!WRF:MEDIATION:IO
!  ---principal wrf input routine (called from routines in module_io_domain )

  SUBROUTINE input_wrf ( fid , grid , config_flags , switch , ierr )
    USE module_domain
    USE module_state_description
    USE module_configure
    USE module_io
    USE module_io_wrf
    USE module_date_time
    USE module_bc_time_utilities
    USE module_utility

    IMPLICIT NONE
#include <wrf_io_flags.h>
#include <wrf_status_codes.h>
    TYPE(domain) :: grid
    TYPE(grid_config_rec_type),  INTENT(INOUT)    :: config_flags
    INTEGER, INTENT(IN) :: fid
    INTEGER, INTENT(IN) :: switch
    INTEGER, INTENT(INOUT) :: ierr

    ! Local data
    INTEGER ids , ide , jds , jde , kds , kde , &
            ims , ime , jms , jme , kms , kme , &
            ips , ipe , jps , jpe , kps , kpe

    TYPE( fieldlist ), POINTER :: p

    INTEGER newswitch, itrace

    INTEGER       iname(9)
    INTEGER       iordering(3)
    INTEGER       icurrent_date(24)
    INTEGER       i,j,k
    INTEGER       icnt
    INTEGER       ndim
    INTEGER       ilen
    INTEGER , DIMENSION(3) :: domain_start , domain_end
    INTEGER , DIMENSION(3) :: memory_start , memory_end
    INTEGER , DIMENSION(3) :: patch_start , patch_end
    CHARACTER*256 errmess, currtimestr
    CHARACTER*40            :: this_datestr, next_datestr
    CHARACTER*9   NAMESTR
    INTEGER       IBDY, NAMELEN
    LOGICAL wrf_dm_on_monitor
    EXTERNAL wrf_dm_on_monitor
    Type(WRFU_Time) time, currtime, currentTime
    CHARACTER*19  new_date
    CHARACTER*24  base_date
    CHARACTER*80  fname
    CHARACTER*80  dname, memord, sim_type
    LOGICAL dryrun
    INTEGER idt
    INTEGER itmp
    INTEGER filestate, ierr3
    INTEGER :: ide_compare , jde_compare , kde_compare
    CHARACTER (len=19) simulation_start_date , first_date_input , first_date_nml
    INTEGER first_date_start_year   , &
            first_date_start_month  , &
            first_date_start_day    , &
            first_date_start_hour   , &
            first_date_start_minute , &
            first_date_start_second
    INTEGER simulation_start_year   , &
            simulation_start_month  , &
            simulation_start_day    , &
            simulation_start_hour   , &
            simulation_start_minute , &
            simulation_start_second
    LOGICAL reset_simulation_start
    REAL dx_compare , dy_compare , dum
    INTEGER :: num_land_cat_compare
    CHARACTER (LEN=256) :: MMINLU

    !  Local variables for vertical interpolation.

    REAL, ALLOCATABLE, DIMENSION(:      ) ::  f_vint_1d
    REAL, ALLOCATABLE, DIMENSION(:,:,:  ) ::  f_vint_3d
    REAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::  f_vint_4d
    integer :: ed1_c,em1_c,ep1_c
    integer :: ed2_c,em2_c,ep2_c
    integer :: n_ref_m,i_inter

    !  Local variables for the alarms in the input restart file.

    INTEGER max_wrf_alarms_compare, seconds
    CHARACTER*80 alarmname, timestr
    TYPE(WRFU_Time) :: curtime, ringTime
    TYPE(WRFU_TimeInterval) :: interval, interval2
    integer s, iring

    !  Local variables: are we are using the correct hypsometric option for ARW ideal cases.

    CHARACTER (LEN=80) :: input_name
    INTEGER :: loop, hypsometric_opt, icount

    CHARACTER (LEN=256) :: a_message


!<DESCRIPTION>
!
! Core wrf input routine for all input data streams. Part of mediation layer.
!
! Note that WRF IOAPI routines wrf_get_dom_ti_*() do not return values during
! training reads (dryrun).
!
!</DESCRIPTION>

    WRITE(wrf_err_message,*)'input_wrf: begin'
    CALL wrf_debug( 300 , wrf_err_message )

    CALL modify_io_masks ( grid%id )   ! this adjusts the I/O masks according to the users run-time specs, if any

    ierr = 0

    CALL get_ijk_from_grid (  grid ,                        &
                              ids, ide, jds, jde, kds, kde,    &
                              ims, ime, jms, jme, kms, kme,    &
                              ips, ipe, jps, jpe, kps, kpe    )

! If this was not a training read (dry run) check for erroneous values.
    CALL wrf_inquire_filename ( fid , fname , filestate , ierr )
    IF ( ierr /= 0 ) THEN
      WRITE(wrf_err_message,*)'module_io_wrf: input_wrf: wrf_inquire_filename Status = ',ierr
      CALL wrf_error_fatal( wrf_err_message )
    ENDIF

    WRITE(wrf_err_message,*)'input_wrf: filestate = ',filestate
    CALL wrf_debug( 300 , wrf_err_message )

    dryrun        = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )

    WRITE(wrf_err_message,*)'input_wrf: dryrun = ',dryrun,' switch ',switch
    CALL wrf_debug( 300 , wrf_err_message )

    check_if_dryrun : IF ( .NOT. dryrun ) THEN

#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
      IF ( switch .EQ. boundary_only ) THEN
         grid%just_read_boundary = .true.
      END IF
#endif

      ! INPUT ONLY (KK)

      IF ( switch .EQ. restart_only ) THEN

        ! recover the restart alarms from input if available
 
        CALL wrf_get_dom_ti_integer( fid , 'MAX_WRF_ALARMS', max_wrf_alarms_compare, 1, icnt, ierr )
        IF ( max_wrf_alarms_compare .NE. MAX_WRF_ALARMS ) THEN
          WRITE(wrf_err_message,*)'MAX_WRF_ALARMS different in restart file (',max_wrf_alarms_compare,&
                                  ') from in code (',MAX_WRF_ALARMS,').  Disregarding info in restart file.'
        ELSE
          curtime = domain_get_current_time( grid )
          DO i = auxinput1_only, MAX_WRF_ALARMS
            IF ( grid%alarms_created(i) .AND. .NOT. i .EQ. boundary_only ) THEN
              write(alarmname,'("WRF_ALARM_ISRINGING_",i2.2)')i
              CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), iring, 1, icnt, ierr )
  
              write(alarmname,'("WRF_ALARM_SECS_TIL_NEXT_RING_",i2.2)')i
              CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), seconds, 1, icnt, ierr )
              IF ( ierr .EQ. 0 &
                   .AND. seconds .GE. 0 ) THEN  ! disallow negative intervals; can happen with wrfbdy datasets
                                                ! which keep time differently
  
                ! Get and set interval so that we are sure to have both the
                ! interval and first ring time set correctly
                CALL WRFU_AlarmGet( grid%alarms(i), ringinterval=interval2 )

                IF (config_flags%override_restart_timers) THEN
                   IF (i .EQ. restart_only) THEN
                      seconds = grid%restart_interval_d * 86400 + &
                                grid%restart_interval_h *  3600 + &
                                grid%restart_interval_m *    60 + &
                                grid%restart_interval   *    60 + &
                                grid%restart_interval_s
                   ENDIF
                ENDIF

                CALL WRFU_TimeIntervalSet(interval,S=seconds)
                ringTime = curtime + interval
                CALL WRFU_AlarmSet( grid%alarms(i), RingInterval=interval2, RingTime=ringTime )

              ENDIF

              IF ( iring .EQ. 1 ) THEN
                CALL WRFU_AlarmRingerOn( grid%alarms( i ) )
              ELSE
                CALL WRFU_AlarmRingerOff( grid%alarms( i ) )
              ENDIF
            ENDIF
          ENDDO
        ENDIF

     
     !OUTPUT ONLY (KK)

      IF ( switch .EQ. restart_only .AND. .NOT. config_flags%override_restart_timers ) THEN

        ! recover the restart alarms from input if available
 
        CALL wrf_get_dom_ti_integer( fid , 'MAX_WRF_ALARMS', max_wrf_alarms_compare, 1, icnt, ierr )
        IF ( max_wrf_alarms_compare .NE. MAX_WRF_ALARMS ) THEN
          WRITE(wrf_err_message,*)'MAX_WRF_ALARMS different in restart file (',max_wrf_alarms_compare,&
                                  ') from in code (',MAX_WRF_ALARMS,').  Disregarding info in restart file.'
        ELSE
          curtime = domain_get_current_time( grid )
          DO i = 1, auxinput1_only-1
            IF ( grid%alarms_created(i) .AND. .NOT. i .EQ. boundary_only ) THEN
              write(alarmname,'("WRF_ALARM_ISRINGING_",i2.2)')i
              CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), iring, 1, icnt, ierr )
  
              write(alarmname,'("WRF_ALARM_SECS_TIL_NEXT_RING_",i2.2)')i
              CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), seconds, 1, icnt, ierr )
              IF ( ierr .EQ. 0 &
                   .AND. seconds .GE. 0 ) THEN  ! disallow negative intervals; can happen with wrfbdy datasets
                                                ! which keep time differently
  
                ! Get and set interval so that we are sure to have both the
                ! interval and first ring time set correctly
                CALL WRFU_AlarmGet( grid%alarms(i), ringinterval=interval2 )

                IF (config_flags%override_restart_timers) THEN
                   IF (i .EQ. history_only) THEN
                      seconds = grid%history_interval_d * 86400 + &
                                grid%history_interval_h *  3600 + &
                                grid%history_interval_m *    60 + &
                                grid%history_interval   *    60 + &
                                grid%history_interval_s
                   ENDIF
                ENDIF

                CALL WRFU_TimeIntervalSet(interval,S=seconds)
                ringTime = curtime + interval
                CALL WRFU_AlarmSet( grid%alarms(i), RingInterval=interval, RingTime=ringTime )

              ENDIF

              IF ( iring .EQ. 1 ) THEN
                CALL WRFU_AlarmRingerOn( grid%alarms( i ) )
              ELSE
                CALL WRFU_AlarmRingerOff( grid%alarms( i ) )
              ENDIF
            ENDIF
          ENDDO
        ENDIF

      ENDIF

      CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_START_DATE' , simulation_start_date , ierr )
      CALL nl_get_reset_simulation_start ( 1, reset_simulation_start )

      IF ( ( ierr .EQ. 0 ) .AND. ( .NOT. reset_simulation_start ) ) THEN
        ! Overwrite simulation start date with metadata.
