geogrid/src/geogrid.F

   1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   2 ! Program: geogrid
   3 !
   4 ! Written by Michael G. Duda
   5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   6 program geogrid
   7
   8    use gridinfo_module
   9    use llxy_module
  10    use list_module
  11    use module_debug
  12    use parallel_module
  13    use process_tile_module
  14    use source_data_module
  15
  16    implicit none
  17
  18    ! Local variables
  19    integer :: i, nest_level, temp
  20    logical :: ew_extra_col, sn_extra_row
  21    type(list) :: level_list
  22
  23    ! Prepare anything necessary to do parallel processing of domains
  24    ! The parallel module should be initialized before any other calls take place
  25    call parallel_start()
  26
  27    call mprintf(.true.,LOGFILE,' *** Starting program geogrid.exe *** ')
  28
  29    ! Have the gridinfo module retrieve description of the grid setup
  30    call get_grid_params()
  31
  32    ! Get information about the source data to be processed
  33    call get_datalist()
  34
  35    if (gridtype == 'C') then
  36
  37       ! Tell the llxy module that it can now compute parameters necessary to do
  38       !   transformations for any nest
  39       call compute_nest_locations()
  40
  41       ! Process all requested domains
  42       do i=1,n_domains
  43          if (grid_is_active(i)) then
  44             call mprintf(.true.,STDOUT,'Processing domain %i of %i', i1=i, i2=n_domains)
  45             call mprintf(.true.,LOGFILE,'Processing domain %i of %i', i1=i, i2=n_domains)
  46
  47             ! Get information about the source data we will use for this nest
  48             call get_source_params(geog_data_res(i))
  49
  50             ! Set transformations in llxy module to be with respect to current nest
  51             call select_domain(i)
  52
  53             ! Determine which range of indices we will work on
  54             call parallel_get_tile_dims(ixdim(i), jydim(i))
  55
  56             if (my_x == nproc_x-1) then ! One more column for U points
  57                ew_extra_col = .true.
  58             else
  59                ew_extra_col = .false.
  60             end if
  61
  62             if (my_y == nproc_y-1) then ! One more row for V points
  63                sn_extra_row = .true.
  64             else
  65                sn_extra_row = .false.
  66             end if
  67
  68             ! Process fields for a tile of the current nest
  69             call process_tile(i, gridtype, dyn_opt,                 &
  70                               1,       ixdim(i), 1,       jydim(i), &
  71                               my_minx, my_maxx,  my_miny, my_maxy,  &   ! These come from parallel_module
  72                               ew_extra_col, sn_extra_row)
  73
  74             ! Print summary of any optional fields that were not processed
  75             call display_optional_field_msgs()
  76          else
  77             call mprintf(.true.,STDOUT,'Skipping domain %i of %i', i1=i, i2=n_domains)
  78             call mprintf(.true.,LOGFILE,'Skipping domain %i of %i', i1=i, i2=n_domains)
  79          end if
  80       end do
  81
  82    else if (gridtype == 'E') then
  83
  84       ! Get number of grid points and grid spacing for nest levels
  85       call compute_nest_level_info()
  86
  87       ! Create list to track NMM nesting levels
  88       call list_init(level_list)
  89
  90       ! Process all requested domains
  91       do i=1,n_domains
  92
  93          nest_level = get_nest_level(i)
  94
  95          if (.not. list_search(level_list, ikey=nest_level, ivalue=temp)) then
  96             call list_insert(level_list, ikey=nest_level, ivalue=nest_level)
  97
  98             if (nest_level == 1) then
  99                call mprintf(.true.,STDOUT,'Processing coarse domain', i1=nest_level)
 100                call mprintf(.true.,LOGFILE,'Processing coarse domain', i1=nest_level)
 101             else
 102                call mprintf(.true.,STDOUT,'Processing nesting level %i', i1=nest_level-1)
 103                call mprintf(.true.,LOGFILE,'Processing nesting level %i', i1=nest_level-1)
 104             end if
 105
 106             ! Get information about the source data we will use for this nest
 107             call get_source_params(geog_data_res(i))
 108
 109             ! Set transformations in llxy module to be with respect to current nest
 110             call select_domain(nest_level)
 111
 112             ! Determine which range of indices we will work on
 113             call parallel_get_tile_dims(ixdim(nest_level), jydim(nest_level))
 114
 115             sn_extra_row = .false.
 116             ew_extra_col = .false.
 117
 118             ! Process fields for a tile of the current nest
 119             call process_tile(nest_level, gridtype, dyn_opt, &
 120                               1, ixdim(nest_level), 1, jydim(nest_level), &
 121                               my_minx, my_maxx, my_miny, my_maxy, &   ! These come from parallel_module
 122                               ew_extra_col, sn_extra_row)
 123
 124             ! Print summary of any optional fields that were not processed
 125             call display_optional_field_msgs()
 126          end if
 127       end do
 128
 129       ! Free up list that was used for tracking NMM nesting levels
 130       call list_destroy(level_list)
 131
 132    end if
 133
 134    ! Free up memory used by list of source data to be processed
 135    call datalist_destroy()
 136
 137    ! Clean up parallel stuff
 138    call parallel_finish()
 139
 140    call mprintf(.true.,STDOUT,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!')
 141    call mprintf(.true.,STDOUT,'!  Successful completion of geogrid.        !')
 142    call mprintf(.true.,STDOUT,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!')
 143
 144    call mprintf(.true.,LOGFILE,' *** Successful completion of program geogrid.exe *** ')
 145
 146    stop
 147
 148 end program geogrid