WPS/metgrid/src/gridinfo_module.F

   1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   2 ! MODULE GRIDINFO_MODULE
   3 !
   4 ! This module handles (i.e., acquires, stores, and makes available) all data
   5 !   describing the model domains to be processed.
   6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   7 module gridinfo_module
   8
   9    use misc_definitions_module
  10    use module_debug
  11
  12    ! Parameters
  13    integer, parameter :: MAX_DOMAINS = 21
  14
  15    ! Variables
  16    integer :: interval_seconds, max_dom, io_form_input, io_form_output, debug_level
  17    integer, dimension(MAX_DOMAINS) :: sr_x, sr_y
  18    character (len=MAX_FILENAME_LEN) :: opt_output_from_geogrid_path, &
  19                           opt_output_from_metgrid_path, opt_metgrid_tbl_path
  20    character (len=128), dimension(MAX_DOMAINS) :: start_date, end_date
  21    character (len=MAX_FILENAME_LEN), dimension(MAX_DOMAINS) :: fg_name, constants_name
  22    logical :: do_tiled_input, do_tiled_output, opt_ignore_dom_center, nocolons
  23    character (len=1) :: gridtype
  24
  25    contains
  26
  27    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  28    ! Name: get_namelist_params
  29    !
  30    ! Purpose: Read namelist parameters.
  31    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  32    subroutine get_namelist_params()
  33
  34       implicit none
  35
  36       ! Local variables
  37       integer :: i, io_form_geogrid, io_form_metgrid
  38       integer, dimension(MAX_DOMAINS) :: start_year, start_month, start_day, start_hour, start_minute, start_second, &
  39                                          end_year, end_month, end_day, end_hour, end_minute, end_second
  40       integer :: funit
  41       logical :: is_used
  42       character (len=3) :: wrf_core
  43       namelist /share/ wrf_core, max_dom, start_date, end_date, &
  44                         start_year, end_year, start_month, end_month, &
  45                         start_day, end_day, start_hour, end_hour, &
  46                         start_minute, end_minute, start_second, end_second, &
  47                         interval_seconds, &
  48                         io_form_geogrid, opt_output_from_geogrid_path, debug_level, nocolons, &
  49                         sr_x, sr_y
  50       namelist /metgrid/ io_form_metgrid, fg_name, constants_name, opt_output_from_metgrid_path, &
  51                          opt_metgrid_tbl_path, opt_ignore_dom_center
  52
  53       ! Set defaults
  54       io_form_geogrid = 2
  55       io_form_metgrid = 2
  56       max_dom = 1
  57       wrf_core = 'ARW'
  58       debug_level = 0
  59       nocolons = .false.
  60       do i=1,MAX_DOMAINS
  61          fg_name(i) = '*'
  62          constants_name(i) = '*'
  63          start_year(i) = 0
  64          start_month(i) = 0
  65          start_day(i) = 0
  66          start_hour(i) = 0
  67          start_minute(i) = 0
  68          start_second(i) = 0
  69          end_year(i) = 0
  70          end_month(i) = 0
  71          end_day(i) = 0
  72          end_hour(i) = 0
  73          end_minute(i) = 0
  74          end_second(i) = 0
  75          start_date(i) = '0000-00-00_00:00:00'
  76          end_date(i) = '0000-00-00_00:00:00'
  77          sr_x(i) = 1
  78          sr_y(i) = 1
  79       end do
  80       opt_output_from_geogrid_path = './'
  81       opt_output_from_metgrid_path = './'
  82       opt_metgrid_tbl_path = 'metgrid/'
  83       opt_ignore_dom_center = .false.
  84       interval_seconds = INVALID
  85
  86       ! Read parameters from Fortran namelist
  87       do funit=10,100
  88          inquire(unit=funit, opened=is_used)
  89          if (.not. is_used) exit
  90       end do
  91       open(funit,file='namelist.wps',status='old',form='formatted',err=1000)
  92       read(funit,share)
  93       read(funit,metgrid)
  94       close(funit)
  95
  96 ! BUG: Better handle debug_level in module_debug
  97       if ( debug_level .gt. 100 ) then
  98          call set_debug_level(DEBUG)
  99       else
 100          call set_debug_level(WARN)
 101       end if
 102
 103       call mprintf(.true.,LOGFILE,'Using the following namelist variables:')
 104       call mprintf(.true.,LOGFILE,'&SHARE')
 105       call mprintf(.true.,LOGFILE,'  WRF_CORE         = %s',s1=wrf_core)
 106       call mprintf(.true.,LOGFILE,'  MAX_DOM          = %i',i1=max_dom)
 107       call mprintf(.true.,LOGFILE,'  START_YEAR       = %i',i1=start_year(1))
 108       do i=2,max_dom
 109          call mprintf(.true.,LOGFILE,'                   = %i',i1=start_year(i))
 110       end do
 111       call mprintf(.true.,LOGFILE,'  START_MONTH      = %i',i1=start_month(1))
 112       do i=2,max_dom
 113          call mprintf(.true.,LOGFILE,'                   = %i',i1=start_month(i))
 114       end do
 115       call mprintf(.true.,LOGFILE,'  START_DAY        = %i',i1=start_day(1))
 116       do i=2,max_dom
 117          call mprintf(.true.,LOGFILE,'                   = %i',i1=start_day(i))
 118       end do
 119       call mprintf(.true.,LOGFILE,'  START_HOUR       = %i',i1=start_hour(1))
 120       do i=2,max_dom
 121          call mprintf(.true.,LOGFILE,'                   = %i',i1=start_hour(i))
 122       end do
 123       call mprintf(.true.,LOGFILE,'  START_MINUTE     = %i',i1=start_minute(1))
 124       do i=2,max_dom
 125          call mprintf(.true.,LOGFILE,'                   = %i',i1=start_minute(i))
 126       end do
 127       call mprintf(.true.,LOGFILE,'  START_SECOND     = %i',i1=start_second(1))
 128       do i=2,max_dom
 129          call mprintf(.true.,LOGFILE,'                   = %i',i1=start_second(i))
 130       end do
 131       call mprintf(.true.,LOGFILE,'  END_YEAR         = %i',i1=end_year(1))
 132       do i=2,max_dom
 133          call mprintf(.true.,LOGFILE,'                   = %i',i1=end_year(i))
 134       end do
 135       call mprintf(.true.,LOGFILE,'  END_MONTH        = %i',i1=end_month(1))
 136       do i=2,max_dom
 137          call mprintf(.true.,LOGFILE,'                   = %i',i1=end_month(i))
 138       end do
 139       call mprintf(.true.,LOGFILE,'  END_DAY          = %i',i1=end_day(1))
 140       do i=2,max_dom
 141          call mprintf(.true.,LOGFILE,'                   = %i',i1=end_day(i))
 142       end do
 143       call mprintf(.true.,LOGFILE,'  END_HOUR         = %i',i1=end_hour(1))
 144       do i=2,max_dom
 145          call mprintf(.true.,LOGFILE,'                   = %i',i1=end_hour(i))
 146       end do
 147       call mprintf(.true.,LOGFILE,'  END_MINUTE       = %i',i1=end_minute(1))
 148       do i=2,max_dom
 149          call mprintf(.true.,LOGFILE,'                   = %i',i1=end_minute(i))
 150       end do
 151       call mprintf(.true.,LOGFILE,'  END_SECOND       = %i',i1=end_second(1))
 152       do i=2,max_dom
 153          call mprintf(.true.,LOGFILE,'                   = %i',i1=end_second(i))
 154       end do
 155       call mprintf(.true.,LOGFILE,'  START_DATE       = %s',s1=start_date(1))
 156       do i=2,max_dom
 157          call mprintf(.true.,LOGFILE,'                   = %s',s1=start_date(i))
 158       end do
 159       call mprintf(.true.,LOGFILE,'  END_DATE         = %s',s1=end_date(1))
 160       do i=2,max_dom
 161          call mprintf(.true.,LOGFILE,'                   = %s',s1=end_date(i))
 162       end do
 163       call mprintf(.true.,LOGFILE,'  INTERVAL_SECONDS = %i',i1=interval_seconds)
 164       call mprintf(.true.,LOGFILE,'  IO_FORM_GEOGRID  = %i',i1=io_form_geogrid)
 165       call mprintf(.true.,LOGFILE,'  OPT_OUTPUT_FROM_GEOGRID_PATH = %s',s1=opt_output_from_geogrid_path)
 166       call mprintf(.true.,LOGFILE,'  SR_X              = %i',i1=sr_x(1))
 167       do i=2,max_dom
 168          call mprintf(.true.,LOGFILE,'                    = %i',i1=sr_x(i))
 169       enddo
 170       call mprintf(.true.,LOGFILE,'  SR_Y              = %i',i1=sr_y(1))
 171       do i=2,max_dom
 172          call mprintf(.true.,LOGFILE,'                    = %i',i1=sr_y(i))
 173       enddo
 174       call mprintf(.true.,LOGFILE,'  DEBUG_LEVEL      = %i',i1=debug_level)
 175       if ( nocolons ) then
 176          call mprintf(.true.,LOGFILE,'  NOCOLONS         = .TRUE.' )
 177       else
 178          call mprintf(.true.,LOGFILE,'  NOCOLONS         = .FALSE.' )
 179       endif
 180       call mprintf(.true.,LOGFILE,'/')
 181
 182       call mprintf(.true.,LOGFILE,'&METGRID')
 183       do i=1,MAX_DOMAINS
 184          if (i == 1) then
 185             if (fg_name(i) == '*') then
 186                call mprintf(.true.,LOGFILE,'  FG_NAME               = ')
 187             else
 188                call mprintf(.true.,LOGFILE,'  FG_NAME               = %s',s1=fg_name(i))
 189             end if
 190          else
 191             if (fg_name(i) == '*') exit
 192             call mprintf(.true.,LOGFILE,'                        = %s',s1=fg_name(i))
 193          end if
 194       end do
 195       do i=1,MAX_DOMAINS
 196          if (i == 1) then
 197             if (constants_name(i) == '*') then
 198                call mprintf(.true.,LOGFILE,'  CONSTANTS_NAME        = ')
 199             else
 200                call mprintf(.true.,LOGFILE,'  CONSTANTS_NAME        = %s',s1=constants_name(i))
 201             end if
 202          else
 203             if (constants_name(i) == '*') exit
 204             call mprintf(.true.,LOGFILE,'                        = %s',s1=constants_name(i))
 205          end if
 206       end do
 207       call mprintf(.true.,LOGFILE,'  IO_FORM_METGRID       = %i',i1=io_form_metgrid)
 208       call mprintf(.true.,LOGFILE,'  OPT_OUTPUT_FROM_METGRID_PATH = %s',s1=opt_output_from_metgrid_path)
 209       call mprintf(.true.,LOGFILE,'  OPT_METGRID_TBL_PATH  = %s',s1=opt_metgrid_tbl_path)
 210       if (opt_ignore_dom_center) then
 211          call mprintf(.true.,LOGFILE,'  OPT_IGNORE_DOM_CENTER = .TRUE.')
 212       else
 213          call mprintf(.true.,LOGFILE,'  OPT_IGNORE_DOM_CENTER = .FALSE.')
 214       end if
 215       call mprintf(.true.,LOGFILE,'/')
 216
 217
 218       ! Convert wrf_core to uppercase letters
 219       do i=1,3
 220          if (ichar(wrf_core(i:i)) >= ichar('a') .and. ichar(wrf_core(i:i)) <= ichar('z') ) &
 221              wrf_core(i:i) = char(ichar(wrf_core(i:i))-ichar('a')+ichar('A'))
 222       end do
 223
 224       ! Before doing anything else, we must have a valid grid type
 225       gridtype = ' '
 226       if (wrf_core == 'ARW') then
 227          gridtype = 'C'
 228       else if (wrf_core == 'NMM') then
 229          gridtype = 'E'
 230       end if
 231
 232       call mprintf(gridtype /= 'C' .and. gridtype /= 'E', ERROR, &
 233                    'A valid wrf_core must be specified in the namelist. '// &
 234                    'Currently, only "ARW" and "NMM" are supported.')
 235
 236       call mprintf(max_dom > MAX_DOMAINS, ERROR, &
 237                    'In namelist, max_dom must be <= %i. To run with more'// &
 238                    ' than %i domains, increase the MAX_DOMAINS parameter.', &
 239                    i1=MAX_DOMAINS, i2=MAX_DOMAINS)
 240
 241       ! Handle IO_FORM+100
 242       if (io_form_geogrid > 100) then
 243          io_form_geogrid = io_form_geogrid - 100
 244          do_tiled_input = .true.
 245       else
 246          do_tiled_input = .false.
 247       end if
 248       if (io_form_metgrid > 100) then
 249          io_form_metgrid = io_form_metgrid - 100
 250          do_tiled_output = .true.
 251       else
 252          do_tiled_output = .false.
 253       end if
 254
 255       ! Check for valid io_form_geogrid
 256       if ( &
 257 #ifdef IO_BINARY
 258           io_form_geogrid /= BINARY .and. &
 259 #endif
 260 #ifdef IO_NETCDF
 261           io_form_geogrid /= NETCDF .and. &
 262 #endif
 263 #ifdef IO_GRIB1
 264           io_form_geogrid /= GRIB1 .and. &
 265 #endif
 266           .true. ) then
 267          call mprintf(.true.,WARN,'Valid io_form_geogrid values are:')
 268 #ifdef IO_BINARY
 269          call mprintf(.true.,WARN,'       %i (=BINARY)',i1=BINARY)
 270 #endif
 271 #ifdef IO_NETCDF
 272          call mprintf(.true.,WARN,'       %i (=NETCDF)',i1=NETCDF)
 273 #endif
 274 #ifdef IO_GRIB1
 275          call mprintf(.true.,WARN,'       %i (=GRIB1)',i1=GRIB1)
 276 #endif
 277          call mprintf(.true.,ERROR,'No valid value for io_form_geogrid was specified in the namelist.')
 278       end if
 279       io_form_input = io_form_geogrid
 280
 281       ! Check for valid io_form_metgrid
 282       if ( &
 283 #ifdef IO_BINARY
 284           io_form_metgrid /= BINARY .and. &
 285 #endif
 286 #ifdef IO_NETCDF
 287           io_form_metgrid /= NETCDF .and. &
 288 #endif
 289 #ifdef IO_GRIB1
 290           io_form_metgrid /= GRIB1 .and. &
 291 #endif
 292           .true. ) then
 293          call mprintf(.true.,WARN,'Valid io_form_metgrid values are:')
 294 #ifdef IO_BINARY
 295          call mprintf(.true.,WARN,'       %i (=BINARY)',i1=BINARY)
 296 #endif
 297 #ifdef IO_NETCDF
 298          call mprintf(.true.,WARN,'       %i (=NETCDF)',i1=NETCDF)
 299 #endif
 300 #ifdef IO_GRIB1
 301          call mprintf(.true.,WARN,'       %i (=GRIB1)',i1=GRIB1)
 302 #endif
 303          call mprintf(.true.,ERROR,'No valid value for io_form_metgrid was specified in the namelist.')
 304       end if
 305       io_form_output = io_form_metgrid
 306
 307       if (start_date(1) == '0000-00-00_00:00:00') then
 308          do i=1,max_dom
 309             ! Build starting date string
 310             write(start_date(i), '(i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2)') &
 311                start_year(i),'-',start_month(i),'-',start_day(i),'_',start_hour(i),':',start_minute(i),':',start_second(i)
 312
 313             ! Build ending date string
 314             write(end_date(i), '(i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2)') &
 315                end_year(i),'-',end_month(i),'-',end_day(i),'_',end_hour(i),':',end_minute(i),':',end_second(i)
 316          end do
 317       end if
 318
 319
 320       ! Paths need to end with a /
 321       i = len_trim(opt_metgrid_tbl_path)
 322       if (opt_metgrid_tbl_path(i:i) /= '/') then
 323          opt_metgrid_tbl_path(i+1:i+1) = '/'
 324       end if
 325
 326       i = len_trim(opt_output_from_geogrid_path)
 327       if (opt_output_from_geogrid_path(i:i) /= '/') then
 328          opt_output_from_geogrid_path(i+1:i+1) = '/'
 329       end if
 330
 331       i = len_trim(opt_output_from_metgrid_path)
 332       if (opt_output_from_metgrid_path(i:i) /= '/') then
 333          opt_output_from_metgrid_path(i+1:i+1) = '/'
 334       end if
 335
 336
 337       ! Blank strings should be set to flag values
 338       do i=1,max_dom
 339          if (len_trim(constants_name(i)) == 0) then
 340             constants_name(i) = '*'
 341          end if
 342          if (len_trim(fg_name(i)) == 0) then
 343             fg_name(i) = '*'
 344          end if
 345       end do
 346
 347       return
 348
 349  1000 call mprintf(.true.,ERROR,'Error opening file namelist.wps')
 350
 351    end subroutine get_namelist_params
 352
 353 end module gridinfo_module