wrfv2_fire/share/input_wrf.F

   1 !WRF:MEDIATION:IO
   2 !  ---principal wrf input routine (called from routines in module_io_domain )
   3
   4   SUBROUTINE input_wrf ( fid , grid , config_flags , switch , ierr )
   5     USE module_domain
   6     USE module_state_description
   7     USE module_configure
   8     USE module_io
   9     USE module_io_wrf
  10     USE module_date_time
  11     USE module_bc_time_utilities
  12     USE module_utility
  13     IMPLICIT NONE
  14 #include <wrf_io_flags.h>
  15 #include <wrf_status_codes.h>
  16     TYPE(domain) :: grid
  17     TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
  18     INTEGER, INTENT(IN) :: fid
  19     INTEGER, INTENT(IN) :: switch
  20     INTEGER, INTENT(INOUT) :: ierr
  21
  22     ! Local data
  23     INTEGER ids , ide , jds , jde , kds , kde , &
  24             ims , ime , jms , jme , kms , kme , &
  25             ips , ipe , jps , jpe , kps , kpe
  26
  27     INTEGER       iname(9)
  28     INTEGER       iordering(3)
  29     INTEGER       icurrent_date(24)
  30     INTEGER       i,j,k
  31     INTEGER       icnt
  32     INTEGER       ndim
  33     INTEGER       ilen
  34     INTEGER , DIMENSION(3) :: domain_start , domain_end
  35     INTEGER , DIMENSION(3) :: memory_start , memory_end
  36     INTEGER , DIMENSION(3) :: patch_start , patch_end
  37     CHARACTER*256 errmess, currtimestr
  38     CHARACTER*40            :: this_datestr, next_datestr
  39     CHARACTER*9   NAMESTR
  40     INTEGER       IBDY, NAMELEN
  41     LOGICAL wrf_dm_on_monitor
  42     EXTERNAL wrf_dm_on_monitor
  43     Type(WRFU_Time) time, currtime
  44     CHARACTER*19  new_date
  45     CHARACTER*24  base_date
  46     CHARACTER*80  fname
  47     LOGICAL dryrun
  48     INTEGER idt
  49     INTEGER itmp
  50     INTEGER filestate, ierr3
  51     INTEGER :: ide_compare , jde_compare , kde_compare
  52     CHARACTER (len=19) simulation_start_date
  53     INTEGER simulation_start_year   , &
  54             simulation_start_month  , &
  55             simulation_start_day    , &
  56             simulation_start_hour   , &
  57             simulation_start_minute , &
  58             simulation_start_second
  59     LOGICAL reset_simulation_start
  60     REAL dx_compare , dy_compare , dum
  61
  62 !<DESCRIPTION>
  63 !
  64 ! Core wrf input routine for all input data streams. Part of mediation layer.
  65 !
  66 ! Note that WRF IOAPI routines wrf_get_dom_ti_*() do not return values during
  67 ! training reads (dryrun).
  68 !
  69 !</DESCRIPTION>
  70
  71     WRITE(wrf_err_message,*)'input_wrf: begin, fid = ',fid
  72     CALL wrf_debug( 300 , wrf_err_message )
  73
  74     ierr = 0
  75
  76     CALL get_ijk_from_grid (  grid ,                        &
  77                               ids, ide, jds, jde, kds, kde,    &
  78                               ims, ime, jms, jme, kms, kme,    &
  79                               ips, ipe, jps, jpe, kps, kpe    )
  80
  81 ! simulation start time is a Singleton maintained by head_grid
  82     IF ( ( switch .EQ.     model_input_only  ) .OR. &
  83          ( switch .EQ.          restart_only ) ) THEN
  84       CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_START_DATE' , simulation_start_date , ierr )
  85       CALL nl_get_reset_simulation_start ( 1, reset_simulation_start )
  86       IF ( ( ierr .EQ. 0 ) .AND. ( .NOT. reset_simulation_start ) ) THEN
  87         ! Overwrite simulation start date with metadata.
  88 #ifdef PLANET
  89         READ ( simulation_start_date , fmt = '(I4,1x,I5,1x,I2,1x,I2,1x,I2)' )       &
  90                simulation_start_year,                                               &
  91                simulation_start_day,    simulation_start_hour,                      &
  92                simulation_start_minute, simulation_start_second
  93         simulation_start_month = 0
  94 #else
  95         READ ( simulation_start_date , fmt = '(I4,1x,I2,1x,I2,1x,I2,1x,I2,1x,I2)' ) &
  96                simulation_start_year,   simulation_start_month,                     &
  97                simulation_start_day,    simulation_start_hour,                      &
  98                simulation_start_minute, simulation_start_second
  99 #endif
 100         CALL nl_set_simulation_start_year   ( 1 , simulation_start_year   )
 101         CALL nl_set_simulation_start_month  ( 1 , simulation_start_month  )
 102         CALL nl_set_simulation_start_day    ( 1 , simulation_start_day    )
 103         CALL nl_set_simulation_start_hour   ( 1 , simulation_start_hour   )
 104         CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
 105         CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
 106         IF ( switch .EQ. model_input_only  ) THEN
 107           WRITE(wrf_err_message,*)fid,' input_wrf, model_input_only:  SIMULATION_START_DATE = ', &
 108                                   simulation_start_date(1:19)
 109           CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
 110         ELSE IF ( switch .EQ. restart_only  ) THEN
 111           WRITE(wrf_err_message,*)fid,' input_wrf, restart_only:  SIMULATION_START_DATE = ', &
 112                                   simulation_start_date(1:19)
 113           CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
 114         ENDIF
 115       ELSE
 116         CALL nl_get_start_year   ( 1 , simulation_start_year   )
 117         CALL nl_get_start_month  ( 1 , simulation_start_month  )
 118         CALL nl_get_start_day    ( 1 , simulation_start_day    )
 119         CALL nl_get_start_hour   ( 1 , simulation_start_hour   )
 120         CALL nl_get_start_minute ( 1 , simulation_start_minute )
 121         CALL nl_get_start_second ( 1 , simulation_start_second )
 122         CALL nl_set_simulation_start_year   ( 1 , simulation_start_year   )
 123         CALL nl_set_simulation_start_month  ( 1 , simulation_start_month  )
 124         CALL nl_set_simulation_start_day    ( 1 , simulation_start_day    )
 125         CALL nl_set_simulation_start_hour   ( 1 , simulation_start_hour   )
 126         CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
 127         CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
 128         IF ( reset_simulation_start ) THEN
 129           CALL wrf_message('input_wrf: forcing SIMULATION_START_DATE = head_grid start time')
 130           CALL wrf_message('           due to namelist variable reset_simulation_start')
 131         ELSE
 132           CALL wrf_message('input_wrf: SIMULATION_START_DATE not available in input')
 133           CALL wrf_message('will use head_grid start time from namelist')
 134         ENDIF
 135       ENDIF
 136       ! Initialize derived time quantity in grid%xtime.
 137       ! Note that this call is also made in setup_timekeeping().
 138       ! Ugh, what a hack.  Simplify all this later...
 139       CALL domain_clock_get( grid, minutesSinceSimulationStart=grid%xtime )
 140       ! Note that it is NOT necessary to reset grid%julian here.
 141       WRITE(wrf_err_message,*) 'input_wrf:  set xtime to ',grid%xtime
 142       CALL wrf_debug ( 100, TRIM(wrf_err_message) )
 143     ENDIF
 144
 145
 146     !  Test to make sure that the input data is the right size.  Do this for input from real/ideal into
 147     !  WRF, and from the standard initialization into real.
 148
 149     IF ( ( switch .EQ.     model_input_only  ) .OR. &
 150          ( switch .EQ. aux_model_input1_only ) ) THEN
 151        ierr = 0
 152        CALL wrf_get_dom_ti_integer ( fid , 'WEST-EAST_GRID_DIMENSION' ,    ide_compare , 1 , icnt , ierr3 )
 153        ierr = max( ierr, ierr3 )
 154        CALL wrf_get_dom_ti_integer ( fid , 'SOUTH-NORTH_GRID_DIMENSION' ,  jde_compare , 1 , icnt , ierr3 )
 155        ierr = max( ierr, ierr3 )
 156        CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMENSION' ,   kde_compare , 1 , icnt , ierr3 )
 157        ierr = max( ierr, ierr3 )
 158 !      IF ( ierr3 .NE. 0 ) CALL wrf_error_fatal( 'wrf_get_dom_ti_integer getting dimension information from dataset' )
 159        IF ( ierr3 .NE. 0 ) CALL wrf_debug( 'wrf_get_dom_ti_integer getting dimension information from dataset' )
 160
 161 #if (EM_CORE == 1)
 162        !  Test to make sure that the grid distances are the right size.
 163
 164        CALL wrf_get_dom_ti_real ( fid , 'DX' ,  dx_compare , 1 , icnt , ierr )
 165        CALL wrf_get_dom_ti_real ( fid , 'DY' ,  dy_compare , 1 , icnt , ierr )
 166        IF ( ( ABS ( dx_compare - config_flags%dx ) .GT. 1.E-5 * dx_compare ) .OR. &
 167             ( ABS ( dy_compare - config_flags%dy ) .GT. 1.E-5 * dy_compare ) ) THEN
 168           IF ( ( config_flags%polar ) .AND. ( config_flags%grid_id .EQ. 1 ) ) THEN
 169              WRITE(wrf_err_message,*)'input_wrf: DX and DY from input file expected to be wrong'
 170              CALL wrf_debug ( 1 , wrf_err_message )
 171           ELSE
 172              print *,'dx_compare,dy_compare = ',dx_compare,dy_compare
 173              CALL wrf_error_fatal( 'DX and DY do not match from the namelist and the input file' )
 174           END IF
 175        END IF
 176 #endif
 177     END IF
 178
 179     ! do the check later (see check_if_dryrun below)
 180
 181     !  We do not want the CEN_LAT LON values from the boundary file.  For 1-way nests
 182     !  with ndown, this ends up being the data from the previous coarse domain.
 183
 184     IF ( switch .NE. boundary_only ) THEN
 185        CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' ,  config_flags%cen_lat , 1 , icnt , ierr )
 186        WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',config_flags%cen_lat
 187        CALL wrf_debug ( 300 , wrf_err_message )
 188        CALL nl_set_cen_lat ( grid%id , config_flags%cen_lat )
 189
 190        CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' ,  config_flags%cen_lon , 1 , icnt , ierr )
 191        WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',config_flags%cen_lon
 192        CALL wrf_debug ( 300 , wrf_err_message )
 193        CALL nl_set_cen_lon ( grid%id , config_flags%cen_lon )
 194     ELSE
 195        CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' ,  dum , 1 , icnt , ierr )
 196        WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',dum
 197        CALL wrf_debug ( 300 , wrf_err_message )
 198
 199        CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' ,  dum , 1 , icnt , ierr )
 200        WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',dum
 201        CALL wrf_debug ( 300 , wrf_err_message )
 202     END IF
 203
 204     CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' ,  config_flags%truelat1 , 1 , icnt , ierr )
 205     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT1 returns ',config_flags%truelat1
 206     CALL wrf_debug ( 300 , wrf_err_message )
 207     CALL nl_set_truelat1 ( grid%id , config_flags%truelat1 )
 208
 209     CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' ,  config_flags%truelat2 , 1 , icnt , ierr )
 210     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT2 returns ',config_flags%truelat2
 211     CALL wrf_debug ( 300 , wrf_err_message )
 212     CALL nl_set_truelat2 ( grid%id , config_flags%truelat2 )
 213
 214     CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' ,  config_flags%moad_cen_lat , 1 , icnt , ierr )
 215     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for MOAD_CEN_LAT returns ',config_flags%moad_cen_lat
 216     CALL wrf_debug ( 300 , wrf_err_message )
 217     CALL nl_set_moad_cen_lat ( grid%id , config_flags%moad_cen_lat )
 218
 219     CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' ,  config_flags%stand_lon , 1 , icnt , ierr )
 220     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for STAND_LON returns ',config_flags%stand_lon
 221     CALL wrf_debug ( 300 , wrf_err_message )
 222     CALL nl_set_stand_lon ( grid%id , config_flags%stand_lon )
 223
 224 #if ( NMM_CORE != 1 )
 225 ! program_name is defined in module_domain and set in the main program for whatever application
 226 ! is using subroutine input_wrf (that is, the subroutine you are looking at here). Data files
 227 ! written by SI have P_TOP as a metadata item; the real program and wrf model have it as a
 228 ! state variable. This test is to supress non-fatal but confusing messages from the model complaining
 229 ! that P_TOP cannot be read from the metadata for this dataset.  JM 20040905
 230 !
 231 ! Note, P_TOP is not defined in the NMM core.
 232
 233     IF ( program_name(1:7) .EQ. "REAL_EM" ) THEN
 234       CALL wrf_get_dom_ti_real ( fid , 'P_TOP' ,  grid%p_top , 1 , icnt , ierr )
 235       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for P_TOP returns ',grid%p_top
 236       CALL wrf_debug ( 300 , wrf_err_message )
 237     ENDIF
 238 #endif
 239
 240     IF ( switch .NE. boundary_only ) THEN
 241       CALL wrf_get_dom_ti_real ( fid , 'GMT' ,  config_flags%gmt , 1 , icnt , ierr )
 242       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for GMT returns ',config_flags%gmt
 243       CALL wrf_debug ( 300 , wrf_err_message )
 244       CALL nl_set_gmt ( grid%id , config_flags%gmt )
 245
 246       CALL wrf_get_dom_ti_integer ( fid , 'JULYR' ,  config_flags%julyr , 1 , icnt , ierr )
 247       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULYR returns ',config_flags%julyr
 248       CALL wrf_debug ( 300 , wrf_err_message )
 249       CALL nl_set_julyr ( grid%id , config_flags%julyr )
 250
 251       CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' ,  config_flags%julday , 1 , icnt , ierr )
 252       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULDAY returns ',config_flags%julday
 253       CALL wrf_debug ( 300 , wrf_err_message )
 254       CALL nl_set_julday ( grid%id , config_flags%julday )
 255     ENDIF
 256
 257     CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' ,  config_flags%map_proj , 1 , icnt , ierr )
 258     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for MAP_PROJ returns ',config_flags%map_proj
 259     CALL wrf_debug ( 300 , wrf_err_message )
 260     CALL nl_set_map_proj ( grid%id , config_flags%map_proj )
 261
 262     CALL wrf_get_dom_ti_char ( fid , 'MMINLU', mminlu , ierr )
 263     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_char for MMINLU returns ',mminlu(1:4)
 264     CALL wrf_debug ( 300 , wrf_err_message )
 265     CALL nl_set_mminlu ( 1, mminlu(1:4) )
 266
 267     CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' ,  config_flags%iswater , 1 , icnt , ierr )
 268     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISWATER returns ',config_flags%iswater
 269     CALL wrf_debug ( 300 , wrf_err_message )
 270     IF ( ierr .NE. 0 ) THEN
 271          IF (mminlu == 'UMD') THEN
 272               config_flags%iswater = 14
 273          ELSE
 274               config_flags%iswater = 16
 275          ENDIF
 276     ENDIF
 277     CALL nl_set_iswater ( grid%id , config_flags%iswater )
 278
 279     CALL wrf_get_dom_ti_integer ( fid , 'ISICE' ,  config_flags%isice , 1 , icnt , ierr )
 280     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISICE returns ',config_flags%isice
 281     CALL wrf_debug ( 300 , wrf_err_message )
 282     IF ( ierr .NE.  0 ) THEN
 283          IF (mminlu == 'UMD') THEN
 284               config_flags%isice = 14
 285          ELSE
 286               config_flags%isice = 24
 287          ENDIF
 288     ENDIF
 289     CALL nl_set_isice ( grid%id , config_flags%isice )
 290
 291     CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' ,  config_flags%isurban , 1 , icnt , ierr )
 292     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISURBAN returns ',config_flags%isurban
 293     CALL wrf_debug ( 300 , wrf_err_message )
 294     IF ( ierr .NE. 0 ) THEN
 295          IF (mminlu == 'UMD') THEN
 296               config_flags%isurban = 13
 297          ELSE
 298               config_flags%isurban = 1
 299          ENDIF
 300     ENDIF
 301     CALL nl_set_isurban ( grid%id , config_flags%isurban )
 302
 303     CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' ,  config_flags%isoilwater , 1 , icnt , ierr )
 304     WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISOILWATER returns ',config_flags%isoilwater
 305     CALL wrf_debug ( 300 , wrf_err_message )
 306     IF ( ierr .NE. 0 ) THEN
 307          config_flags%isoilwater = 14
 308     ENDIF
 309     CALL nl_set_isoilwater ( grid%id , config_flags%isoilwater )
 310
 311 #ifdef MOVE_NESTS
 312 ! Added these fields for restarting of moving nests, JM
 313 ! DANGER and TODO
 314 ! It is very important that these be set correctly if they are set at all in here.
 315 ! Garbage values will produce unpredictable results, possibly segfaults, in the nesting
 316 ! code. Need some integrity checking here or elsewhere in the code to at least check to
 317 ! make sure that the istart and jstart values make sense with respect to the nest dimensions
 318 ! and the position in the parent domain.
 319     CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' ,  itmp  , 1 , icnt, ierr )
 320     IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
 321       config_flags%i_parent_start = itmp
 322       CALL nl_set_i_parent_start ( grid%id , config_flags%i_parent_start )
 323     ENDIF
 324     CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' ,  itmp  , 1 , icnt, ierr )
 325     IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
 326       config_flags%j_parent_start = itmp
 327       CALL nl_set_j_parent_start ( grid%id , config_flags%j_parent_start )
 328     ENDIF
 329 #endif
 330
 331 ! If this was not a training read (dry run) check for erroneous values.
 332     CALL wrf_inquire_filename ( fid , fname , filestate , ierr )
 333     IF ( ierr /= 0 ) THEN
 334       WRITE(wrf_err_message,*)'module_io_wrf: input_wrf: wrf_inquire_filename Status = ',ierr
 335       CALL wrf_error_fatal( wrf_err_message )
 336     ENDIF
 337
 338     WRITE(wrf_err_message,*)'input_wrf: fid,filestate = ',fid,filestate
 339     CALL wrf_debug( 300 , wrf_err_message )
 340
 341     dryrun        = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
 342
 343     WRITE(wrf_err_message,*)'input_wrf: dryrun = ',dryrun
 344     CALL wrf_debug( 300 , wrf_err_message )
 345
 346     check_if_dryrun : IF ( .NOT. dryrun ) THEN
 347
 348 #if (EM_CORE == 1)
 349
 350 !KLUDGE - is there a more elegant way to determine "old si" input
 351     IF      ( ( switch .EQ.     model_input_only  ) .OR. &
 352             ( ( switch .EQ. aux_model_input1_only ) .AND. &
 353               ( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) ) THEN
 354
 355        !  Test to make sure that the input data is the right size.
 356
 357        IF ( ( ide .NE. ide_compare    ) .OR. &
 358             ( kde .NE. kde_compare    ) .OR. &
 359             ( jde .NE. jde_compare    ) ) THEN
 360           WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  namelist ide,jde,kde=',ide,jde,kde,&
 361                                   '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
 362           CALL wrf_error_fatal( wrf_err_message )
 363        ENDIF
 364
 365     ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
 366
 367        !  Test to make sure that the input data is the right size.
 368
 369        IF ( ( ide                             .NE. ide_compare ) .OR. &
 370             ( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
 371             ( jde                             .NE. jde_compare ) ) THEN
 372          WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  ',&
 373                                  'namelist ide,jde,num_metgrid_levels=',ide,jde,config_flags%num_metgrid_levels,&
 374                                  '; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
 375          CALL wrf_error_fatal( wrf_err_message )
 376        ENDIF
 377     ENDIF
 378
 379 #endif
 380
 381 #if (NMM_CORE == 1)
 382
 383     IF      ( ( switch .EQ. aux_model_input1_only  ) .AND. &
 384               ( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) THEN
 385
 386        CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMSNSION' ,   kde_compare , 1 , icnt , ierr3 )
 387
 388        !  Test to make sure that the input data is the right size.
 389
 390        IF ( ( ide-1 .NE. ide_compare    ) .OR. &
 391             ( kde   .NE. kde_compare    ) .OR. &
 392             ( jde-1 .NE. jde_compare    ) .AND. ierr3 .EQ. 0 ) THEN
 393           WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  namelist ide-1,jde-1,kde=',ide-1,jde-1,kde,&
 394                                   '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
 395           CALL wrf_debug( 100, wrf_err_message )
 396        ENDIF
 397
 398        ELSEIF ( switch .EQ. aux_model_input1_only ) THEN          ! assume just WPS in this branch
 399          IF ( ( ide-1                           .NE. ide_compare ) .OR. &
 400             ( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
 401             ( jde-1                             .NE. jde_compare ) .AND. ierr3 .EQ. 0 ) THEN
 402                 WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  ',&
 403                  'namelist ide-1,jde-1,num_metgrid_levels=',ide-1,jde-1,config_flags%num_metgrid_levels,&
 404                  '; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
 405                 IF (ide-1 .eq. ide_compare .AND. jde-1 .EQ. jde_compare) THEN
 406                   CALL wrf_message(wrf_err_message)
 407                   CALL wrf_error_fatal( "appears that the vertical dimension is wrong - quitting" )
 408                 ELSE
 409                   CALL wrf_message(wrf_err_message)
 410                   CALL wrf_error_fatal( "appears that I or J dimensions are wrong - quitting" )
 411                 ENDIF
 412          ENDIF
 413        ENDIF
 414
 415 #endif
 416
 417     ENDIF check_if_dryrun
 418
 419 !
 420 ! This call to wrf_get_next_time will position the dataset over the next time-frame
 421 ! in the file and return the current_date, which is used as an argument to the
 422 ! read_field routines in the blocks of code included below.  Note that we read the
 423 ! next time *after* all the meta data has been read. This is only important for the
 424 ! WRF internal I/O format because it is order-dependent. Other formats shouldn't care
 425 ! about this.
 426 !
 427
 428     3003 continue
 429
 430     CALL wrf_get_next_time(fid, current_date , ierr)
 431     WRITE(wrf_err_message,*)fid,' input_wrf: wrf_get_next_time current_date: ',current_date(1:19),' Status = ',ierr
 432     CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
 433     IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
 434       CALL wrf_message ( TRIM(wrf_err_message ) )
 435       IF ( switch .EQ. boundary_only ) THEN
 436         WRITE(wrf_err_message,*) ' ... May have run out of valid boundary conditions in file ',TRIM(fname)
 437         CALL wrf_error_fatal( TRIM(wrf_err_message) )
 438       ELSE
 439 #if ( NMM_CORE != 1 )
 440         WRITE(wrf_err_message,*) '... Could not find matching time in input file ',TRIM(fname)
 441         CALL wrf_error_fatal( TRIM(wrf_err_message) )
 442 #endif
 443       ENDIF
 444     ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ) THEN
 445 !
 446 ! check input time against domain time (which will be start time at beginning, see share/set_timekeeping.F)
 447 ! JM 20040511
 448 !
 449       SELECT CASE ( switch )
 450         CASE ( model_input_only, aux_model_input1_only, aux_model_input2_only,       &
 451                aux_model_input3_only, aux_model_input4_only, aux_model_input5_only, aux_model_input10_only )
 452 #ifdef WRF_CHEM
 453            IF( (config_flags%io_style_emissions .eq. 1) .and.                       &
 454               ((switch.eq.aux_model_input4_only) .or. (switch.eq.aux_model_input5_only)) )then
 455                CALL wrf_message( "**WARNING** Time in input file not being checked **WARNING**" )
 456            ELSE
 457 #endif
 458             CALL wrf_atotime( current_date(1:19), time )
 459             CALL domain_clock_get( grid, current_time=currtime, &
 460                                          current_timestr=currtimestr )
 461 #if (DA_CORE != 1)
 462 ! Don't perform the check for WRFVAR, as we're not passing the right dates
 463 ! around
 464             CALL domain_clockprint(150, grid, &
 465                    'DEBUG input_wrf():  get CurrTime from clock,')
 466             IF ( time .NE. currtime ) THEN
 467                 WRITE( wrf_err_message , * )'Time in file: ',trim( current_date(1:19) )
 468                 CALL wrf_message ( trim(wrf_err_message) )
 469                 WRITE( wrf_err_message , * )'Time on domain: ',trim( currtimestr )
 470                 CALL wrf_message ( trim(wrf_err_message) )
 471                 CALL wrf_message( "**WARNING** Time in input file not equal to time on domain **WARNING**" )
 472                 WRITE(wrf_err_message,*) "**WARNING** Trying next time in file ",TRIM(fname)," ..."
 473                 CALL wrf_message( TRIM(wrf_err_message) )
 474                 GOTO 3003
 475             ENDIF
 476 #endif
 477 #ifdef WRF_CHEM
 478             ENDIF
 479 #endif
 480         CASE DEFAULT
 481       END SELECT
 482     ENDIF
 483
 484 ! set the lbc time interval fields in the domain data structure
 485 ! these time values are checked as stopping condition for the while loop in
 486 ! latbound_in() defined in share/medation_integrate.F, which is used to
 487 ! iterate forward to the correct interval in the input LBC file
 488 !
 489     IF ( switch .EQ. boundary_only ) THEN
 490         CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' ,  current_date(1:19), this_datestr , ierr )
 491         CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
 492         CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' ,  current_date(1:19), next_datestr , ierr )
 493         CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
 494     ENDIF
 495
 496 #if 1
 497     IF      ( switch .EQ. model_input_only ) THEN
 498       CALL wrf_inputin( fid , grid , config_flags , switch , ierr )
 499     ELSE IF ( switch .EQ. history_only ) THEN
 500       CALL wrf_histin( fid , grid , config_flags , switch , ierr )
 501     ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
 502       CALL wrf_auxinput1in( fid , grid , config_flags , switch , ierr )
 503     ELSE IF ( switch .EQ. aux_model_input2_only ) THEN
 504       CALL wrf_auxinput2in( fid , grid , config_flags , switch , ierr )
 505     ELSE IF ( switch .EQ. aux_model_input3_only ) THEN
 506       CALL wrf_auxinput3in( fid , grid , config_flags , switch , ierr )
 507     ELSE IF ( switch .EQ. aux_model_input4_only ) THEN
 508       CALL wrf_auxinput4in( fid , grid , config_flags , switch , ierr )
 509     ELSE IF ( switch .EQ. aux_model_input5_only ) THEN
 510       CALL wrf_auxinput5in( fid , grid , config_flags , switch , ierr )
 511     ELSE IF ( switch .EQ. aux_model_input6_only ) THEN
 512       CALL wrf_auxinput6in( fid , grid , config_flags , switch , ierr )
 513     ELSE IF ( switch .EQ. aux_model_input7_only ) THEN
 514       CALL wrf_auxinput7in( fid , grid , config_flags , switch , ierr )
 515     ELSE IF ( switch .EQ. aux_model_input8_only ) THEN
 516       CALL wrf_auxinput8in( fid , grid , config_flags , switch , ierr )
 517     ELSE IF ( switch .EQ. aux_model_input9_only ) THEN
 518       CALL wrf_auxinput9in( fid , grid , config_flags , switch , ierr )
 519     ELSE IF ( switch .EQ. aux_model_input10_only ) THEN
 520       CALL wrf_auxinput10in( fid , grid , config_flags , switch , ierr )
 521     ELSE IF ( switch .EQ. aux_model_input11_only ) THEN
 522       CALL wrf_auxinput11in( fid , grid , config_flags , switch , ierr )
 523
 524
 525     ELSE IF ( switch .EQ. aux_hist1_only ) THEN
 526       CALL wrf_auxhist1in( fid , grid , config_flags , switch , ierr )
 527     ELSE IF ( switch .EQ. aux_hist2_only ) THEN
 528       CALL wrf_auxhist2in( fid , grid , config_flags , switch , ierr )
 529     ELSE IF ( switch .EQ. aux_hist3_only ) THEN
 530       CALL wrf_auxhist3in( fid , grid , config_flags , switch , ierr )
 531     ELSE IF ( switch .EQ. aux_hist4_only ) THEN
 532       CALL wrf_auxhist4in( fid , grid , config_flags , switch , ierr )
 533     ELSE IF ( switch .EQ. aux_hist5_only ) THEN
 534       CALL wrf_auxhist5in( fid , grid , config_flags , switch , ierr )
 535     ELSE IF ( switch .EQ. aux_hist6_only ) THEN
 536       CALL wrf_auxhist6in( fid , grid , config_flags , switch , ierr )
 537     ELSE IF ( switch .EQ. aux_hist7_only ) THEN
 538       CALL wrf_auxhist7in( fid , grid , config_flags , switch , ierr )
 539     ELSE IF ( switch .EQ. aux_hist8_only ) THEN
 540       CALL wrf_auxhist8in( fid , grid , config_flags , switch , ierr )
 541     ELSE IF ( switch .EQ. aux_hist9_only ) THEN
 542       CALL wrf_auxhist9in( fid , grid , config_flags , switch , ierr )
 543     ELSE IF ( switch .EQ. aux_hist10_only ) THEN
 544       CALL wrf_auxhist10in( fid , grid , config_flags , switch , ierr )
 545     ELSE IF ( switch .EQ. aux_hist11_only ) THEN
 546       CALL wrf_auxhist11in( fid , grid , config_flags , switch , ierr )
 547
 548     ELSE IF ( switch .EQ. restart_only ) THEN
 549       CALL wrf_restartin( fid , grid , config_flags , switch , ierr )
 550     ELSE IF ( switch .EQ. boundary_only ) THEN
 551       CALL wrf_bdyin( fid , grid , config_flags , switch , ierr )
 552     ENDIF
 553
 554     CALL wrf_tsin( grid , ierr )
 555 #else
 556     CALL wrf_message ( "ALL I/O DISABLED IN share/module_io_wrf.F")
 557 #endif
 558
 559     WRITE(wrf_err_message,*)'input_wrf: end, fid = ',fid
 560     CALL wrf_debug( 300 , wrf_err_message )
 561
 562     RETURN
 563   END SUBROUTINE input_wrf