#ifdef PLANET
        READ ( simulation_start_date , fmt = '(I4,1x,I5,1x,I2,1x,I2,1x,I2)' )       &
               simulation_start_year,                                               &
               simulation_start_day,    simulation_start_hour,                      &
               simulation_start_minute, simulation_start_second
        simulation_start_month = 0
#else
        READ ( simulation_start_date , fmt = '(I4,1x,I2,1x,I2,1x,I2,1x,I2,1x,I2)' ) &
               simulation_start_year,   simulation_start_month,                     &
               simulation_start_day,    simulation_start_hour,                      &
               simulation_start_minute, simulation_start_second
#endif
        CALL nl_set_simulation_start_year   ( 1 , simulation_start_year   )
        CALL nl_set_simulation_start_month  ( 1 , simulation_start_month  )
        CALL nl_set_simulation_start_day    ( 1 , simulation_start_day    )
        CALL nl_set_simulation_start_hour   ( 1 , simulation_start_hour   )
        CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
        CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
        IF ( switch .EQ. input_only  ) THEN
          WRITE(wrf_err_message,*) ' input_wrf, input_only:  SIMULATION_START_DATE = ', &
                                  simulation_start_date(1:19)
          CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
        ELSE IF ( switch .EQ. restart_only  ) THEN
          WRITE(wrf_err_message,*) ' input_wrf, restart_only:  SIMULATION_START_DATE = ', &
                                  simulation_start_date(1:19)
          CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
        ENDIF
      ELSE
        CALL nl_get_start_year   ( 1 , simulation_start_year   )
        CALL nl_get_start_month  ( 1 , simulation_start_month  )
        CALL nl_get_start_day    ( 1 , simulation_start_day    )
        CALL nl_get_start_hour   ( 1 , simulation_start_hour   )
        CALL nl_get_start_minute ( 1 , simulation_start_minute )
        CALL nl_get_start_second ( 1 , simulation_start_second )
        CALL nl_set_simulation_start_year   ( 1 , simulation_start_year   )
        CALL nl_set_simulation_start_month  ( 1 , simulation_start_month  )
        CALL nl_set_simulation_start_day    ( 1 , simulation_start_day    )
        CALL nl_set_simulation_start_hour   ( 1 , simulation_start_hour   )
        CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
        CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
        IF ( reset_simulation_start ) THEN
          CALL wrf_message('input_wrf: forcing SIMULATION_START_DATE = head_grid start time')
          CALL wrf_message('           due to namelist variable reset_simulation_start')
        ELSE
          CALL wrf_message('input_wrf: SIMULATION_START_DATE not available in input')
          CALL wrf_message('will use head_grid start time from namelist')
        ENDIF
      ENDIF
      ! Initialize derived time quantity in grid%xtime.
      ! Note that this call is also made in setup_timekeeping().
      ! Ugh, what a hack.  Simplify all this later...
      CALL domain_clock_get( grid, minutesSinceSimulationStart=grid%xtime )
      ! Note that it is NOT necessary to reset grid%julian here.
      WRITE(wrf_err_message,*) 'input_wrf:  set xtime to ',grid%xtime
      CALL wrf_debug ( 100, TRIM(wrf_err_message) )
    ELSE IF ( switch .EQ. auxinput1_only ) then
      CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_START_DATE' , first_date_input , ierr )
      WRITE(wrf_err_message,*)'metgrid input_wrf.F first_date_input = ',first_date_input
      CALL wrf_message(wrf_err_message)
      CALL nl_get_start_year   ( 1 , first_date_start_year   )
      CALL nl_get_start_month  ( 1 , first_date_start_month  )
      CALL nl_get_start_day    ( 1 , first_date_start_day    )
      CALL nl_get_start_hour   ( 1 , first_date_start_hour   )
      CALL nl_get_start_minute ( 1 , first_date_start_minute )
      CALL nl_get_start_second ( 1 , first_date_start_second )
      WRITE ( first_date_nml, fmt = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
             first_date_start_year,   first_date_start_month,                     &
             first_date_start_day,    first_date_start_hour,                      &
             first_date_start_minute, first_date_start_second
      WRITE (wrf_err_message,*) 'metgrid input_wrf.F first_date_nml = ',first_date_nml
      CALL wrf_message( TRIM(wrf_err_message ) )
    ENDIF

    !  Test to make sure that the input data is the right size.  Do this for input from real/ideal into
    !  WRF, and from the standard initialization into real.

    IF ( ( switch .EQ.     input_only  ) .OR. &
         ( switch .EQ. auxinput1_only ) ) THEN
       ierr = 0
       CALL wrf_get_dom_ti_integer ( fid , 'WEST-EAST_GRID_DIMENSION' ,    ide_compare , 1 , icnt , ierr3 )
       ierr = max( ierr, ierr3 )
       CALL wrf_get_dom_ti_integer ( fid , 'SOUTH-NORTH_GRID_DIMENSION' ,  jde_compare , 1 , icnt , ierr3 )
       ierr = max( ierr, ierr3 )
       CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMENSION' ,   kde_compare , 1 , icnt , ierr3 )
       ierr = max( ierr, ierr3 )
       IF ( ierr3 .NE. 0 ) CALL wrf_error_fatal( 'wrf_get_dom_ti_integer getting dimension information from dataset' )

#if (EM_CORE == 1)

       !  Test to make sure that the grid distances are the right size.

       CALL wrf_get_dom_ti_real ( fid , 'DX' ,  dx_compare , 1 , icnt , ierr )
       CALL wrf_get_dom_ti_real ( fid , 'DY' ,  dy_compare , 1 , icnt , ierr )

       IF ( ( ABS ( dx_compare - config_flags%dx ) .GT. 1.E-5 * dx_compare ) .OR. &
            ( ABS ( dy_compare - config_flags%dy ) .GT. 1.E-5 * dy_compare ) ) THEN
          IF ( ( config_flags%polar ) .AND. ( config_flags%grid_id .EQ. 1 ) ) THEN
             WRITE(wrf_err_message,*)'input_wrf: DX and DY from input file expected to be wrong'
             CALL wrf_debug ( 1 , wrf_err_message )
          ELSE
             WRITE(wrf_err_message,*)'dx and dy from file     ',dx_compare,dy_compare
             CALL wrf_message(wrf_err_message)
             WRITE(wrf_err_message,*)'dx and dy from namelist ',config_flags%dx,config_flags%dy
             CALL wrf_message(wrf_err_message)
             CALL wrf_error_fatal( 'DX and DY do not match comparing namelist to the input file' )
          END IF
       END IF
#endif
    END IF

#if (EM_CORE == 1)
    IF ( ( switch .EQ. input_only ) .OR. ( switch .EQ. auxinput2_only ) .OR. ( switch .EQ. auxinput1_only ) ) THEN
       ierr  = 0
       ierr3 = 0
       IF      ( ( ( switch .EQ. input_only ) .AND. ( grid%id .GE. 2 ) ) .OR. ( switch .EQ. auxinput2_only ) ) THEN
          CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' ,    itmp , 1 , icnt , ierr3 )
       ELSE IF ( ( switch .EQ. auxinput1_only ) .AND. ( grid%id .GE. 2 ) ) THEN
          CALL wrf_get_dom_ti_integer ( fid , 'i_parent_start' ,    itmp , 1 , icnt , ierr3 )
       ELSE IF ( ( ( switch .EQ. auxinput1_only ) .OR. ( switch .EQ. input_only ) ) .AND. ( grid%id .EQ. 1 ) ) THEN
          itmp  = config_flags%i_parent_start
          ierr3 = 0 
       END IF
       ierr = max( ierr, ierr3 )
       IF ( itmp .NE. config_flags%i_parent_start ) THEN
          ierr = 1
          WRITE(wrf_err_message,*)'i_parent_start from namelist.input file = ',config_flags%i_parent_start
          CALL wrf_message(wrf_err_message)
          WRITE(wrf_err_message,*)'i_parent_start from gridded input file  = ',itmp
          CALL wrf_message(wrf_err_message)
       END IF
       IF      ( ( ( switch .EQ. input_only ) .AND. ( grid%id .GE. 2 ) ) .OR. ( switch .EQ. auxinput2_only ) ) THEN
          CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' ,    itmp , 1 , icnt , ierr3 )
       ELSE IF ( ( switch .EQ. auxinput1_only ) .AND. ( grid%id .GE. 2 ) ) THEN
          CALL wrf_get_dom_ti_integer ( fid , 'j_parent_start' ,    itmp , 1 , icnt , ierr3 )
       ELSE IF ( ( ( switch .EQ. auxinput1_only ) .OR. ( switch .EQ. input_only ) ) .AND. ( grid%id .EQ. 1 ) ) THEN
          itmp  = config_flags%j_parent_start
          ierr3 = 0 
       END IF
       ierr = max( ierr, ierr3 )
       IF ( itmp .NE. config_flags%j_parent_start ) THEN
          ierr = 1
          WRITE(wrf_err_message,*)'j_parent_start from namelist.input file = ',config_flags%j_parent_start
          CALL wrf_message(wrf_err_message)
          WRITE(wrf_err_message,*)'j_parent_start from gridded input file  = ',itmp
          CALL wrf_message(wrf_err_message)
       END IF
       IF ( ierr .NE. 0 ) THEN
          CALL wrf_error_fatal( 'Nest start locations do not match: namelist.input vs gridded input file' )
       END IF
    END IF
#endif

    ! do the check later (see check_if_dryrun below)

    !  We do not want the CEN_LAT LON values from the boundary file.  For 1-way nests
    !  with ndown, this ends up being the data from the previous coarse domain.

    IF ( switch .NE. boundary_only ) THEN
       CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' ,  config_flags%cen_lat , 1 , icnt , ierr )
       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',config_flags%cen_lat
       CALL wrf_debug ( 300 , wrf_err_message )
       CALL nl_set_cen_lat ( grid%id , config_flags%cen_lat )

       CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' ,  config_flags%cen_lon , 1 , icnt , ierr )
       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',config_flags%cen_lon
       CALL wrf_debug ( 300 , wrf_err_message )
       CALL nl_set_cen_lon ( grid%id , config_flags%cen_lon )
    ELSE
       CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' ,  dum , 1 , icnt , ierr )
       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',dum
       CALL wrf_debug ( 300 , wrf_err_message )

       CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' ,  dum , 1 , icnt , ierr )
       WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',dum
       CALL wrf_debug ( 300 , wrf_err_message )
    END IF

    CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' ,  config_flags%truelat1 , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT1 returns ',config_flags%truelat1
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_truelat1 ( grid%id , config_flags%truelat1 )

    CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' ,  config_flags%truelat2 , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT2 returns ',config_flags%truelat2
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_truelat2 ( grid%id , config_flags%truelat2 )

    CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' ,  config_flags%moad_cen_lat , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for MOAD_CEN_LAT returns ',config_flags%moad_cen_lat
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_moad_cen_lat ( grid%id , config_flags%moad_cen_lat )

    CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' ,  config_flags%stand_lon , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for STAND_LON returns ',config_flags%stand_lon
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_stand_lon ( grid%id , config_flags%stand_lon )

#if ( NMM_CORE != 1 )

    CALL wrf_get_dom_ti_real ( fid , 'POLE_LAT' ,  config_flags%pole_lat , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for POLE_LAT returns ',config_flags%pole_lat
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_pole_lat ( grid%id , config_flags%pole_lat )

    CALL wrf_get_dom_ti_real ( fid , 'POLE_LON' ,  config_flags%pole_lon , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for POLE_LON returns ',config_flags%pole_lon
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_pole_lon ( grid%id , config_flags%pole_lon )

! program_name is defined in module_domain and set in the main program for whatever application
! is using subroutine input_wrf (that is, the subroutine you are looking at here). Data files
! written by SI have P_TOP as a metadata item; the real program and wrf model have it as a
! state variable. This test is to supress non-fatal but confusing messages from the model complaining
! that P_TOP cannot be read from the metadata for this dataset.  JM 20040905
!
! Note, P_TOP is not defined in the NMM core.

    IF ( program_name(1:7) .EQ. "REAL_EM" ) THEN
      CALL wrf_get_dom_ti_real ( fid , 'P_TOP' ,  grid%p_top , 1 , icnt , ierr )
      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for P_TOP returns ',grid%p_top
      CALL wrf_debug ( 300 , wrf_err_message )
    ENDIF
#endif

    IF ( switch .NE. boundary_only ) THEN
      CALL wrf_get_dom_ti_real ( fid , 'GMT' ,  config_flags%gmt , 1 , icnt , ierr )
      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for GMT returns ',config_flags%gmt
      CALL wrf_debug ( 300 , wrf_err_message )
      CALL nl_set_gmt ( grid%id , config_flags%gmt )

      CALL wrf_get_dom_ti_integer ( fid , 'JULYR' ,  config_flags%julyr , 1 , icnt , ierr )
      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULYR returns ',config_flags%julyr
      CALL wrf_debug ( 300 , wrf_err_message )
      CALL nl_set_julyr ( grid%id , config_flags%julyr )

      CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' ,  config_flags%julday , 1 , icnt , ierr )
      WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULDAY returns ',config_flags%julday
      CALL wrf_debug ( 300 , wrf_err_message )
      CALL nl_set_julday ( grid%id , config_flags%julday )
    ENDIF

    CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' ,  config_flags%map_proj , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for MAP_PROJ returns ',config_flags%map_proj
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_map_proj ( grid%id , config_flags%map_proj )
    grid%map_proj = config_flags%map_proj

    CALL wrf_get_dom_ti_char ( fid , 'MMINLU', mminlu , ierr )
#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
    IF ( ( ( switch .EQ. input_only ) .OR. ( switch .EQ. restart_only ) ) .AND. &
         ( ( config_flags%io_form_input .EQ.  2 ) .OR. &
           ( config_flags%io_form_input .EQ. 11 ) ) ) THEN
      CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_INITIALIZATION_TYPE', sim_type , icnt )
      IF ( TRIM(sim_type) .NE. "IDEALIZED DATA" ) THEN
        IF ( ierr .NE. 0 ) THEN
          WRITE(wrf_err_message,*)'MMINLU error on input'
          mminlu = " "
          CALL wrf_debug ( 0 , wrf_err_message )
        END IF
      END IF
    ELSE IF ( ( switch .EQ. input_only ) .OR. ( switch .EQ. restart_only ) ) THEN
      IF ( ierr .NE. 0 ) THEN
        WRITE(wrf_err_message,*)'MMINLU error on input'
        mminlu = " "
        CALL wrf_debug ( 0 , wrf_err_message )
      END IF
    END IF
#endif
    IF ( ierr .EQ. 0 ) THEN
      IF ( ( ( mminlu(1:1) .GE. "A" ) .AND. ( mminlu(1:1) .LE. "Z" ) ) .OR. &
                ( ( mminlu(1:1) .GE. "a" ) .AND. ( mminlu(1:1) .LE. "z" ) ) .OR. &
                ( ( mminlu(1:1) .GE. "0" ) .AND. ( mminlu(1:1) .LE. "9" ) ) ) THEN
         ! no-op, the mminlu field is probably OK
      ELSE IF ( mminlu(1:1) .EQ. " " ) THEN
         mminlu = " "
      ELSE
         mminlu = " "
      END IF
    END IF
    call wrf_debug( 1 , "mminlu = '" // TRIM(mminlu) // "'")
    if (index(mminlu, char(0)) > 0) mminlu(index(mminlu, char(0)):) = " "
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_char for MMINLU returns ' // TRIM(mminlu)
    CALL wrf_debug ( 300 , wrf_err_message )
    CALL nl_set_mminlu ( grid%id, mminlu )

    ! Test to make sure that the number of land categories is set correctly
    ! The default is set to 24 somewhere, from the number of categories
    ! in the traditional USGS dataset

    IF ( ( switch .EQ. input_only )       .OR. & 
         ( switch .EQ. auxinput1_only )   .OR. &
         ( switch .EQ. auxinput2_only ) ) THEN
      call wrf_get_dom_ti_integer(fid, "NUM_LAND_CAT", num_land_cat_compare, 1, icnt, ierr)
      if ( (ierr .NE. 0) .OR. ( num_land_cat_compare .LT. 1 ) .OR. ( num_land_cat_compare .GT. 1000 ) ) then
        IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
          call wrf_debug( 1 , "Must be old WPS data, assuming 20 levels for NUM_LAND_CAT")
          num_land_cat_compare = 20
        ELSE
          call wrf_debug( 1 , "Must be old WPS data, assuming 24 levels for NUM_LAND_CAT")
          num_land_cat_compare = 24
        END IF
      endif
      if ( config_flags%num_land_cat /= num_land_cat_compare ) then
        call wrf_message("----------------- ERROR -------------------")
        WRITE(wrf_err_message,'("namelist    : NUM_LAND_CAT = ",I10)') config_flags%num_land_cat
        call wrf_message(wrf_err_message)
        WRITE(wrf_err_message,'("input files : NUM_LAND_CAT = ",I10, " (from geogrid selections).")') num_land_cat_compare
        call wrf_message(wrf_err_message)
        call wrf_error_fatal("Mismatch between namelist and wrf input files for dimension NUM_LAND_CAT")
      endif
    ENDIF

    ! Test here to check that config_flags%num_metgrid_soil_levels in namelist
    ! is equal to what is in the global attributes of the met_em files.  Note that
    ! if this is not the first time period, we don't really care about soil data.

    IF ( ( switch .EQ. auxinput1_only ) .AND. &
         ( first_date_nml .EQ. first_date_input ) )  THEN
       CALL wrf_get_dom_ti_integer ( fid, 'NUM_METGRID_SOIL_LEVELS', itmp, 1, icnt, ierr )
   
       IF ( ierr .EQ. 0 ) THEN

#if (EM_CORE == 1)
          IF ( itmp .EQ. 1 ) THEN
             call wrf_error_fatal("NUM_METGRID_SOIL_LEVELS must be greater than 1")
          END IF
#endif
          WRITE(wrf_err_message,*)'input_wrf: global attribute NUM_METGRID_SOIL_LEVELS returns ', itmp
          CALL wrf_debug ( 300 , wrf_err_message )
          IF ( config_flags%num_metgrid_soil_levels /= itmp ) THEN
             call wrf_message("----------------- ERROR -------------------")
             WRITE(wrf_err_message,'("namelist    : num_metgrid_soil_levels = ",I10)') config_flags%num_metgrid_soil_levels
             call wrf_message(wrf_err_message)
#if (EM_CORE == 1)
             WRITE(wrf_err_message,'("input files : NUM_METGRID_SOIL_LEVELS = ",I10, " (from met_em files).")') itmp
#else
             WRITE(wrf_err_message,'("input files : NUM_METGRID_SOIL_LEVELS = ",I10, " (from met_nmm files).")') itmp
#endif
             call wrf_message(wrf_err_message)
             call wrf_error_fatal("Mismatch between namelist and global attribute NUM_METGRID_SOIL_LEVELS")
          END IF
       END IF
    END IF

#if 0
#if ( WRF_CHEM == 1 )
    !  Dust erosion static data.

    CALL wrf_get_dom_ti_integer ( fid, 'EROSION_DIM', itmp, 1, icnt, ierr )

    IF ( ierr .EQ. 0 ) THEN
       WRITE(wrf_err_message,*)'input_wrf: global attribute EROSION_DIM returns ', itmp
       CALL wrf_debug ( 300 , wrf_err_message )
       IF ( config_flags%erosion_dim /= itmp ) THEN
          call wrf_message("----------------- ERROR -------------------")
          WRITE(wrf_err_message,'("namelist    : erosion_dim = ",I10)') config_flags%erosion_dim
          call wrf_message(wrf_err_message)
          WRITE(wrf_err_message,'("input files : EROSION_DIM = ",I10, " (from met_em files).")') itmp
          call wrf_message(wrf_err_message)
          call wrf_error_fatal("Mismatch between namelist and global attribute EROSION_DIM")
       END IF
    END IF
#endif
#endif

    ! Test here to check that config_flags%sf_surface_physics in namelist
    ! is equal to what is in the global attributes of the wrfinput files

    IF ( switch .EQ. input_only  ) THEN
       CALL wrf_get_dom_ti_integer ( fid, 'SF_SURFACE_PHYSICS', itmp, 1, icnt, ierr )
       IF ( ierr .EQ. 0 ) THEN
          WRITE(wrf_err_message,*)'input_wrf: global attribute SF_SURFACE_PHYSICS returns ', itmp
          CALL wrf_debug ( 300 , wrf_err_message )
          IF ( config_flags%sf_surface_physics /= itmp ) THEN
             IF ( ( config_flags%sf_surface_physics == LSMSCHEME ) .and. ( itmp == NOAHMPSCHEME ) ) then
                ! All is well.  Noah-MP and Noah have compatible wrfinput files.
             ELSE IF ( ( config_flags%sf_surface_physics == NOAHMPSCHEME ) .and. ( itmp == LSMSCHEME ) ) then
                ! All is well.  Noah-MP and Noah have compatible wrfinput files.
             ELSE
                call wrf_message("----------------- ERROR -------------------")
                WRITE(wrf_err_message,'("namelist    : sf_surface_physics = ",I10)') config_flags%sf_surface_physics
                call wrf_message(wrf_err_message)
                WRITE(wrf_err_message,'("input files : SF_SURFACE_PHYSICS = ",I10, " (from wrfinput files).")') itmp
                call wrf_message(wrf_err_message)
                call wrf_error_fatal("Mismatch between namelist and global attribute SF_SURFACE_PHYSICS")
             END IF
          END IF
       END IF
    END IF


    CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' ,  config_flags%iswater , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISWATER returns ',config_flags%iswater
    CALL wrf_debug ( 300 , wrf_err_message )
    IF ( ierr .NE. 0 ) THEN
         IF (mminlu == 'UMD') THEN
              config_flags%iswater = 14
         ELSE IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
              config_flags%iswater = 17
         ELSE
              config_flags%iswater = 16
         ENDIF
    ENDIF
    CALL nl_set_iswater ( grid%id , config_flags%iswater )
    grid%iswater = config_flags%iswater

    CALL wrf_get_dom_ti_integer ( fid , 'ISLAKE' ,  config_flags%islake , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISLAKE returns ',config_flags%islake
    CALL wrf_debug ( 300 , wrf_err_message )
    IF ( ierr .NE. 0 ) THEN
         config_flags%islake = -1
    ENDIF
    CALL nl_set_islake ( grid%id , config_flags%islake )
    grid%islake = config_flags%islake

    CALL wrf_get_dom_ti_integer ( fid , 'ISICE' ,  config_flags%isice , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISICE returns ',config_flags%isice
    CALL wrf_debug ( 300 , wrf_err_message )
    IF ( ierr .NE.  0 ) THEN
         IF (mminlu == 'UMD') THEN
              config_flags%isice = 14
         ELSE IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
              config_flags%isice = 15
         ELSE
              config_flags%isice = 24
         ENDIF
    ENDIF
    CALL nl_set_isice ( grid%id , config_flags%isice )
    grid%isice = config_flags%isice

    CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' ,  config_flags%isurban , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISURBAN returns ',config_flags%isurban
    CALL wrf_debug ( 300 , wrf_err_message )
    IF ( ierr .NE. 0 ) THEN
         IF (mminlu == 'UMD') THEN
              config_flags%isurban = 13
         ELSE IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
              config_flags%isurban = 13
         ELSE
              config_flags%isurban = 1
         ENDIF
    ENDIF
    CALL nl_set_isurban ( grid%id , config_flags%isurban )
    grid%isurban = config_flags%isurban

    CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' ,  config_flags%isoilwater , 1 , icnt , ierr )
    WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISOILWATER returns ',config_flags%isoilwater
    CALL wrf_debug ( 300 , wrf_err_message )
    IF ( ierr .NE. 0 ) THEN
         config_flags%isoilwater = 14
    ENDIF
    CALL nl_set_isoilwater ( grid%id , config_flags%isoilwater )
    grid%isoilwater = config_flags%isoilwater

#ifdef MOVE_NESTS
! Added these fields for restarting of moving nests, JM
! DANGER and TODO
! It is very important that these be set correctly if they are set at all in here.
! Garbage values will produce unpredictable results, possibly segfaults, in the nesting
! code. Need some integrity checking here or elsewhere in the code to at least check to
! make sure that the istart and jstart values make sense with respect to the nest dimensions
! and the position in the parent domain.
    CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' ,  itmp  , 1 , icnt, ierr )
    IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
      config_flags%i_parent_start = itmp
      CALL nl_set_i_parent_start ( grid%id , config_flags%i_parent_start )
    ENDIF
    CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' ,  itmp  , 1 , icnt, ierr )
    IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
      config_flags%j_parent_start = itmp
      CALL nl_set_j_parent_start ( grid%id , config_flags%j_parent_start )
    ENDIF
#endif

#if (EM_CORE == 1)

!KLUDGE - is there a more elegant way to determine "old si" input
    IF      ( ( switch .EQ.     input_only  ) .OR. &
            ( ( switch .EQ. auxinput1_only ) .AND. &
              ( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) ) THEN

       !  Test to make sure that the input data is the right size.

       IF ( ( ide .NE. ide_compare    ) .OR. &
            ( kde .NE. kde_compare    ) .OR. &
            ( jde .NE. jde_compare    ) ) THEN
          WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  namelist ide,jde,kde=',ide,jde,kde,&
                                  '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
          CALL wrf_error_fatal( wrf_err_message )
       ENDIF

    ELSE IF ( switch .EQ. auxinput1_only ) THEN

       !  Test to make sure that the input data is the right size.

       IF ( ( ide                             .NE. ide_compare ) .OR. &
            ( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
            ( jde                             .NE. jde_compare ) ) THEN
         WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  ',&
                                 'namelist ide,jde,num_metgrid_levels=',ide,jde,config_flags%num_metgrid_levels,&
                                 '; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
         CALL wrf_error_fatal( wrf_err_message )
       ENDIF
    ENDIF

#endif

#if (NMM_CORE == 1)

    IF      ( ( switch .EQ. auxinput1_only  ) .AND. &
              ( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) THEN

       CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMSNSION' ,   kde_compare , 1 , icnt , ierr3 )

       !  Test to make sure that the input data is the right size.

       IF ( ( ide-1 .NE. ide_compare    ) .OR. &
            ( kde   .NE. kde_compare    ) .OR. &
            ( jde-1 .NE. jde_compare    ) .AND. ierr3 .EQ. 0 ) THEN
          WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  namelist ide-1,jde-1,kde=',ide-1,jde-1,kde,&
                                  '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
          CALL wrf_debug( 100, wrf_err_message )
       ENDIF

       ELSEIF ( switch .EQ. auxinput1_only ) THEN          ! assume just WPS in this branch
         IF ( ( ide-1                           .NE. ide_compare ) .OR. &
            ( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
            ( jde-1                             .NE. jde_compare ) .AND. ierr3 .EQ. 0 ) THEN
                WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH:  ',&
                 'namelist ide-1,jde-1,num_metgrid_levels=',ide-1,jde-1,config_flags%num_metgrid_levels,&
                 '; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
                IF (ide-1 .eq. ide_compare .AND. jde-1 .EQ. jde_compare) THEN
                  CALL wrf_message(wrf_err_message)
                  CALL wrf_error_fatal( "appears that the vertical dimension is wrong - quitting" )
                ELSE
                  CALL wrf_message(wrf_err_message)
                  CALL wrf_error_fatal( "appears that I or J dimensions are wrong - quitting" )
                ENDIF
         ENDIF
       ENDIF

#endif

#if (DA_CORE == 1)
    ! Test here to check that config_flags%hypsometric_opt in namelist
    ! is equal to what is in the global attributes of the wrfinput files

    IF ( switch .EQ. input_only  ) THEN
       CALL wrf_get_dom_ti_integer ( fid, 'HYPSOMETRIC_OPT', itmp, 1, icnt, ierr )
       IF ( ierr .EQ. 0 ) THEN
          WRITE(wrf_err_message,*)'input_wrf: global attribute HYPSOMETRIC_OPT returns ', itmp
          CALL wrf_debug ( 300 , wrf_err_message )
          IF ( config_flags%hypsometric_opt /= itmp ) THEN
             call wrf_message("----------------- WARNING  -------------------")
             WRITE(wrf_err_message,'("namelist    : hypsometric_opt = ",I10)') config_flags%hypsometric_opt
             call wrf_message(wrf_err_message)
             WRITE(wrf_err_message,'("input files : HYPSOMETRIC_OPT = ",I10, " (from wrfinput files).")') itmp
             call wrf_message(wrf_err_message)
             call wrf_error_fatal("Mismatch between namelist and global attribute HYPSOMETRIC_OPT")
          END IF
       ELSE
          ! For WRFDA backward compatibility.  If hypsometric_opt is not defined in the fg file, it is
          ! pre-version 3.4 WRF input data.  For older versions, hypsometric_opt should be 1.
          hypsometric_opt = -1
          CALL wrf_get_dom_ti_integer ( fid , 'HYPSOMETRIC_OPT' , hypsometric_opt, 1 , icnt , ierr )
          IF ( ( hypsometric_opt .NE. 1 ) .AND. ( hypsometric_opt .NE. 2 ) ) THEN
             grid%hypsometric_opt = 1
             config_flags%hypsometric_opt = 1
             DO loop = 1 , grid%max_dom
                CALL nl_set_hypsometric_opt ( loop , 1 )
             END DO
             WRITE(wrf_err_message,*)'Background (fg) file appears to be from earlier than WRF V3.4;'
             call wrf_message(wrf_err_message)
             WRITE(wrf_err_message,*)'Resetting the hypsometric_opt from default value of 2 to 1'
             CALL wrf_message(wrf_err_message)
          END IF

       END IF
    END IF

#endif

#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
      IF ( ( switch .EQ. input_only ) .OR. ( switch .EQ. restart_only ) ) THEN

        !  Make sure for ARW ideal cases that the hypsometric option, the
        !  way that we integrate the height field, is set to 1.  This is the
        !  method that is used in all of the "ideal" programs to get the
        !  base-state height (phb).

        CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_INITIALIZATION_TYPE', sim_type , ierr )
        IF      ( TRIM(sim_type) .EQ. "IDEALIZED DATA" ) THEN
           grid%this_is_an_ideal_run = .TRUE.
        ELSE IF ( TRIM(sim_type) .EQ. "REAL-DATA CASE" ) THEN
           grid%this_is_an_ideal_run = .FALSE.
        ELSE IF ( ierr .NE. 0 ) THEN
           CALL wrf_get_dom_ti_char ( fid , 'START_DATE' , input_name , ierr )
           grid%this_is_an_ideal_run = INDEX(TRIM(input_name) , '0001-' ) .NE. 0
        END IF

        IF ( grid%this_is_an_ideal_run ) THEN
          grid%hypsometric_opt = 1
          config_flags%hypsometric_opt = 1
	  DO loop = 1 , grid%max_dom
            CALL nl_set_hypsometric_opt ( loop , 1 ) 
          END DO
          WRITE(wrf_err_message,*)'NOTE:  Ideal cases always use hypsometric_opt=1, regardless of namelist setting'
          CALL wrf_debug( 1 , wrf_err_message )
        END IF
      END IF

       IF ( ( switch .EQ. input_only ) .AND. ( config_flags%io_form_input .EQ. 2 ) ) THEN

        !  For backward compatibility.  If we do not find the hypsometric_opt defined
        !  in the input data, this is pre version 3.4.  Most likely, the hypsometric_opt
        !  was the default value, 1.  

        hypsometric_opt = -1
        CALL wrf_get_dom_ti_integer ( fid , 'HYPSOMETRIC_OPT' , hypsometric_opt , 1 , icnt , ierr )
        IF ( ( hypsometric_opt .NE. 1 ) .AND. ( hypsometric_opt .NE. 2 ) ) THEN
          grid%hypsometric_opt = 1
          config_flags%hypsometric_opt = 1
	  DO loop = 1 , grid%max_dom
            CALL nl_set_hypsometric_opt ( loop , 1 ) 
          END DO
          WRITE(wrf_err_message,*)'Resetting the hypsometric_opt from default value of 2 to 1'
          CALL wrf_debug( 0 , wrf_err_message )
        END IF
       END IF
#endif

    ENDIF check_if_dryrun

!
! This call to wrf_get_next_time will position the dataset over the next time-frame
! in the file and return the current_date, which is used as an argument to the
! read_field routines in the blocks of code included below.  Note that we read the
! next time *after* all the meta data has been read. This is only important for the
! WRF internal I/O format because it is order-dependent. Other formats shouldn't care
! about this.
!

    3003 continue

    CALL wrf_get_next_time(fid, current_date , ierr)
    WRITE(wrf_err_message,*)fid,' input_wrf: wrf_get_next_time current_date: ',current_date(1:19),' Status = ',ierr
    CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
    IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
      CALL wrf_message ( TRIM(wrf_err_message ) )
      IF ( switch .EQ. boundary_only ) THEN
        WRITE(wrf_err_message,*) ' ... May have run out of valid boundary conditions in file ',TRIM(fname)
        CALL wrf_error_fatal( TRIM(wrf_err_message) )
      ELSE
#if ( NMM_CORE != 1 )
        WRITE(wrf_err_message,*) '... Could not find matching time in input file ',TRIM(fname)
        CALL wrf_error_fatal( TRIM(wrf_err_message) )
#endif
      ENDIF
    ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ) THEN
!
! check input time against domain time (which will be start time at beginning, see share/set_timekeeping.F)
! JM 20040511
!
      SELECT CASE ( switch )
        CASE ( input_only, auxinput1_only, auxinput2_only,       &
               auxinput3_only, auxinput4_only, auxinput5_only,  &
               auxinput6_only, auxinput7_only, auxinput8_only,  &
               auxinput9_only, auxinput10_only )
#if ( WRF_CHEM == 1 )
           IF( (config_flags%io_style_emissions .eq. 1) .and.                                &
              ((switch.eq.auxinput5_only) .or. (switch.eq.auxinput6_only) .or. &
               (switch.eq.auxinput7_only) .or. (switch.eq.auxinput8_only)) ) then
               CALL wrf_message( "**WARNING** Time in input file not being checked **WARNING**" )
           ELSE
#endif
            CALL wrf_atotime( current_date(1:19), time )
            CALL domain_clock_get( grid, current_time=currtime, &
                                         current_timestr=currtimestr )
#if (DA_CORE != 1) 
! Don't perform the check for WRFVAR, as we're not passing the right dates
! around
            CALL domain_clockprint(150, grid, &
                   'DEBUG input_wrf():  get CurrTime from clock,')
            IF ( time .NE. currtime ) THEN
                WRITE( wrf_err_message , * )'Time in file: ',trim( current_date(1:19) )
                CALL wrf_message ( trim(wrf_err_message) )
                WRITE( wrf_err_message , * )'Time on domain: ',trim( currtimestr )
                CALL wrf_message ( trim(wrf_err_message) )
                CALL wrf_message( "**WARNING** Time in input file not equal to time on domain **WARNING**" )
                WRITE(wrf_err_message,*) "**WARNING** Trying next time in file ",TRIM(fname)," ..."
                CALL wrf_message( TRIM(wrf_err_message) )
                GOTO 3003
            ENDIF
#endif
#if ( WRF_CHEM == 1 )
            ENDIF
#endif
        CASE DEFAULT
      END SELECT
    ENDIF

! set the lbc time interval fields in the domain data structure
! these time values are checked as stopping condition for the while loop in
! latbound_in() defined in share/medation_integrate.F, which is used to
! iterate forward to the correct interval in the input LBC file
!
    IF ( switch .EQ. boundary_only ) THEN
       IF ( config_flags%restart ) THEN
          ! get WRF time of current_date position in boundary file
          CALL wrf_atotime( current_date(1:19), time )
          ! jump straight to the restart time
          CALL domain_clock_get( grid, current_time=currentTime, &
                                     current_timestr=currtimestr )
          write(wrf_err_message, '(4a)') "WRF restart, LBC starts at ", &
                                     & trim(current_date), " and restart starts at ", trim(currtimestr)
          CALL wrf_debug( 0 , wrf_err_message )
          CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' ,  current_date(1:19), this_datestr , ierr )
          CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
          CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' ,  current_date(1:19), next_datestr , ierr )
          CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
         
          WRITE ( wrf_err_message , * ) 'LBC for restart: Starting valid date = ',this_datestr(1:19),', Ending valid date = ',next_datestr(1:19)
          CALL wrf_message( TRIM(wrf_err_message) )
          WRITE ( wrf_err_message , * ) 'LBC for restart: Restart time            = ',trim(currtimestr)
          CALL wrf_message( TRIM(wrf_err_message) )

          IF ( ( grid%this_bdy_time .LE. currentTime ) .AND. ( grid%next_bdy_time .GT. currentTime ) ) THEN
              WRITE ( wrf_err_message , * ) 'LBC for restart: Found the correct bounding LBC time periods'
              CALL wrf_message( TRIM(wrf_err_message) )
          ELSE

              WRITE ( wrf_err_message , * ) 'LBC for restart: Looking for a bounding time'
              CALL wrf_message( TRIM(wrf_err_message) )

              !  While the lateral BC time is less than the restart time, advance forward to the next LBC time.

              icount = 0
              DO WHILE ( ( currentTime .GE. grid%next_bdy_time ) .AND. ( icount < 10000 ) ) 
                  CALL wrf_get_next_time(fid, current_date , ierr)
                  IF ( ierr .NE. 0 ) THEN
                     CALL wrf_error_fatal ( 'Cannot find a valid time to start the LBC during this restart, likely ran out of time periods to test' )
                  END IF
                  CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' ,  current_date(1:19), this_datestr , ierr )
                  CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' ,  current_date(1:19), next_datestr , ierr )
                  CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
                  WRITE ( wrf_err_message , * ) 'LBC for restart: Starting valid date = ',this_datestr(1:19),', Ending valid date = ',next_datestr(1:19)
                  CALL wrf_message( TRIM(wrf_err_message) )
                  icount = icount + 1
              END DO
             
              !  Now the LBC time either matches or is beyond the restart time.  If it matches, we are at the
              !  right time.  If we have gone too far, then back up one time period, and we are good to go.

              IF ( time .eq. currentTime ) THEN
                  CALL wrf_debug ( 0 , 'Found correct time, LBC matches the restart interval.' )
              ELSE IF ( time .gt. currentTime ) THEN
                  CALL wrf_debug ( 0 , 'Went one LBC interval too far, backing up for restart.' )
                  CALL wrf_get_previous_time(fid, current_date , ierr)
                  IF ( ierr .EQ. 0 ) THEN
                     CALL wrf_atotime(current_date(1:19), time)
                     WRITE(wrf_err_message,*) 'LBC: wrf_get_prev_time current_date: ',&
                                             & current_date(1:19),' Status = ',ierr
                     CALL wrf_debug ( 0 , TRIM(wrf_err_message ) )
                     CALL wrf_debug ( 0 , 'LBC is now correctly positioned for requested restart time' )
                  ELSE
                     CALL wrf_error_fatal ( 'Problems backing up in the LBC file to find startig location for restart' )
                  END IF
              END IF
          END IF

          CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' ,  current_date(1:19), this_datestr , ierr )
          CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
          CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' ,  current_date(1:19), next_datestr , ierr )
          CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
          WRITE ( wrf_err_message , * ) 'LBC for restart: Found the correct bounding LBC time periods for restart time = ',trim(currtimestr)
          CALL wrf_message ( TRIM(wrf_err_message) )

       ELSE IF ( .NOT. config_flags%restart ) THEN
          CALL domain_clock_get( grid, current_time=currentTime )
          CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' ,  current_date(1:19), this_datestr , ierr )
          CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
          CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' ,  current_date(1:19), next_datestr , ierr )
          CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
       END IF
#if (DA_CORE != 1)
       IF( currentTime .GE. grid%next_bdy_time ) THEN
          IF ( wrf_dm_on_monitor() ) THEN
             write(a_message,*) 'THIS TIME ',this_datestr(1:19),', NEXT TIME ',next_datestr(1:19)
             CALL wrf_message ( a_message ) 
          END IF
          RETURN
       ENDIF
#endif
    ENDIF

#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
    !  Vertical interpolation space is required if specified by user.

    n_ref_m = config_flags%vert_refine_fact
#else
    !  Default value indicating no vertical interpolation required.

    n_ref_m = 0
#endif

    IF ( (first_input   .LE. switch .AND. switch .LE. last_input) .OR. &
         (first_history .LE. switch .AND. switch .LE. last_history) .OR. &
         switch .EQ. restart_only    ) THEN
      newswitch = switch
      p => grid%head_statevars%next
      DO WHILE ( ASSOCIATED( p ) ) 
        IF ( p%ProcOrient .NE. 'X' .AND. p%ProcOrient .NE. 'Y' ) THEN   ! no I/O for xposed variables
          IF ( p%Ndim .EQ. 0 ) THEN
            IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
              IF ( in_use_for_config(grid%id,TRIM(p%VarName)) ) THEN
                IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
                dname = p%DataName
                IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
                  IF      ( p%Type .EQ. 'r' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%rfield_0d             , & ! Field
                                    WRF_FLOAT               , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    '0'                     , & ! MemoryOrder
                                    ''                      , & ! Stagger
                     __FILE__ // ' reading 0d real ' // TRIM(p%VarName)     , & ! Debug message
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'd' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%dfield_0d             , & ! Field
                                    WRF_DOUBLE              , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    '0'                     , & ! MemoryOrder
                                    ''                      , & ! Stagger
                     __FILE__ // ' reading 0d double ' // TRIM(p%VarName)     , & ! Debug message
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'i' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%ifield_0d             , & ! Field
                                    WRF_INTEGER             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    '0'                     , & ! MemoryOrder
                                    ''                      , & ! Stagger
                     __FILE__ // ' reading 0d integer ' // TRIM(p%VarName)     , & ! Debug message
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'l' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%lfield_0d             , & ! Field
                                    WRF_LOGICAL             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    '0'                     , & ! MemoryOrder
                                    ''                      , & ! Stagger
                     __FILE__ // ' reading 0d logical ' // TRIM(p%VarName)     , & ! Debug message
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     1 , 1 , 1 , 1 , 1 , 1 ,  &
                     ierr )
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ELSE IF ( p%Ndim .EQ. 1 ) THEN
            IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
              IF ( in_use_for_config(grid%id,TRIM(p%VarName)) ) THEN
                IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
                  dname = p%DataName
                  IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
                  memord = p%MemoryOrder

                  i_inter = 0
#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
                  !  Vertical interpolation space is required if specified by user.

                  if( TRIM(p%dimname1).EQ.'bottom_top'.OR.TRIM(p%dimname1).EQ.'bottom_top_stag') i_inter = 1 
#endif
                  
                  IF      ( p%Type .EQ. 'r' ) THEN
                    IF( (i_inter.eq.1.and.n_ref_m.ge.2).and.(switch.eq.history_only) ) THEN
                       em1_c = (p%em1 - 1)/n_ref_m +1
                       ed1_c = em1_c
                       ep1_c = em1_c
                       if (TRIM(p%dimname1).EQ.'bottom_top') then
                       ed1_c = em1_c-1
                       ep1_c = em1_c-1
                       endif
                       allocate (f_vint_1d(em1_c))

                       CALL wrf_ext_read_field (  &
                                       fid                     , & ! DataHandle
                                       current_date(1:19)      , & ! DateStr
                                       TRIM(dname)             , & ! Data Name
                                       f_vint_1d               , & ! Field
                                       WRF_FLOAT               , & ! FieldType
                                       grid                    , & ! grid
                                       grid%domdesc            , & ! domdesc
                                       grid%bdy_mask           , & ! bdy_mask
                                       TRIM(memord)            , & ! MemoryOrder
                                       p%Stagger               , & ! Stagger
                        __FILE__ // ' reading 1d real ' // TRIM(p%VarName)     , & ! Debug message
                        p%sd1 , ed1_c , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                        p%sm1 , em1_c , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                        p%sp1 , ep1_c , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                        ierr )

                        do k=1,ed1_c
                        p%rfield_1d(k) = f_vint_1d(k)
                        enddo
                        deallocate (f_vint_1d)

                     ELSE
                       CALL wrf_ext_read_field (  &
                                       fid                     , & ! DataHandle
                                       current_date(1:19)      , & ! DateStr
                                       TRIM(dname)             , & ! Data Name
                                       p%rfield_1d             , & ! Field
                                       WRF_FLOAT               , & ! FieldType
                                       grid                    , & ! grid
                                       grid%domdesc            , & ! domdesc
                                       grid%bdy_mask           , & ! bdy_mask
                                       TRIM(memord)            , & ! MemoryOrder
                                       p%Stagger               , & ! Stagger
                        __FILE__ // ' reading 1d real ' // TRIM(p%VarName)     , & ! Debug message
                        p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                        p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                        p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                        ierr )
                     END IF
                  ELSE IF ( p%Type .EQ. 'd' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%dfield_1d             , & ! Field
                                    WRF_DOUBLE              , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 1d double ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'i' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%ifield_1d             , & ! Field
                                    WRF_INTEGER             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 1d integer ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'l' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%lfield_1d             , & ! Field
                                    WRF_LOGICAL             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 1d logical ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ELSE IF ( p%Ndim .EQ. 2 ) THEN
            IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
              IF ( in_use_for_config(grid%id,TRIM(p%VarName)) .AND.  &
                   ( .NOT. p%subgrid_x .OR. (p%subgrid_x .AND. grid%sr_x .GT. 0) ) .AND. &
                   ( .NOT. p%subgrid_y .OR. (p%subgrid_y .AND. grid%sr_y .GT. 0) )       &
                 ) THEN
                IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
                  dname = p%DataName
                  IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
                  memord = p%MemoryOrder
                  IF      ( p%Type .EQ. 'r' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%rfield_2d             , & ! Field
                                    WRF_FLOAT               , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 2d real ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'd' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%dfield_2d             , & ! Field
                                    WRF_DOUBLE              , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 2d double ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'i' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%ifield_2d             , & ! Field
                                    WRF_INTEGER             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 2d integer ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'l' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%lfield_2d             , & ! Field
                                    WRF_LOGICAL             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 2d logical ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ELSE IF ( p%Ndim .EQ. 3 ) THEN
            IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
              IF ( in_use_for_config(grid%id,TRIM(p%VarName)) .AND.  &
                   ( .NOT. p%subgrid_x .OR. (p%subgrid_x .AND. grid%sr_x .GT. 0) ) .AND. &
                   ( .NOT. p%subgrid_y .OR. (p%subgrid_y .AND. grid%sr_y .GT. 0) )       &
                 ) THEN
                IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
                  dname = p%DataName
                  IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
                  memord = p%MemoryOrder

                  i_inter = 0
#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
                  !  Vertical interpolation space is required if specified by user.

                  if( TRIM(p%dimname2).EQ.'bottom_top'.OR.TRIM(p%dimname2).EQ.'bottom_top_stag') i_inter = 1
#endif

                  IF      ( p%Type .EQ. 'r' ) THEN
                    IF( (i_inter.eq.1.and.n_ref_m.ge.2).and.(switch.eq.history_only) ) then
                       em2_c = (p%em2 - 1)/n_ref_m +1
                       ed2_c = em2_c
                       ep2_c = em2_c
                       if (TRIM(p%dimname2).EQ.'bottom_top') then
                       ed2_c = em2_c-1
                       ep2_c = em2_c-1
                       endif
                       allocate (f_vint_3d(p%sm1:p%em1,em2_c,p%sm3:p%em3))
                       CALL wrf_ext_read_field (  &
                                       fid                     , & ! DataHandle
                                       current_date(1:19)      , & ! DateStr
                                       TRIM(dname)             , & ! Data Name
                                       f_vint_3d               , & ! Field
                                       WRF_FLOAT               , & ! FieldType
                                       grid                    , & ! grid
                                       grid%domdesc            , & ! domdesc
                                       grid%bdy_mask           , & ! bdy_mask
                                       TRIM(memord)            , & ! MemoryOrder
                                       TRIM(p%Stagger)         , & ! Stagger
                        __FILE__ // ' reading 3d real ' // TRIM(p%VarName)     , & ! Debug message
                        p%sd1 , p%ed1 , p%sd2 , ed2_c , p%sd3 , p%ed3 ,  &
                        p%sm1 , p%em1 , p%sm2 , em2_c , p%sm3 , p%em3 ,  &
                        p%sp1 , p%ep1 , p%sp2 , ep2_c , p%sp3 , p%ep3 ,  &
                        ierr )

                        do j = p%sm3,p%em3
                        do k = 1,ed2_c
                        do i = p%sm1,p%em1
                        p%rfield_3d(i,k,j) = f_vint_3d(i,k,j)
                        enddo
                        enddo
                        enddo
                        deallocate (f_vint_3d)
                    ELSE
                       CALL wrf_ext_read_field (  &
                                       fid                     , & ! DataHandle
                                       current_date(1:19)      , & ! DateStr
                                       TRIM(dname)             , & ! Data Name
                                       p%rfield_3d             , & ! Field
                                       WRF_FLOAT               , & ! FieldType
                                       grid                    , & ! grid
                                       grid%domdesc            , & ! domdesc
                                       grid%bdy_mask           , & ! bdy_mask
                                       TRIM(memord)            , & ! MemoryOrder
                                       TRIM(p%Stagger)         , & ! Stagger
                        __FILE__ // ' reading 3d real ' // TRIM(p%VarName)     , & ! Debug message
                        p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                        p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                        p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                        ierr )
                    ENDIF
                  ELSE IF ( p%Type .EQ. 'd' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%dfield_3d             , & ! Field
                                    WRF_DOUBLE              , & ! FieldType
                                    grid%communicator       , & ! Comm
                                    grid%iocommunicator     , & ! Comm
                                    grid%domdesc            , & ! Comm
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 3d double ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
                  ELSE IF ( p%Type .EQ. 'i' ) THEN
                    CALL wrf_ext_read_field (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%ifield_3d             , & ! Field
                                    WRF_INTEGER             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                     __FILE__ // ' reading 3d integer ' // TRIM(p%VarName)     , & ! Debug message
                     p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                     p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                     p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                     ierr )
! NOTE no io on logical arrays greater than 2d
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ELSE IF ( p%Ndim .EQ. 4 .AND. p%scalar_array ) THEN
! Use a different read routine, wrf_ext_read_field_arr, and pass in the
! tracer indeces so that p%rfield_4d can be passsed in without arguments,
! avoiding the possiblity of a copy-in/copy-out problem for some compilers.
! JM 20091208
            DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
              IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams_table(grid%id,itrace)%stream,newswitch)) THEN
                dname = p%dname_table( grid%id, itrace )
                IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
                memord = p%MemoryOrder

                i_inter = 0
#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
                !  Vertical interpolation space is required if specified by user.

                if( TRIM(p%dimname2).EQ.'bottom_top'.OR.TRIM(p%dimname2).EQ.'bottom_top_stag') i_inter = 1
#endif

                IF      ( p%Type .EQ. 'r' ) THEN
                    IF( (i_inter.eq.1.and.n_ref_m.ge.2).and.(switch.eq.history_only) ) then
                       em2_c = (p%em2 - 1)/n_ref_m +1
                       ed2_c = em2_c
                       ep2_c = em2_c
                       if (TRIM(p%dimname2).EQ.'bottom_top') then
                       ed2_c = em2_c-1
                       ep2_c = em2_c-1
                       endif
                       allocate (f_vint_4d(p%sm1:p%em1,em2_c,p%sm3:p%em3,p%num_table(grid%id)))

                       CALL wrf_ext_read_field_arr (  &
                                         fid                     , & ! DataHandle
                                         current_date(1:19)      , & ! DateStr
                                         TRIM(dname)             , & ! Data Name
                                         f_vint_4d               , & ! Field
                                         itrace, 1, 1, 1         , & ! see comment above
                                         1, 1, 1                 , & ! see comment above
                                         RWORDSIZE               , &
                                         WRF_FLOAT               , & ! FieldType
                                         grid                    , & ! grid
                                         grid%domdesc            , & ! domdesc
                                         grid%bdy_mask           , & ! bdy_mask
                                         TRIM(memord)            , & ! MemoryOrder
                                         TRIM(p%Stagger)         , & ! Stagger
                        __FILE__ // ' reading 4d real ' // TRIM(p%dname_table(grid%id,itrace))     , & ! Debug message
                        p%sd1 , p%ed1 , p%sd2 , ed2_c , p%sd3 , p%ed3 ,  &
                        p%sm1 , p%em1 , p%sm2 , em2_c , p%sm3 , p%em3 ,  &
                        p%sp1 , p%ep1 , p%sp2 , ep2_c , p%sp3 , p%ep3 ,  &
                        ierr )
                        do j = p%sm3,p%em3
                        do k = 1,ed2_c
                        do i = p%sm1,p%em1
                        p%rfield_4d(i,k,j,itrace) = f_vint_4d(i,k,j,itrace)
                        enddo
                        enddo
                        enddo
                        deallocate (f_vint_4d)
                   ELSE
                        CALL wrf_ext_read_field_arr (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%rfield_4d             , & ! Field
                                    itrace, 1, 1, 1         , & ! see comment above
                                    1, 1, 1                 , & ! see comment above
                                    RWORDSIZE               , &
                                    WRF_FLOAT               , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                       __FILE__ // ' reading 4d real ' // TRIM(p%dname_table(grid%id,itrace))     , & ! Debug message
                       p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                       p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                       p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                       ierr )
                   ENDIF
                ELSE IF ( p%Type .EQ. 'd' ) THEN
                  CALL wrf_ext_read_field_arr (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%dfield_4d             , & ! Field
                                    itrace, 1, 1, 1         , & ! see comment above
                                    1, 1, 1                 , & ! see comment above
                                    DWORDSIZE               , &
                                    WRF_DOUBLE              , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                   __FILE__ // ' reading 4d double ' // TRIM(p%dname_table(grid%id,itrace))     , & ! Debug message
                   p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                   p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                   p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                   ierr )
                ELSE IF ( p%Type .EQ. 'i' ) THEN
                  CALL wrf_ext_read_field_arr (  &
                                    fid                     , & ! DataHandle
                                    current_date(1:19)      , & ! DateStr
                                    TRIM(dname)             , & ! Data Name
                                    p%ifield_4d             , & ! Field
                                    itrace, 1, 1, 1         , & ! see comment above
                                    1, 1, 1                 , & ! see comment above
                                    IWORDSIZE               , &
                                    WRF_INTEGER             , & ! FieldType
                                    grid                    , & ! grid
                                    grid%domdesc            , & ! domdesc
                                    grid%bdy_mask           , & ! bdy_mask
                                    TRIM(memord)            , & ! MemoryOrder
                                    TRIM(p%Stagger)         , & ! Stagger
                   __FILE__ // ' reading 4d integer ' // TRIM(p%dname_table(grid%id,itrace))     , & ! Debug message
                   p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 ,  &
                   p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 ,  &
                   p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 ,  &
                   ierr )
                ENDIF
              ENDIF
            ENDDO  ! loop over tracers
          ENDIF
        ENDIF
        p => p%next
      ENDDO
    ELSE
      IF ( switch .EQ. boundary_only ) THEN
        CALL wrf_bdyin( fid , grid , config_flags , switch , ierr )
      ENDIF
    ENDIF

#if (DA_CORE != 1)
    CALL wrf_tsin( grid , ierr )
#if (EM_CORE == 1)
    if (config_flags%track_loc_in > 0 ) then
       call track_input( grid , ierr )
    end if
#endif
#endif

    WRITE(wrf_err_message,*)'input_wrf: end, fid = ',fid
    CALL wrf_debug( 300 , wrf_err_message )

    RETURN
  END SUBROUTINE input_wrf
