ungrib/src/read_namelist.F

   1 subroutine read_namelist(hstart, hend, delta_time, ntimes,&
   2      ordered_by_date, debug_level, out_format, prefix,    &
   3      add_lvls, new_plvl_in, interp_type, ec_rec_len, pmin)
   4
   5   use misc_definitions_module
   6   use module_debug
   7
   8   implicit none
   9   integer , parameter :: maxim_doms = 21
  10   character(len=200) :: extdataroot, file_name_namelist
  11   character(len=19) :: hstart, hend
  12   integer :: delta_time
  13   integer :: ntimes
  14   logical :: ordered_by_date
  15   integer :: debug_level
  16   real, dimension(:) :: new_plvl_in
  17   logical :: add_lvls
  18   integer :: interp_type, ec_rec_len
  19   real :: pmin
  20
  21   integer :: ierr
  22   integer :: idts
  23
  24 ! Declare the namelist variables:
  25
  26   integer , dimension(maxim_doms) :: start_year
  27   integer , dimension(maxim_doms) :: start_month
  28   integer , dimension(maxim_doms) :: start_day
  29   integer , dimension(maxim_doms) :: start_hour
  30   integer , dimension(maxim_doms) :: start_minute
  31   integer , dimension(maxim_doms) :: start_second
  32
  33   integer , dimension(maxim_doms) :: end_year
  34   integer , dimension(maxim_doms) :: end_month
  35   integer , dimension(maxim_doms) :: end_day
  36   integer , dimension(maxim_doms) :: end_hour
  37   integer , dimension(maxim_doms) :: end_minute
  38   integer , dimension(maxim_doms) :: end_second
  39
  40   logical , dimension(maxim_doms) :: active_grid
  41   integer , dimension(maxim_doms) :: subgrid_ratio_x
  42   integer , dimension(maxim_doms) :: subgrid_ratio_y
  43
  44   character (len=128) , dimension(maxim_doms) :: start_date, end_date
  45   character (len=MAX_FILENAME_LEN) :: opt_output_from_geogrid_path
  46   integer :: interval_seconds = 0
  47   character (len=3) :: wrf_core = 'ARW'
  48   integer :: max_dom, io_form_geogrid
  49
  50   character(len=3) :: out_format
  51   character(len=MAX_FILENAME_LEN) :: prefix
  52   logical :: nocolons
  53
  54   real :: target_end, incr
  55   integer :: il
  56
  57   real, dimension(:), allocatable :: new_plvl
  58
  59   namelist /share/ wrf_core, max_dom, &
  60        start_year, start_month, start_day, start_hour, &
  61        start_minute, start_second, &
  62        end_year, end_month, end_day, end_hour, &
  63        end_minute, end_second,&
  64        interval_seconds, &
  65        start_date, end_date, &
  66        io_form_geogrid, opt_output_from_geogrid_path, &
  67        debug_level, active_grid, &
  68        subgrid_ratio_x, subgrid_ratio_y, &
  69        nocolons
  70
  71   namelist /ungrib/ out_format, &
  72        ordered_by_date, prefix, &
  73        add_lvls, new_plvl, interp_type, ec_rec_len, pmin
  74
  75   allocate(new_plvl(size(new_plvl_in)))
  76
  77   start_year = 0
  78   start_month = 0
  79   start_day = 0
  80   start_hour = 0
  81   start_minute = 0
  82   start_second = 0
  83
  84   end_year = 0
  85   end_month = 0
  86   end_day = 0
  87   end_hour = 0
  88   end_minute = 0
  89   end_second = 0
  90
  91   ! Set defaults.
  92   io_form_geogrid = 2
  93   max_dom = 1
  94   wrf_core = 'ARW'
  95   debug_level = 0
  96   nocolons = .false.
  97
  98   add_lvls = .false.
  99   new_plvl = -99999.
 100   interp_type = 0
 101   ec_rec_len = 0
 102   pmin = 100.    ! default is 1 hPa (48 km)
 103
 104 ! Start routine:
 105
 106 ! Build the namelist file name:
 107
 108 #ifndef __crayx1
 109   CALL GETENV('EXT_DATAROOT',extdataroot)
 110 #endif
 111   file_name_namelist =  'namelist.wps'
 112
 113 ! Open the namelist file:
 114   open(10, file=file_name_namelist, status='old', iostat=ierr)
 115   call mprintf((ierr.ne.0),ERROR,"**** Error opening namelist file namelist.wps")
 116
 117    REWIND (10)
 118
 119   ! set default:
 120   ordered_by_date = .TRUE.
 121   start_date(1)(1:4) = '0000'
 122   end_date(1)(1:4)   = '0000'
 123
 124   read(10,NML=share)
 125
 126   if (debug_level.gt.100) then
 127      call set_debug_level(DEBUG)
 128   else
 129      call set_debug_level(WARN)
 130   end if
 131
 132
 133 ! Build the Starting date HSTART and the ending date HEND from the namelist
 134 ! date/time information. start_date takes priority over the multi-variable method.
 135
 136   if ( start_date(1)(1:4) .eq. '0000' ) then
 137     call build_hdate(hstart, start_year(1), start_month(1), start_day(1), start_hour(1), &
 138        start_minute(1), start_second(1))
 139   else
 140     hstart = start_date(1)(1:19)
 141   endif
 142   if ( end_date(1)(1:4) .eq. '0000' ) then
 143     call build_hdate(hend, end_year(1), end_month(1), end_day(1), end_hour(1), &
 144        end_minute(1), end_second(1))
 145   else
 146     hend = end_date(1)(1:19)
 147   endif
 148
 149 ! Compute the time difference between start date and end date:
 150
 151   call geth_idts(hend, hstart, idts)
 152
 153 ! Check that INTERVAL is greater than zero:
 154
 155   if (interval_seconds <= 0) then
 156      call mprintf(.true.,STDOUT,"ERROR STOP IN READ_NAMELIST")
 157      call mprintf(.true.,STDOUT,"INTERVAL must be greater than zero:")
 158      call mprintf(.true.,STDOUT,"Start time: %s",s1=hstart)
 159      call mprintf(.true.,STDOUT,"End time:   %s",s1=hend)
 160      call mprintf(.true.,STDOUT,"INTERVAL:   %i",i1=interval_seconds)
 161      call mprintf(.true.,LOGFILE,"ERROR STOP IN READ_NAMELIST")
 162      call mprintf(.true.,LOGFILE,"INTERVAL must be greater than zero:")
 163      call mprintf(.true.,LOGFILE,"Start time: %s",s1=hstart)
 164      call mprintf(.true.,LOGFILE,"End time:   %s",s1=hend)
 165      call mprintf(.true.,LOGFILE,"INTERVAL:   %i",i1=interval_seconds)
 166      call mprintf(.true.,ERROR,"Change your namelist, and resubmit")
 167   endif
 168
 169 ! Check that the selected INTERVAL evenly fills difference between
 170 ! start time and end time:
 171
 172   if ((idts/interval_seconds)*interval_seconds /= idts) then
 173      call mprintf(.true.,STDOUT,"ERROR STOP IN READ_NAMELIST")
 174      call mprintf(.true.,STDOUT,"INTERVAL must fit evenly between start time and end time:")
 175      call mprintf(.true.,STDOUT,"Start time: %s",s1=hstart)
 176      call mprintf(.true.,STDOUT,"End time:   %s",s1=hend)
 177      call mprintf(.true.,STDOUT,"INTERVAL  : %i seconds,  %f hours",&
 178           i1=interval_seconds,f1=float(interval_seconds)/3600.)
 179      call mprintf(.true.,LOGFILE,"ERROR STOP IN READ_NAMELIST")
 180      call mprintf(.true.,LOGFILE,"INTERVAL must fit evenly between start time and end time:")
 181      call mprintf(.true.,LOGFILE,"Start time: %s",s1=hstart)
 182      call mprintf(.true.,LOGFILE,"End time:   %s",s1=hend)
 183      call mprintf(.true.,LOGFILE,"INTERVAL  : %i seconds,  %f hours",&
 184           i1=interval_seconds,f1=float(interval_seconds)/3600.)
 185      call mprintf(.true.,ERROR,"Change your namelist, and resubmit")
 186   endif
 187
 188 ! Check that start time is not later than end time:
 189
 190   if (hstart > hend) then
 191      call mprintf(.true.,STDOUT,"ERROR STOP IN READ_NAMELIST")
 192      call mprintf(.true.,STDOUT,"Start time must not be later than end time:")
 193      call mprintf(.true.,STDOUT,"Start time: %s",s1=hstart)
 194      call mprintf(.true.,STDOUT,"End time:   %s",s1=hend)
 195      call mprintf(.true.,STDOUT,"INTERVAL:   %i",i1=interval_seconds)
 196      call mprintf(.true.,LOGFILE,"ERROR STOP IN READ_NAMELIST")
 197      call mprintf(.true.,LOGFILE,"Start time must not be later than end time:")
 198      call mprintf(.true.,LOGFILE,"Start time: %s",s1=hstart)
 199      call mprintf(.true.,LOGFILE,"End time:   %s",s1=hend)
 200      call mprintf(.true.,LOGFILE,"INTERVAL:   %i",i1=interval_seconds)
 201      call mprintf(.true.,ERROR,"Change your namelist, and resubmit")
 202   endif
 203
 204 ! Compute the number of time periods to process:
 205
 206   ntimes = idts/interval_seconds + 1
 207
 208   call mprintf(.true.,STDOUT, &
 209   "Start_date =  %s ,      End_date = %s ",s1=hstart,s2=hend)
 210   call mprintf(.true.,LOGFILE, &
 211   "Start_date =  %s ,      End_date = %s ",s1=hstart,s2=hend)
 212
 213   if (debug_level.gt.0) then
 214      call mprintf(.true.,LOGFILE,"Namelist information (coarse domain): ")
 215      call mprintf(.true.,LOGFILE,'  START_YEAR       = %i',i1=start_year(1))
 216      call mprintf(.true.,LOGFILE,'  START_MONTH      = %i',i1=start_month(1))
 217      call mprintf(.true.,LOGFILE,'  START_DAY        = %i',i1=start_day(1))
 218      call mprintf(.true.,LOGFILE,'  START_HOUR       = %i',i1=start_hour(1))
 219 !    call mprintf(.true.,LOGFILE,"start_minute = %i",i1=start_minute(1))
 220 !    call mprintf(.true.,LOGFILE,"start_second = %i",i1=start_second(1))
 221      call mprintf(.true.,LOGFILE,'  END_YEAR         = %i',i1=end_year(1))
 222      call mprintf(.true.,LOGFILE,'  END_MONTH        = %i',i1=end_month(1))
 223      call mprintf(.true.,LOGFILE,'  END_DAY          = %i',i1=end_day(1))
 224      call mprintf(.true.,LOGFILE,'  END_HOUR         = %i',i1=end_hour(1))
 225 !    call mprintf(.true.,LOGFILE,"end_minute = %i",i1=end_minute(1))
 226 !    call mprintf(.true.,LOGFILE,"end_second = %i",i1=end_second(1))
 227      call mprintf(.true.,LOGFILE,'  START_DATE       = %s',s1=start_date(1))
 228      call mprintf(.true.,LOGFILE,'  END_DATE         = %s',s1=end_date(1))
 229      call mprintf(.true.,LOGFILE,'  INTERVAL_SECONDS = %i',i1=interval_seconds)
 230      call mprintf(.true.,LOGFILE,'  DEBUG_LEVEL      = %i',i1=debug_level)
 231      call mprintf(.true.,LOGFILE,'/')
 232   else
 233      debug_level=0
 234   endif
 235
 236   delta_time = interval_seconds
 237
 238   rewind(10)
 239   out_format = 'WPS'
 240   prefix = 'FILE'
 241   read(10,NML=ungrib,END=100)
 242
 243      call mprintf(.true.,LOGFILE,'&UNGRIB')
 244      call mprintf(.true.,LOGFILE,"out_format = %s",s1=out_format)
 245      if (ordered_by_date) then
 246        call mprintf(.true.,LOGFILE,"ordered_by_date = %s",s1='TRUE')
 247      else
 248        call mprintf(.true.,LOGFILE,"ordered_by_date = %s",s1='FALSE')
 249      endif
 250      call mprintf(.true.,LOGFILE,"prefix = %s",s1=trim(prefix))
 251      call mprintf(.true.,LOGFILE,'/')
 252
 253 100  continue
 254    if (out_format(1:2) .eq. 'WP' .or. out_format(1:2) .eq. 'wp') then
 255      out_format = 'WPS'
 256      call mprintf(.true.,STDOUT,'output format is WPS')
 257      call mprintf(.true.,LOGFILE,'output format is WPS')
 258    else if (out_format(1:2) .eq. 'SI' .or. out_format(1:2) .eq. 'si') then
 259      out_format = 'SI '
 260      call mprintf(.true.,STDOUT,'output format is SI')
 261      call mprintf(.true.,LOGFILE,'output format is SI')
 262    else if (out_format(1:2) .eq. 'MM' .or. out_format(1:2) .eq. 'mm') then
 263      out_format = 'MM5'
 264      call mprintf(.true.,STDOUT,'output format is MM5 pregrid')
 265      call mprintf(.true.,LOGFILE,'output format is MM5 pregrid')
 266    else
 267      call mprintf(.true.,ERROR, &
 268  'read_namelist: I do not recognize the output format, %s , stopping.',s1=out_format)
 269    endif
 270
 271 ! Check to see if I should create my own set of new_plvl's
 272   if ( add_lvls .AND. new_plvl(2) > -99999. .AND. new_plvl(2) < 0.0 ) then
 273     target_end = abs(new_plvl(2))
 274     incr = new_plvl(3)
 275     il = 2
 276     make_plvl : do
 277       if(il.gt.size(new_plvl)) then
 278        call mprintf(.true.,ERROR,&
 279         'Too many new levels specified via new_plvl. Increase maxlvl in ungrib.F')
 280       end if
 281       new_plvl(il) = new_plvl(il-1) - incr
 282       ! If we are past the end of the range of pressures over which new levels
 283       ! are to be created, then discard the pressure we just calculated.
 284       ! This occurs when the user-chosen increment did not evenly divide
 285       ! the range of pressures over which new pressures were to be added.
 286       if ( new_plvl(il) < target_end ) then
 287         new_plvl(il) = -99999.
 288         exit make_plvl
 289       end if
 290       if ( new_plvl(il) == target_end ) exit make_plvl
 291       il = il + 1
 292     end do make_plvl
 293   endif
 294
 295 ! Close the namelist file:
 296
 297   close(10)
 298
 299   new_plvl_in(:) = new_plvl(:)
 300   deallocate(new_plvl)
 301
 302 end subroutine read_namelist