share/mediation_integrate.F

   1 !
   2 !WRF:MEDIATION_LAYER:IO
   3 !
   4 #if (DA_CORE != 1)
   5
   6 SUBROUTINE med_calc_model_time ( grid , config_flags )
   7   ! Driver layer
   8    USE module_domain    , ONLY : domain, domain_clock_get
   9    USE module_configure , ONLY : grid_config_rec_type
  10   ! Model layer
  11    USE module_date_time
  12
  13    IMPLICIT NONE
  14
  15   ! Arguments
  16    TYPE(domain)                               :: grid
  17    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
  18
  19   ! Local data
  20    REAL                                       :: time
  21
  22 ! this is now handled by with calls to time manager
  23 !   time = head_grid%dt * head_grid%total_time_steps
  24 !   CALL calc_current_date (grid%id, time)
  25
  26
  27 END SUBROUTINE med_calc_model_time
  28
  29 SUBROUTINE med_before_solve_io ( grid , config_flags )
  30   ! Driver layer
  31    USE module_state_description
  32    USE module_domain    , ONLY : domain, domain_clock_get
  33    USE module_configure , ONLY : grid_config_rec_type
  34    USE module_streams
  35   ! Model layer
  36    USE module_utility
  37 #if (WRFPLUS == 1)
  38    USE module_domain    , ONLY : domain_clock_set, get_ijk_from_grid
  39    USE module_configure , ONLY : model_config_rec
  40    USE mediation_pertmod_io , ONLY : save_tl_pert, read_ad_forcing, save_xtraj, read_xtraj, read_xtraj_reverse
  41    USE module_bc_em, ONLY : rk_phys_bc_dry_2
  42    USE module_bc, ONLY : set_physical_bc3d
  43    USE wrf_esmf_timemod, ONLY : ESMF_TimeInc
  44
  45 #ifdef DM_PARALLEL
  46    USE module_dm, ONLY : ntasks_x, ntasks_y, &
  47         local_communicator, mytask, ntasks
  48    USE module_comm_dm, ONLY : halo_em_init_1_sub, halo_em_init_2_sub, halo_em_init_5_sub
  49 #endif
  50 #endif
  51    IMPLICIT NONE
  52
  53   ! Arguments
  54    TYPE(domain)                               :: grid
  55    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
  56   ! Local
  57    INTEGER                                    :: ialarm
  58    INTEGER                                    :: rc
  59    TYPE(WRFU_Time) :: currTime, startTime
  60
  61    CHARACTER*256          :: message
  62 #if (WRFPLUS == 1)
  63    INTEGER                :: ids , ide , jds , jde , kds , kde , &
  64                              ims , ime , jms , jme , kms , kme , &
  65                              ips , ipe , jps , jpe , kps , kpe, ij, im
  66    CHARACTER*80           :: timestr
  67    REAL, POINTER :: moist(:,:,:,:), scalar(:,:,:,:), chem(:,:,:,:), tracer(:,:,:,:)
  68
  69 ! In WRFPLUS NL run, boundary should be read before save xtraj.
  70 ! - RESTART OUTPUT
  71    CALL WRFU_ClockGet( grid%domain_clock, CurrTime=currTime, StartTime=startTime )
  72    IF ( ( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) .AND. &
  73         ( currTime .NE. startTime ) ) THEN
  74      IF ( grid%id .EQ. 1 ) THEN
  75        ! Only the parent initiates the restart writing. Otherwise, different
  76        ! domains may be written out at different times and with different
  77        ! time stamps in the file names.
  78        CALL med_restart_out ( grid , config_flags )
  79      ENDIF
  80      CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
  81    ELSE
  82      CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
  83    ENDIF
  84
  85 ! - Look for boundary data after writing out history and restart files
  86    CALL med_latbound_in ( grid , config_flags )
  87 #endif
  88
  89  CALL WRFU_ClockGet( grid%domain_clock, CurrTime=currTime, StartTime=startTime )
  90
  91  IF( (WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) .AND. &
  92      (grid%dfi_write_dfi_history .OR. grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI) )) THEN
  93      IF       ( ( config_flags%restart )                    .AND. &
  94                 ( config_flags%write_hist_at_0h_rst )       .AND. &
  95                 ( currTime .EQ. startTime )                       ) THEN
  96        !  output history at beginning of restart if alarm is ringing
  97        CALL med_hist_out ( grid , HISTORY_ALARM, config_flags )
  98
  99      ELSE IF  ( ( config_flags%restart )                    .AND. &
 100                 ( .NOT. config_flags%write_hist_at_0h_rst ) .AND. &
 101                 ( currTime .EQ. startTime )                       ) THEN
 102        !  we do not do anything
 103      ELSE
 104        CALL med_hist_out ( grid , HISTORY_ALARM, config_flags )
 105
 106      END IF
 107      CALL WRFU_AlarmRingerOff( grid%alarms( HISTORY_ALARM ), rc=rc )
 108    ELSE IF  ( (config_flags%restart) .AND. ( currTime .EQ. startTime ) .AND. &
 109               ( config_flags%write_hist_at_0h_rst ) ) THEN
 110      !  output history at beginning of restart even if alarm is not ringing
 111      CALL med_hist_out ( grid , HISTORY_ALARM, config_flags )
 112      CALL WRFU_AlarmRingerOff( grid%alarms( HISTORY_ALARM ), rc=rc )
 113    ENDIF
 114
 115    IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
 116      CALL med_filter_out  ( grid , config_flags )
 117      CALL WRFU_AlarmRingerOff( grid%alarms( INPUTOUT_ALARM ), rc=rc )
 118    ENDIF
 119
 120    DO ialarm = first_auxhist, last_auxhist
 121      IF ( .FALSE.) THEN
 122        rc = 1  ! dummy statement
 123      ELSE IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 124 #if (WRFPLUS == 1)
 125        IF ( .NOT. grid%trajectory_io ) THEN
 126          ! For wrfplus, only allow tl and nl output histoty files.
 127          IF ( config_flags%dyn_opt .EQ. dyn_em_tl .OR. config_flags%dyn_opt .EQ. dyn_em ) THEN
 128             CALL med_hist_out ( grid , ialarm, config_flags )
 129          ENDIF
 130        ELSE
 131          IF ( ialarm .EQ. auxhist8_only ) THEN ! TL perturbation only
 132             CALL domain_clock_get ( grid, current_timestr=message )
 133             IF ( config_flags%dyn_opt .EQ. dyn_em_tl .and. .not. config_flags%tl_standalone ) THEN
 134                CALL save_tl_pert  ( message )
 135             ELSEIF ( config_flags%dyn_opt .EQ. dyn_em_tl .and. config_flags%tl_standalone ) THEN
 136                CALL med_hist_out ( grid , ialarm, config_flags )
 137             ENDIF
 138          ENDIF
 139          IF ( ialarm .EQ. auxhist6_only ) THEN ! trajectory only
 140             CALL domain_clock_get ( grid, current_timestr=message )
 141             IF ( config_flags%dyn_opt .EQ. dyn_em ) THEN
 142                CALL save_xtraj  (  message )
 143             ENDIF
 144          ENDIF
 145        ENDIF
 146 #else
 147 !----------------------------------------------------------------------
 148 ! RASM Climate Diagnostics - JR, AS, MS  - October 2016
 149 !----------------------------------------------------------------------
 150        IF  ( (ialarm .EQ.  AUXHIST5_ALARM) .AND. (config_flags%restart) .AND. ( currTime .EQ. startTime ) ) THEN
 151          !  no AVG history output on the first time of the restart
 152        ELSE IF  ( (ialarm .EQ.  AUXHIST6_ALARM) .AND. (config_flags%restart) .AND. ( currTime .EQ. startTime ) ) THEN
 153          !  no DIURNAL history output on the first time of the restart
 154        ELSE IF ( grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI ) THEN
 155          CALL med_hist_out ( grid , ialarm, config_flags )
 156        ENDIF
 157 !----------------------------------------------------------------------
 158 ! end RASM Climate Diagnostics
 159 !----------------------------------------------------------------------
 160 #endif
 161        CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 162      ENDIF
 163    ENDDO
 164
 165    DO ialarm = first_auxinput, last_auxinput
 166      IF ( .FALSE.) THEN
 167        rc = 1  ! dummy statement
 168 #if ( WRF_CHEM == 1 )
 169 ! - Get chemistry data
 170      ELSE IF( ialarm .EQ. AUXINPUT5_ALARM .AND. config_flags%chem_opt > 0 ) THEN
 171        IF( config_flags%emiss_inpt_opt /= 0 ) THEN
 172          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) .OR.  &
 173          ((config_flags%restart) .AND. ( currTime .EQ. startTime ))) THEN
 174            call wrf_debug(15,' CALL med_read_wrf_chem_emiss ')
 175            CALL med_read_wrf_chem_emiss ( grid , config_flags )
 176            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 177            call wrf_debug(15,' Back from CALL med_read_wrf_chem_emiss ')
 178          ENDIF
 179        ELSE
 180          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 181            CALL med_auxinput_in ( grid, ialarm, config_flags )
 182            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 183          ENDIF
 184        ENDIF
 185      ELSE IF(( ialarm .EQ. AUXINPUT7_ALARM .AND. config_flags%chem_opt > 0 ) .or.  &
 186              ( ialarm .EQ. AUXINPUT7_ALARM .AND. config_flags%tracer_opt > 0 ) )THEN
 187        IF( config_flags%biomass_burn_opt /= 0 ) THEN
 188          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) .OR.  &
 189          ((config_flags%restart) .AND. ( currTime .EQ. startTime ))) THEN
 190            CALL med_auxinput_in ( grid, ialarm, config_flags )
 191            WRITE ( message , FMT='(A,i3,A,i3)') 'Input data processed for aux input ',&
 192                   ialarm - first_auxinput + 1, ' for domain ',grid%id
 193            CALL wrf_debug ( 15 , message )
 194            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 195          ENDIF
 196        ELSE
 197         IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 198           CALL med_auxinput_in ( grid, ialarm, config_flags )
 199           CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 200         ENDIF
 201        ENDIF
 202      ELSE IF( ialarm .EQ. AUXINPUT13_ALARM .AND. config_flags%chem_opt > 0 ) THEN
 203        IF( config_flags%emiss_opt_vol /= 0 ) THEN
 204          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 205            call wrf_debug(15,' CALL med_read_wrf_volc_emiss ')
 206            CALL med_read_wrf_volc_emiss ( grid , config_flags )
 207            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 208            call wrf_debug(15,' Back from CALL med_read_wrf_volc_emiss ')
 209          ENDIF
 210        ELSE
 211          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 212            CALL med_auxinput_in ( grid, ialarm, config_flags )
 213            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 214          ENDIF
 215        ENDIF
 216 #endif
 217      ELSE IF( ialarm .EQ. AUXINPUT17_ALARM ) THEN
 218        IF( config_flags%qna_update .EQ. 1) THEN
 219          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 220            call wrf_debug(00,' CALL med_read_qna_emissions ')
 221            CALL med_read_qna_emissions ( grid , config_flags )
 222            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 223            call wrf_debug(00,' Back from CALL med_read_qna_emissions ')
 224          ENDIF
 225        ELSE
 226          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 227            CALL med_auxinput_in ( grid, ialarm, config_flags )
 228            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 229          ENDIF
 230        ENDIF
 231 #if ( EM_CORE == 1 )
 232      ELSE IF( ialarm .EQ. AUXINPUT11_ALARM ) THEN
 233        IF( config_flags%obs_nudge_opt .EQ. 1) THEN
 234          CALL med_fddaobs_in ( grid , config_flags )
 235        ENDIF
 236 #endif
 237      ELSE IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
 238 #if ( WRFPLUS == 1 )
 239        IF ( .NOT. grid%trajectory_io ) THEN
 240           ! For adjoint integration with disk IO, the basic state is one step before the domain time.
 241           IF ( config_flags%dyn_opt .EQ. dyn_em_ad .AND. ialarm .EQ. auxinput6_only  ) THEN
 242              grid%domain_clock%clockint%CurrTime =  ESMF_TimeInc (grid%domain_clock%clockint%CurrTime, &
 243                                 grid%domain_clock%clockint%TimeStep )
 244           ENDIF
 245           CALL med_auxinput_in ( grid, ialarm, config_flags )
 246           IF ( config_flags%dyn_opt .EQ. dyn_em_ad .AND. ialarm .EQ. auxinput6_only ) THEN
 247              CALL domain_clock_get( grid, current_time=currTime, start_time=startTime, &
 248                                     current_timestr=timestr )
 249              WRITE(message, FMT='(A,A)') 'read xtraj from file at time stamp:', TRIM(timestr)
 250              CALL wrf_debug ( 1 , message )
 251           ENDIF
 252           IF ( config_flags%dyn_opt .EQ. dyn_em_ad .AND. ialarm .EQ. auxinput7_only ) THEN
 253              CALL domain_clock_get( grid, current_time=currTime, start_time=startTime, &
 254                                     current_timestr=timestr )
 255              WRITE(message, FMT='(A,A)') 'read ad. forcing from file at time stamp:', TRIM(timestr)
 256              CALL wrf_debug ( 1 , message )
 257           ENDIF
 258           IF ( ( config_flags%dyn_opt .EQ. dyn_em_ad .OR. config_flags%dyn_opt .EQ. dyn_em_tl ) &
 259                .AND. ialarm .EQ. auxinput6_only ) THEN
 260              CALL get_ijk_from_grid (  grid ,                   &
 261                                        ids, ide, jds, jde, kds, kde,    &
 262                                        ims, ime, jms, jme, kms, kme,    &
 263                                        ips, ipe, jps, jpe, kps, kpe    )
 264
 265 #ifdef DM_PARALLEL
 266              moist  => grid%moist
 267              scalar => grid%scalar
 268              chem   => grid%chem
 269              tracer => grid%tracer
 270 #  include "HALO_EM_INIT_1.inc"
 271 #  include "HALO_EM_INIT_2.inc"
 272 #  include "HALO_EM_INIT_5.inc"
 273 #endif
 274              DO ij = 1 , grid%num_tiles
 275                 CALL rk_phys_bc_dry_2( config_flags,                     &
 276                                        grid%u_2, grid%v_2, grid%w_2,     &
 277                                        grid%t_2, grid%ph_2, grid%mu_2,   &
 278                                        ids, ide, jds, jde, kds, kde,     &
 279                                        ims, ime, jms, jme, kms, kme,     &
 280                                        ips, ipe, jps, jpe, kps, kpe,     &
 281                                        grid%i_start(ij), grid%i_end(ij), &
 282                                        grid%j_start(ij), grid%j_end(ij), &
 283                                        kps    , kpe               )
 284                 DO im = PARAM_FIRST_SCALAR , num_moist
 285                    CALL set_physical_bc3d( grid%moist(:,:,:,im), 'p', config_flags,   &
 286                                            ids, ide, jds, jde, kds, kde,             &
 287                                            ims, ime, jms, jme, kms, kme,             &
 288                                            ips, ipe, jps, jpe, kps, kpe,             &
 289                                            grid%i_start(ij), grid%i_end(ij),         &
 290                                            grid%j_start(ij), grid%j_end(ij),         &
 291                                            kps    , kpe                       )
 292                 ENDDO
 293                 CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags,  &
 294                                         ids, ide, jds, jde, kds, kde,            &
 295                                         ims, ime, jms, jme, kms, kme,            &
 296                                         ips, ipe, jps, jpe, kps, kpe,            &
 297                                         grid%i_start(ij), grid%i_end(ij),        &
 298                                         grid%j_start(ij), grid%j_end(ij),        &
 299                                         kps    , kpe                     )
 300
 301              ENDDO
 302           ENDIF
 303        ELSE
 304          IF ( ialarm .EQ. auxinput6_only ) THEN ! Read Trajectory only
 305            IF ( config_flags%dyn_opt .EQ. dyn_em_ad  ) THEN
 306               grid%domain_clock%clockint%CurrTime =  ESMF_TimeInc (grid%domain_clock%clockint%CurrTime, &
 307                                 grid%domain_clock%clockint%TimeStep )
 308            ENDIF
 309            CALL domain_clock_get ( grid, current_timestr=message )
 310            IF ( config_flags%dyn_opt .EQ. dyn_em_ad ) THEN
 311              CALL read_xtraj  ( message )
 312            ELSEIF ( config_flags%dyn_opt .EQ. dyn_em_tl ) THEN
 313              CALL read_xtraj_reverse  ( message )
 314            ENDIF
 315          ENDIF
 316          IF ( ialarm .EQ. auxinput7_only ) THEN ! Read Adjoint Forcing only
 317            CALL domain_clock_get ( grid, current_timestr=message )
 318            IF ( config_flags%dyn_opt .EQ. dyn_em_ad ) THEN
 319              CALL read_ad_forcing  ( message )
 320            ENDIF
 321          ENDIF
 322        ENDIF
 323        IF ( .NOT. grid%trajectory_io ) THEN
 324           WRITE ( message , FMT='(A,i3,A,i3)' )  'Input data processed from aux input ' , &
 325              ialarm - first_auxinput + 1, ' for domain ',grid%id
 326           CALL wrf_debug ( 1 , message )
 327        ENDIF
 328        ! Reverse the current time
 329        IF ( config_flags%dyn_opt .EQ. dyn_em_ad .AND. ialarm .EQ. auxinput6_only  ) THEN
 330           CALL domain_clock_set( grid, time_step_seconds=model_config_rec%time_step )
 331           grid%domain_clock%clockint%CurrTime = ESMF_TimeInc (grid%domain_clock%clockint%CurrTime, &
 332                              grid%domain_clock%clockint%TimeStep )
 333           CALL domain_clock_set( grid, time_step_seconds=-1*model_config_rec%time_step )
 334        ENDIF
 335 #else
 336        CALL med_auxinput_in ( grid, ialarm, config_flags )
 337        WRITE ( message , FMT='(A,i3,A,i3)' )  'Input data processed for aux input ' , &
 338           ialarm - first_auxinput + 1, ' for domain ',grid%id
 339        CALL wrf_debug ( 0 , message )
 340 #endif
 341        CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
 342      ENDIF
 343    ENDDO
 344
 345 #if (WRFPLUS != 1)
 346 ! - RESTART OUTPUT
 347    CALL WRFU_ClockGet( grid%domain_clock, CurrTime=currTime, StartTime=startTime )
 348    IF ( ( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) .AND. &
 349         ( currTime .NE. startTime ) ) THEN
 350      IF ( grid%id .EQ. 1 ) THEN
 351        ! Only the parent initiates the restart writing. Otherwise, different
 352        ! domains may be written out at different times and with different
 353        ! time stamps in the file names.
 354        CALL med_restart_out ( grid , config_flags )
 355      ENDIF
 356      CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
 357    ELSE
 358      CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
 359    ENDIF
 360
 361 ! - Look for boundary data after writing out history and restart files
 362    CALL med_latbound_in ( grid , config_flags )
 363 #endif
 364
 365    RETURN
 366 END SUBROUTINE med_before_solve_io
 367
 368 #if (WRFPLUS == 1)
 369 SUBROUTINE med_last_ad_solve_io ( grid , config_flags )
 370   ! Driver layer
 371    USE module_state_description
 372    USE module_domain    , ONLY : domain, domain_clock_get
 373    USE module_configure , ONLY : grid_config_rec_type
 374    USE module_streams
 375    USE mediation_pertmod_io , ONLY : read_ad_forcing
 376   ! Model layer
 377    USE module_utility
 378
 379    IMPLICIT NONE
 380
 381   ! Arguments
 382    TYPE(domain)                               :: grid
 383    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 384   ! Local
 385    INTEGER                                    :: ialarm
 386    INTEGER                                    :: rc
 387
 388    TYPE(WRFU_Time)        :: currTime, startTime
 389    CHARACTER*256          :: message
 390    CHARACTER*80           :: timestr
 391
 392    IF( WRFU_AlarmIsRinging( grid%alarms( AUXINPUT7_ALARM ), rc=rc ) ) THEN
 393      IF ( .NOT. grid%trajectory_io ) THEN
 394         CALL med_auxinput_in ( grid, AUXINPUT7_ALARM, config_flags )
 395      ELSE
 396         CALL domain_clock_get ( grid, current_timestr=message )
 397         CALL read_ad_forcing  ( message )
 398      ENDIF
 399      IF ( .NOT. grid%trajectory_io ) THEN
 400         CALL WRFU_ClockGet( grid%domain_clock, CurrTime=currTime, StartTime=startTime )
 401         CALL domain_clock_get( grid, current_time=currTime, start_time=startTime, &
 402                                current_timestr=timestr )
 403         WRITE(message, FMT='(A,A)') 'read ad. forcing from file at time stamp:', TRIM(timestr)
 404         CALL wrf_debug ( 1 , message )
 405         WRITE ( message , FMT='(A,i3,A,i3)' )  'Input data processed from aux input ' , &
 406              AUXINPUT7_ALARM - first_auxinput + 1, ' for domain ',grid%id
 407         CALL wrf_debug ( 1 , message )
 408      ENDIF
 409      CALL WRFU_AlarmRingerOff( grid%alarms( AUXINPUT7_ALARM ), rc=rc )
 410    ENDIF
 411
 412    RETURN
 413 END SUBROUTINE med_last_ad_solve_io
 414 #endif
 415
 416 SUBROUTINE med_after_solve_io ( grid , config_flags )
 417   ! Driver layer
 418    USE module_domain    , ONLY : domain
 419    USE module_timing
 420    USE module_configure , ONLY : grid_config_rec_type
 421   ! Model layer
 422
 423    IMPLICIT NONE
 424
 425   ! Arguments
 426    TYPE(domain)                               :: grid
 427    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 428
 429    ! Compute time series variables
 430    CALL calc_ts(grid)
 431
 432    ! Compute track variables
 433    CALL track_driver(grid)
 434
 435    RETURN
 436 END SUBROUTINE med_after_solve_io
 437
 438 SUBROUTINE med_pre_nest_initial ( parent , newid , config_flags )
 439   ! Driver layer
 440 #ifdef MOVE_NESTS
 441    USE module_domain    , ONLY : domain, domain_clock_get
 442 #else
 443    USE module_domain    , ONLY : domain
 444 #endif
 445 #ifdef ESMFIO
 446    USE module_utility   , ONLY : WRFU_Time
 447 #else
 448    USE module_utility   , ONLY : WRFU_Time, WRFU_TimeEQ
 449 #endif
 450    USE module_timing
 451    USE module_io_domain
 452    USE module_configure , ONLY : grid_config_rec_type
 453   ! Model layer
 454
 455    IMPLICIT NONE
 456
 457   ! Arguments
 458    TYPE(domain) , POINTER                      :: parent
 459    INTEGER, INTENT(IN)                         :: newid
 460    TYPE (grid_config_rec_type) , INTENT(INOUT) :: config_flags
 461    TYPE (grid_config_rec_type)                 :: nest_config_flags
 462
 463   ! Local
 464    INTEGER                :: itmp, fid, ierr, icnt
 465    CHARACTER*256          :: rstname, message, timestr
 466
 467    TYPE(WRFU_Time)        :: strt_time, cur_time
 468
 469 #ifdef MOVE_NESTS
 470
 471    CALL domain_clock_get( parent, current_timestr=timestr, start_time=strt_time, current_time=cur_time )
 472    CALL construct_filename2a ( rstname , config_flags%rst_inname , newid , 2 , timestr )
 473
 474 #ifdef ESMFIO
 475     IF ( config_flags%restart .AND. (cur_time .EQ. strt_time) ) THEN
 476 #else
 477     IF ( config_flags%restart .AND. WRFU_TimeEQ(cur_time,strt_time) ) THEN
 478 #endif
 479      WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading header information only'
 480      CALL wrf_message ( message )
 481   ! note that the parent pointer is not strictly correct, but nest is not allocated yet and
 482   ! only the i/o communicator fields are used from "parent" (and those are dummies in current
 483   ! implementation.
 484      CALL open_r_dataset ( fid , TRIM(rstname) , parent , config_flags , "DATASET=RESTART", ierr )
 485      IF ( ierr .NE. 0 ) THEN
 486        WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
 487        CALL WRF_ERROR_FATAL ( message )
 488      ENDIF
 489
 490   ! update the values of parent_start that were read in from the namelist (nest may have moved)
 491      CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' ,  itmp  , 1 , icnt, ierr )
 492      IF ( ierr .EQ. 0 ) THEN
 493        config_flags%i_parent_start = itmp
 494        CALL nl_set_i_parent_start ( newid , config_flags%i_parent_start )
 495      ENDIF
 496      CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' ,  itmp  , 1 , icnt, ierr )
 497      IF ( ierr .EQ. 0 ) THEN
 498        config_flags%j_parent_start = itmp
 499        CALL nl_set_j_parent_start ( newid , config_flags%j_parent_start )
 500      ENDIF
 501
 502      CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
 503    ENDIF
 504 #endif
 505
 506 END SUBROUTINE med_pre_nest_initial
 507
 508
 509 SUBROUTINE med_nest_initial ( parent , nest , config_flags )
 510   ! Driver layer
 511    USE module_domain    , ONLY : domain , domain_clock_get , get_ijk_from_grid
 512    USE module_timing
 513    USE module_io_domain
 514    USE module_configure , ONLY : grid_config_rec_type
 515    USE module_utility
 516 #ifdef DM_PARALLEL
 517    USE module_dm, ONLY : local_communicator,                                     &
 518                          mpi_comm_to_mom, mpi_comm_to_kid, which_kid
 519 #endif
 520   ! Model layer
 521
 522    IMPLICIT NONE
 523
 524   ! Arguments
 525    TYPE(domain) , POINTER                     :: parent, nest
 526    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 527    TYPE (grid_config_rec_type)                :: nest_config_flags
 528
 529   ! Local
 530    LOGICAL, EXTERNAL      :: wrf_dm_on_monitor
 531    TYPE(WRFU_Time)        :: strt_time, cur_time
 532    CHARACTER * 256        :: rstname , timestr
 533    CHARACTER * 256        :: message
 534    INTEGER                :: fid
 535    INTEGER                :: ierr
 536    INTEGER                :: i , j, rc
 537    INTEGER                :: ids , ide , jds , jde , kds , kde , &
 538                              ims , ime , jms , jme , kms , kme , &
 539                              ips , ipe , jps , jpe , kps , kpe
 540
 541 #if (EM_CORE == 1)
 542 #ifdef MOVE_NESTS
 543    TYPE (WRFU_TimeInterval) :: interval, TimeSinceStart
 544    INTEGER :: vortex_interval , n
 545 #endif
 546    INTEGER                :: save_itimestep ! This is a kludge, correct fix will
 547                                             ! involve integrating the time-step
 548                                             ! counting into the time manager.
 549                                             ! JM 20040604
 550    REAL, ALLOCATABLE, DIMENSION(:,:) ::   save_acsnow             &
 551                                          ,save_acsnom             &
 552                                          ,save_cuppt              &
 553                                          ,save_rainc              &
 554                                          ,save_rainnc             &
 555                                          ,save_sfcevp             &
 556                                          ,save_sfcrunoff          &
 557                                          ,save_udrunoff
 558
 559
 560    INTERFACE
 561      SUBROUTINE med_interp_domain ( parent , nest )
 562         USE module_domain       , ONLY : domain
 563         TYPE(domain) , POINTER                 :: parent , nest
 564      END SUBROUTINE med_interp_domain
 565
 566     !KAL
 567      SUBROUTINE init_domain_vert_nesting ( parent, nest, use_baseparam_fr_nml )
 568     !KAL this is a driver to initialize the vertical coordinates for the nest when vertical nesting is used.
 569        USE module_domain, ONLY : domain
 570        IMPLICIT NONE
 571        TYPE(domain), POINTER                      :: parent, nest
 572        LOGICAL                                    :: use_baseparam_fr_nml
 573      END SUBROUTINE init_domain_vert_nesting
 574
 575      SUBROUTINE med_interp_domain_small ( parent , nest )
 576         USE module_domain       , ONLY : domain
 577         TYPE(domain) , POINTER                 :: parent , nest
 578      END SUBROUTINE med_interp_domain_small
 579
 580      SUBROUTINE med_initialdata_input_ptr( nest , config_flags )
 581         USE module_domain       , ONLY : domain
 582         USE module_configure    , ONLY : grid_config_rec_type
 583         TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
 584         TYPE(domain) , POINTER :: nest
 585      END SUBROUTINE med_initialdata_input_ptr
 586
 587      SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
 588        USE module_domain        , ONLY : domain
 589        USE module_configure     , ONLY : grid_config_rec_type
 590        TYPE (domain), POINTER ::  nest , parent
 591        TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
 592      END SUBROUTINE med_nest_feedback
 593
 594      SUBROUTINE start_domain ( grid , allowed_to_move )
 595         USE module_domain       , ONLY : domain
 596         TYPE(domain) :: grid
 597         LOGICAL, INTENT(IN) :: allowed_to_move
 598      END SUBROUTINE start_domain
 599
 600      SUBROUTINE  blend_terrain ( ter_interpolated , ter_input , &
 601                            ids , ide , jds , jde , kds , kde , &
 602                            ims , ime , jms , jme , kms , kme , &
 603                            ips , ipe , jps , jpe , kps , kpe )
 604        INTEGER                           :: ids , ide , jds , jde , kds , kde , &
 605                                             ims , ime , jms , jme , kms , kme , &
 606                                             ips , ipe , jps , jpe , kps , kpe
 607        REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
 608        REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
 609      END SUBROUTINE blend_terrain
 610
 611      SUBROUTINE  copy_3d_field ( ter_interpolated , ter_input , &
 612                            ids , ide , jds , jde , kds , kde , &
 613                            ims , ime , jms , jme , kms , kme , &
 614                            ips , ipe , jps , jpe , kps , kpe )
 615        INTEGER                           :: ids , ide , jds , jde , kds , kde , &
 616                                             ims , ime , jms , jme , kms , kme , &
 617                                             ips , ipe , jps , jpe , kps , kpe
 618        REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
 619        REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
 620      END SUBROUTINE copy_3d_field
 621
 622      SUBROUTINE  input_terrain_rsmas ( grid ,                  &
 623                            ids , ide , jds , jde , kds , kde , &
 624                            ims , ime , jms , jme , kms , kme , &
 625                            ips , ipe , jps , jpe , kps , kpe )
 626        USE module_domain        , ONLY : domain
 627        TYPE ( domain ) :: grid
 628        INTEGER                           :: ids , ide , jds , jde , kds , kde , &
 629                                             ims , ime , jms , jme , kms , kme , &
 630                                             ips , ipe , jps , jpe , kps , kpe
 631      END SUBROUTINE input_terrain_rsmas
 632
 633      SUBROUTINE wrf_tsin ( grid , ierr )
 634         USE module_domain
 635         TYPE ( domain ), INTENT(INOUT) :: grid
 636         INTEGER, INTENT(INOUT) :: ierr
 637      END SUBROUTINE wrf_tsin
 638
 639    END INTERFACE
 640
 641    CALL interp_init
 642
 643    CALL domain_clock_get( parent, start_time=strt_time, current_time=cur_time )
 644
 645    IF ( .not. ( config_flags%restart .AND. strt_time .EQ. cur_time ) ) THEN
 646      nest%first_force = .true.
 647
 648      IF ( nest%active_this_task ) THEN
 649 ! initialize nest with interpolated data from the parent
 650        nest%imask_nostag = 1
 651        nest%imask_xstag = 1
 652        nest%imask_ystag = 1
 653        nest%imask_xystag = 1
 654      ENDIF
 655
 656 #ifdef MOVE_NESTS
 657      parent%nest_pos = parent%ht
 658      where ( parent%nest_pos .gt. 0. ) parent%nest_pos = parent%nest_pos + 500.  ! make a cliff
 659 #endif
 660
 661 ! initialize some other constants (and 1d arrays in z)
 662      CALL init_domain_constants ( parent, nest )
 663
 664      if (nest%e_vert /= parent%e_vert) then
 665          ! set up coordinate variables for nest with vertical grid refinement (1d variables in z are done later in med_interp_domain)
 666        CALL init_domain_vert_nesting ( parent, nest, config_flags%use_baseparam_fr_nml )
 667      endif
 668
 669
 670 ! fill in entire fine grid domain with interpolated coarse grid data
 671      CALL med_interp_domain( parent, nest )
 672
 673 !  De-reference dimension information stored in the grid data structure.
 674      CALL get_ijk_from_grid (  nest ,                   &
 675                                ids, ide, jds, jde, kds, kde,    &
 676                                ims, ime, jms, jme, kms, kme,    &
 677                                ips, ipe, jps, jpe, kps, kpe    )
 678
 679 ! get the nest config flags
 680      CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
 681
 682      IF ( nest_config_flags%input_from_file .OR. nest_config_flags%input_from_hires ) THEN
 683
 684        WRITE(message,FMT='(A,I2,A)') '*** Initializing nest domain #',nest%id,&
 685                                       ' from an input file. ***'
 686        CALL wrf_debug ( 0 , message )
 687
 688 ! Store horizontally interpolated terrain-based fields in temp location if the input
 689 ! data is from a pristine, un-cycled model input file.  For the original topo from
 690 ! the real program, we will need to adjust the terrain (and a couple of other base-
 691 ! state fields) so reflect the smoothing and matching between the parent and child
 692 ! domains.
 693
 694        CALL  copy_3d_field ( nest%ht_int  , nest%ht , &
 695                              ids , ide , jds , jde , 1   , 1   , &
 696                              ims , ime , jms , jme , 1   , 1   , &
 697                              ips , ipe , jps , jpe , 1   , 1   )
 698        CALL  copy_3d_field ( nest%mub_fine , nest%mub , &
 699                              ids , ide , jds , jde , 1   , 1   , &
 700                              ims , ime , jms , jme , 1   , 1   , &
 701                              ips , ipe , jps , jpe , 1   , 1   )
 702        CALL  copy_3d_field ( nest%phb_fine , nest%phb , &
 703                              ids , ide , jds , jde , kds , kde , &
 704                              ims , ime , jms , jme , kms , kme , &
 705                              ips , ipe , jps , jpe , kps , kpe )
 706
 707        IF ( nest_config_flags%input_from_file ) THEN
 708 ! read input from dataset
 709           CALL med_initialdata_input_ptr( nest , nest_config_flags )
 710
 711        ELSE IF ( nest_config_flags%input_from_hires ) THEN
 712 ! read in high res topography
 713           CALL  input_terrain_rsmas ( nest,                               &
 714                                       ids , ide , jds , jde , 1   , 1   , &
 715                                       ims , ime , jms , jme , 1   , 1   , &
 716                                       ips , ipe , jps , jpe , 1   , 1   )
 717        ENDIF
 718
 719        ! save elevation and mub for temp and qv adjustment
 720
 721        CALL  copy_3d_field ( nest%ht_fine , nest%ht , &
 722                              ids , ide , jds , jde , 1   , 1   , &
 723                              ims , ime , jms , jme , 1   , 1   , &
 724                              ips , ipe , jps , jpe , 1   , 1   )
 725        CALL  copy_3d_field ( nest%mub_save , nest%mub , &
 726                              ids , ide , jds , jde , 1   , 1   , &
 727                              ims , ime , jms , jme , 1   , 1   , &
 728                              ips , ipe , jps , jpe , 1   , 1   )
 729
 730 ! blend parent and nest fields: terrain, mub, and phb.  The ht, mub and phb are used in start_domain.
 731
 732        IF ( nest%save_topo_from_real == 1 ) THEN
 733           CALL  blend_terrain ( nest%ht_int  , nest%ht , &
 734                                 ids , ide , jds , jde , 1   , 1   , &
 735                                 ims , ime , jms , jme , 1   , 1   , &
 736                                 ips , ipe , jps , jpe , 1   , 1   )
 737           CALL  blend_terrain ( nest%mub_fine , nest%mub , &
 738                                 ids , ide , jds , jde , 1   , 1   , &
 739                                 ims , ime , jms , jme , 1   , 1   , &
 740                                 ips , ipe , jps , jpe , 1   , 1   )
 741           CALL  blend_terrain ( nest%phb_fine , nest%phb , &
 742                                 ids , ide , jds , jde , kds , kde , &
 743                                 ims , ime , jms , jme , kms , kme , &
 744                                 ips , ipe , jps , jpe , kps , kpe )
 745        ENDIF
 746
 747        !  adjust temp and qv
 748
 749        CALL adjust_tempqv ( nest%mub , nest%mub_save , &
 750                             nest%c3h , nest%c4h , nest%znw , nest%p_top , &
 751                             nest%t_2 , nest%p , nest%moist(ims,kms,jms,P_QV) , &
 752                             nest_config_flags%use_theta_m, &
 753                             ids , ide , jds , jde , kds , kde , &
 754                             ims , ime , jms , jme , kms , kme , &
 755                             ips , ipe , jps , jpe , kps , kpe )
 756
 757      ELSE
 758        WRITE(message,FMT='(A,I2,A,I2,A)') '*** Initializing nest domain #',nest%id,&
 759                                      ' by horizontally interpolating parent domain #' ,parent%id, &
 760                                      '. ***'
 761        CALL wrf_debug ( 0 , message )
 762
 763 #if (DA_CORE != 1)
 764        ! For nests without an input file, we still need to read time series locations
 765        !   from the tslist file
 766        IF ( nest%active_this_task) THEN
 767           CALL push_communicators_for_domain( nest%id )
 768           CALL wrf_tsin( nest , ierr )
 769           CALL pop_communicators_for_domain
 770        ENDIF
 771 #endif
 772      END IF
 773
 774 ! feedback, mostly for this new terrain, but it is the safe thing to do
 775      parent%ht_coarse = parent%ht
 776
 777      CALL med_nest_feedback ( parent , nest , config_flags )
 778
 779 ! This is the new interpolation for specific 3d arrays that are sensitive to the
 780 ! topography diffs betwixt the CG and the FG.
 781      IF ( config_flags%nest_interp_coord .EQ. 1 ) THEN
 782        call wrf_debug(1,'mediation_integrate.F, calling   med_interp_domain_small')
 783        CALL med_interp_domain_small( parent, nest )
 784        call wrf_debug(1,'mediation_integrate.F, back from med_interp_domain_small')
 785      END IF
 786
 787 ! set some other initial fields, fill out halos, base fields; re-do parent due
 788 ! to new terrain elevation from feedback
 789
 790      IF ( nest%active_this_task) THEN
 791        nest%imask_nostag = 1
 792        nest%imask_xstag = 1
 793        nest%imask_ystag = 1
 794        nest%imask_xystag = 1
 795        nest%press_adj = .TRUE.
 796        CALL push_communicators_for_domain( nest%id )
 797        CALL start_domain ( nest , .TRUE. )
 798        CALL pop_communicators_for_domain
 799      ENDIF
 800
 801 #if defined(DM_PARALLEL) && ! defined(STUBMPI)
 802      CALL push_communicators_for_domain( parent%id )
 803      CALL MPI_Barrier( local_communicator, ierr )
 804      CALL pop_communicators_for_domain
 805 #endif
 806
 807      IF ( parent%active_this_task ) THEN
 808      CALL push_communicators_for_domain( parent%id )
 809 ! kludge: 20040604
 810      CALL get_ijk_from_grid (  parent ,                   &
 811                                ids, ide, jds, jde, kds, kde,    &
 812                                ims, ime, jms, jme, kms, kme,    &
 813                                ips, ipe, jps, jpe, kps, kpe    )
 814
 815      ALLOCATE( save_acsnow(ims:ime,jms:jme) )
 816      ALLOCATE( save_acsnom(ims:ime,jms:jme) )
 817      ALLOCATE( save_cuppt(ims:ime,jms:jme) )
 818      ALLOCATE( save_rainc(ims:ime,jms:jme) )
 819      ALLOCATE( save_rainnc(ims:ime,jms:jme) )
 820      ALLOCATE( save_sfcevp(ims:ime,jms:jme) )
 821      ALLOCATE( save_sfcrunoff(ims:ime,jms:jme) )
 822      ALLOCATE( save_udrunoff(ims:ime,jms:jme) )
 823      save_acsnow       = parent%acsnow
 824      save_acsnom       = parent%acsnom
 825      save_cuppt        = parent%cuppt
 826      save_rainc        = parent%rainc
 827      save_rainnc       = parent%rainnc
 828      save_sfcevp       = parent%sfcevp
 829      save_sfcrunoff    = parent%sfcrunoff
 830      save_udrunoff     = parent%udrunoff
 831      save_itimestep    = parent%itimestep
 832      parent%imask_nostag = 1
 833      parent%imask_xstag = 1
 834      parent%imask_ystag = 1
 835      parent%imask_xystag = 1
 836
 837      parent%press_adj = .FALSE.
 838      CALL start_domain ( parent , .TRUE. )
 839
 840      parent%acsnow     = save_acsnow
 841      parent%acsnom     = save_acsnom
 842      parent%cuppt      = save_cuppt
 843      parent%rainc      = save_rainc
 844      parent%rainnc     = save_rainnc
 845      parent%sfcevp     = save_sfcevp
 846      parent%sfcrunoff  = save_sfcrunoff
 847      parent%udrunoff   = save_udrunoff
 848      parent%itimestep  = save_itimestep
 849      DEALLOCATE( save_acsnow )
 850      DEALLOCATE( save_acsnom )
 851      DEALLOCATE( save_cuppt )
 852      DEALLOCATE( save_rainc )
 853      DEALLOCATE( save_rainnc )
 854      DEALLOCATE( save_sfcevp )
 855      DEALLOCATE( save_sfcrunoff )
 856      DEALLOCATE( save_udrunoff )
 857 ! end of kludge: 20040604
 858      CALL pop_communicators_for_domain
 859      ENDIF
 860
 861   ELSE  ! restart
 862
 863 !TODO -- have to look at restarts yet
 864
 865      IF ( wrf_dm_on_monitor() ) CALL start_timing
 866
 867      CALL domain_clock_get( nest, current_timestr=timestr )
 868      CALL construct_filename2a ( rstname , config_flags%rst_inname , nest%id , 2 , timestr )
 869
 870      WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading'
 871      CALL wrf_message ( message )
 872      CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
 873      CALL open_r_dataset ( fid , TRIM(rstname) , nest , nest_config_flags , "DATASET=RESTART", ierr )
 874      IF ( ierr .NE. 0 ) THEN
 875        WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
 876        CALL WRF_ERROR_FATAL ( message )
 877      ENDIF
 878      CALL input_restart ( fid,   nest , nest_config_flags , ierr )
 879      CALL close_dataset ( fid , nest_config_flags , "DATASET=RESTART" )
 880
 881      IF ( wrf_dm_on_monitor() ) THEN
 882        WRITE ( message , FMT = '("processing restart file for domain ",I8)' ) nest%id
 883        CALL end_timing ( TRIM(message) )
 884      ENDIF
 885
 886      nest%imask_nostag = 1
 887      nest%imask_xstag = 1
 888      nest%imask_ystag = 1
 889      nest%imask_xystag = 1
 890      nest%press_adj = .FALSE.
 891      CALL start_domain ( nest , .TRUE. )
 892 #ifndef MOVE_NESTS
 893 ! this doesn't need to be done for moving nests, since ht_coarse is part of the restart
 894      parent%ht_coarse = parent%ht
 895 #else
 896 #  if 1
 897 ! In case of a restart, assume that the movement has already occurred in the previous
 898 ! run and turn off the alarm for the starting time. We must impose a requirement that the
 899 ! run be restarted on-interval.  Test for that and print a warning if it isn't.
 900 ! Note, simulation_start, etc. should be available as metadata in the restart file, and
 901 ! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
 902 ! using the nl_get routines below.  JM 20060314
 903
 904      CALL nl_get_vortex_interval ( nest%id , vortex_interval )
 905      CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
 906
 907      CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
 908      n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
 909      IF ( ( interval * n ) .NE. TimeSinceStart ) THEN
 910        CALL wrf_message('WARNING: Restart is not on a vortex_interval time boundary.')
 911        CALL wrf_message('The code will work but results will not agree exactly with a ')
 912        CALL wrf_message('a run that was done straight-through, without a restart.')
 913      ENDIF
 914 !! In case of a restart, assume that the movement has already occurred in the previous
 915 !! run and turn off the alarm for the starting time. We must impose a requirement that the
 916 !! run be restarted on-interval.  Test for that and print a warning if it isn't.
 917 !! Note, simulation_start, etc. should be available as metadata in the restart file, and
 918 !! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
 919 !! using the nl_get routines below.  JM 20060314
 920 !     CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
 921
 922 #  else
 923 ! this code, currently commented out, is an attempt to have the
 924 ! vortex centering interval be set according to simulation start
 925 ! time (rather than run start time) in case of a restart. But
 926 ! there are other problems (the WRF clock is currently using
 927 ! run-start as it's start time) so the alarm still would not fire
 928 ! right if the model were started off-interval.  Leave it here and
 929 ! enable when the clock is changed to use sim-start for start time.
 930 ! JM 20060314
 931      CALL nl_get_vortex_interval ( nest%id , vortex_interval )
 932      CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
 933
 934      CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
 935
 936      CALL domain_alarm_create( nest,  COMPUTE_VORTEX_CENTER_ALARM, interval  )
 937      CALL WRFU_AlarmEnable( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
 938      n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
 939      IF ( ( interval * n ) .EQ. TimeSinceStart ) THEN
 940        CALL WRFU_AlarmRingerOn( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
 941      ELSE
 942        CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
 943      ENDIF
 944 #  endif
 945 #endif
 946
 947   ENDIF
 948
 949 #endif
 950
 951   RETURN
 952 END SUBROUTINE med_nest_initial
 953
 954 SUBROUTINE init_domain_constants ( parent , nest )
 955    USE module_domain    , ONLY : domain
 956    IMPLICIT NONE
 957    TYPE(domain) :: parent , nest
 958 #if (EM_CORE == 1)
 959    CALL init_domain_constants_em ( parent, nest )
 960 #endif
 961 END SUBROUTINE init_domain_constants
 962
 963
 964 SUBROUTINE med_nest_force ( parent , nest )
 965   ! Driver layer
 966    USE module_domain    , ONLY : domain
 967    USE module_timing
 968    USE module_configure , ONLY : grid_config_rec_type
 969   ! Model layer
 970   ! External
 971    USE module_utility
 972
 973    IMPLICIT NONE
 974
 975   ! Arguments
 976    TYPE(domain) , POINTER                     :: parent, nest
 977   ! Local
 978    INTEGER                                    :: idum1 , idum2 , fid, rc
 979
 980    INTERFACE
 981      SUBROUTINE med_force_domain ( parent , nest )
 982         USE module_domain       , ONLY : domain
 983         TYPE(domain) , POINTER                 :: parent , nest
 984      END SUBROUTINE med_force_domain
 985      SUBROUTINE med_interp_domain ( parent , nest )
 986         USE module_domain       , ONLY : domain
 987         TYPE(domain) , POINTER                 :: parent , nest
 988      END SUBROUTINE med_interp_domain
 989    END INTERFACE
 990
 991    IF ( .NOT. WRFU_ClockIsStopTime(nest%domain_clock ,rc=rc) ) THEN
 992 ! initialize nest with interpolated data from the parent
 993      IF ( nest%active_this_task ) THEN
 994        nest%imask_nostag = 1
 995        nest%imask_xstag = 1
 996        nest%imask_ystag = 1
 997        nest%imask_xystag = 1
 998      ENDIF
 999      CALL med_force_domain( parent, nest )
1000    ENDIF
1001
1002 ! might also have calls here to do input from a file into the nest
1003
1004    RETURN
1005 END SUBROUTINE med_nest_force
1006
1007 SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
1008   ! Driver layer
1009    USE module_domain    , ONLY : domain , get_ijk_from_grid
1010    USE module_timing
1011    USE module_configure , ONLY : grid_config_rec_type
1012   ! Model layer
1013   ! External
1014    USE module_utility
1015    IMPLICIT NONE
1016
1017
1018   ! Arguments
1019    TYPE(domain) , POINTER                     :: parent, nest
1020    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1021   ! Local
1022    INTEGER                                    :: idum1 , idum2 , fid, rc
1023    INTEGER                         :: ids , ide , jds , jde , kds , kde , &
1024                                       ims , ime , jms , jme , kms , kme , &
1025                                       ips , ipe , jps , jpe , kps , kpe
1026    INTEGER i,j
1027
1028    INTERFACE
1029      SUBROUTINE med_feedback_domain ( parent , nest )
1030         USE module_domain       , ONLY : domain
1031         TYPE(domain) , POINTER                 :: parent , nest
1032      END SUBROUTINE med_feedback_domain
1033    END INTERFACE
1034
1035 ! feedback nest to the parent
1036     IF ( config_flags%feedback .NE. 0 ) THEN
1037       CALL med_feedback_domain( parent, nest )
1038 #ifdef MOVE_NESTS
1039       IF ( parent%active_this_task) THEN
1040       CALL get_ijk_from_grid (  parent ,                         &
1041                                 ids, ide, jds, jde, kds, kde,    &
1042                                 ims, ime, jms, jme, kms, kme,    &
1043                                 ips, ipe, jps, jpe, kps, kpe    )
1044 ! gopal's change- added ifdef
1045 #if ( EM_CORE == 1 )
1046       DO j = jps, MIN(jpe,jde-1)
1047       DO i = ips, MIN(ipe,ide-1)
1048         IF      ( parent%nest_pos(i,j) .EQ. 9021000. ) THEN
1049           parent%nest_pos(i,j) = parent%ht(i,j)*1.5 + 1000.
1050         ELSE IF ( parent%ht(i,j) .NE. 0. ) THEN
1051           parent%nest_pos(i,j) = parent%ht(i,j) + 500.
1052         ELSE
1053           parent%nest_pos(i,j) = 0.
1054         ENDIF
1055       ENDDO
1056       ENDDO
1057 #endif
1058       ENDIF
1059 #endif
1060     END IF
1061
1062    RETURN
1063 END SUBROUTINE med_nest_feedback
1064
1065 SUBROUTINE med_last_solve_io ( grid , config_flags )
1066   ! Driver layer
1067    USE module_state_description
1068    USE module_domain    , ONLY : domain, domain_clock_get
1069    USE module_configure , ONLY : grid_config_rec_type
1070    USE module_utility
1071    USE module_streams
1072 #if ( WRFPLUS == 1 )
1073    USE mediation_pertmod_io , ONLY : save_xtraj, save_tl_pert
1074 #endif
1075   ! Model layer
1076
1077    IMPLICIT NONE
1078
1079   ! Arguments
1080    TYPE(domain)                               :: grid
1081    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1082   ! Local
1083    INTEGER                                    :: rc
1084    CHARACTER*256                              :: message
1085
1086 ! #if (EM_CORE == 1)
1087    IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) .AND. &
1088        (grid%dfi_write_dfi_history .OR. grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI) ) THEN
1089 ! #else
1090 !    IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc )) THEN
1091 ! #endif
1092      CALL med_hist_out ( grid , HISTORY_ALARM , config_flags )
1093    ENDIF
1094
1095    IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
1096      CALL med_filter_out  ( grid , config_flags )
1097    ENDIF
1098
1099 ! registry-generated file of the following
1100 !   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST1_ALARM ), rc=rc ) ) THEN
1101 !     CALL med_hist_out ( grid , AUXHIST1_ALARM , config_flags )
1102 !   ENDIF
1103    IF ( grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI ) THEN
1104 #include "med_last_solve_io.inc"
1105    END IF
1106
1107 ! - RESTART OUTPUT
1108    IF( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) THEN
1109      IF ( grid%id .EQ. 1 ) THEN
1110        CALL med_restart_out ( grid , config_flags )
1111      ENDIF
1112    ENDIF
1113
1114    ! Write out time series
1115    CALL write_ts( grid )
1116
1117    RETURN
1118 END SUBROUTINE med_last_solve_io
1119
1120 #endif
1121
1122 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1123
1124 RECURSIVE SUBROUTINE med_restart_out ( grid , config_flags )
1125   ! Driver layer
1126    USE module_domain    , ONLY : domain , domain_clock_get
1127    USE module_io_domain
1128    USE module_timing
1129    USE module_configure , ONLY : grid_config_rec_type
1130   ! Model layer
1131 !   USE module_bc_time_utilities
1132    USE module_utility
1133
1134    IMPLICIT NONE
1135
1136   ! Arguments
1137    TYPE(domain)                               :: grid
1138    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1139
1140   ! Local
1141    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1142    CHARACTER*256                          :: rstname , outname
1143    INTEGER                                :: fid , rid, kid
1144    CHARACTER (LEN=256)                    :: message
1145    INTEGER                                :: ierr
1146    INTEGER                                :: myproc
1147    CHARACTER*80                           :: timestr
1148    TYPE (grid_config_rec_type)            :: kid_config_flags
1149
1150    IF ( wrf_dm_on_monitor() ) THEN
1151      CALL start_timing
1152    END IF
1153
1154 ! take this out - no effect - LPC
1155 !   rid=grid%id !zhang's doing
1156
1157    ! write out this domains restart file first
1158
1159    CALL domain_clock_get( grid, current_timestr=timestr )
1160    CALL construct_filename2a ( rstname , config_flags%rst_outname , grid%id , 2 , timestr )
1161
1162    WRITE( message , '("med_restart_out: opening ",A," for writing")' ) TRIM ( rstname )
1163    CALL wrf_debug( 1 , message )
1164    CALL open_w_dataset ( rid, TRIM(rstname), grid , &
1165                          config_flags , output_restart , "DATASET=RESTART", ierr )
1166
1167    IF ( ierr .NE. 0 ) THEN
1168      CALL WRF_message( message )
1169    ENDIF
1170    CALL output_restart ( rid, grid , config_flags , ierr )
1171    IF ( wrf_dm_on_monitor() ) THEN
1172      WRITE ( message , FMT = '("Writing restart for domain ",I8)' ) grid%id
1173      CALL end_timing ( TRIM(message) )
1174    END IF
1175    CALL close_dataset ( rid , config_flags , "DATASET=RESTART" )
1176
1177    ! call recursively for children, (if any)
1178    DO kid = 1, max_nests
1179       IF ( ASSOCIATED( grid%nests(kid)%ptr ) ) THEN
1180         CALL model_to_grid_config_rec ( grid%nests(kid)%ptr%id , model_config_rec , kid_config_flags )
1181         CALL med_restart_out ( grid%nests(kid)%ptr , kid_config_flags )
1182       ENDIF
1183    ENDDO
1184
1185    RETURN
1186 END SUBROUTINE med_restart_out
1187
1188 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1189
1190 SUBROUTINE med_hist_out ( grid , stream, config_flags )
1191   ! Driver layer
1192    USE module_domain    , ONLY : domain
1193    USE module_timing
1194    USE module_io_domain
1195    USE module_configure , ONLY : grid_config_rec_type
1196    USE module_dm, ONLY : intercomm_active
1197 !   USE module_bc_time_utilities
1198    USE module_utility
1199
1200    IMPLICIT NONE
1201   ! Arguments
1202    TYPE(domain)                               :: grid
1203    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1204    INTEGER , INTENT(IN)                       :: stream
1205   ! Local
1206    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1207    CHARACTER*256                          :: fname, n2
1208    CHARACTER (LEN=256)                    :: message
1209    INTEGER                                :: ierr
1210
1211    IF ( .NOT. grid%active_this_task ) RETURN
1212
1213    IF ( wrf_dm_on_monitor() ) THEN
1214      CALL start_timing
1215    END IF
1216
1217    IF ( stream .LT. first_history .OR. stream .GT. last_auxhist ) THEN
1218      WRITE(message,*)'med_hist_out: invalid history stream ',stream
1219      CALL wrf_error_fatal( message )
1220    ENDIF
1221
1222    SELECT CASE( stream )
1223      CASE ( HISTORY_ALARM )
1224        CALL open_hist_w( grid, config_flags, stream, HISTORY_ALARM, &
1225                          config_flags%history_outname, grid%oid,    &
1226                          output_history, fname, n2, ierr )
1227        CALL output_history ( grid%oid, grid , config_flags , ierr )
1228
1229 ! registry-generated selections and calls top open_hist_w for aux streams
1230 #include "med_hist_out_opens.inc"
1231
1232    END SELECT
1233
1234    WRITE(message,*)'med_hist_out: opened ',TRIM(fname),' as ',TRIM(n2)
1235    CALL wrf_debug( 1, message )
1236
1237    grid%nframes(stream) = grid%nframes(stream) + 1
1238
1239    SELECT CASE( stream )
1240      CASE ( HISTORY_ALARM )
1241        IF ( grid%nframes(stream) >= config_flags%frames_per_outfile ) THEN
1242 write(0,*)__FILE__,__LINE__,trim(n2)
1243 write(0,*)__FILE__,__LINE__,' grid%id ',grid%id,' grid%oid ',grid%oid
1244          CALL close_dataset ( grid%oid , config_flags , n2 )
1245          grid%oid = 0
1246          grid%nframes(stream) = 0
1247        ENDIF
1248 ! registry-generated selections and calls top close_dataset for aux streams
1249 #include "med_hist_out_closes.inc"
1250
1251    END SELECT
1252    IF ( wrf_dm_on_monitor() ) THEN
1253      WRITE ( message , FMT = '("Writing ",A," for domain ",I8)' )TRIM(fname),grid%id
1254      CALL end_timing ( TRIM(message) )
1255    END IF
1256
1257    RETURN
1258 END SUBROUTINE med_hist_out
1259
1260 #if (DA_CORE != 1)
1261 SUBROUTINE med_fddaobs_in ( grid , config_flags )
1262    USE module_domain    , ONLY : domain
1263    USE module_configure , ONLY : grid_config_rec_type
1264    IMPLICIT NONE
1265    TYPE(domain)                               :: grid
1266    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1267    CALL wrf_fddaobs_in( grid, config_flags )
1268    RETURN
1269 END SUBROUTINE med_fddaobs_in
1270 #endif
1271
1272 SUBROUTINE med_auxinput_in ( grid , stream, config_flags )
1273   ! Driver layer
1274    USE module_domain    , ONLY : domain
1275    USE module_io_domain
1276   ! Model layer
1277    USE module_configure , ONLY : grid_config_rec_type
1278 !   USE module_bc_time_utilities
1279    USE module_utility
1280
1281    IMPLICIT NONE
1282   ! Arguments
1283    TYPE(domain)                               :: grid
1284    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1285    INTEGER , INTENT(IN)                       :: stream
1286   ! Local
1287    CHARACTER (LEN=256)                        :: message
1288    INTEGER :: ierr
1289
1290    IF ( stream .LT. first_auxinput .OR. stream .GT. last_auxinput ) THEN
1291      WRITE(message,*)'med_auxinput_in: invalid input stream ',stream
1292      CALL wrf_error_fatal( message )
1293    ENDIF
1294
1295    grid%nframes(stream) = grid%nframes(stream) + 1
1296
1297    SELECT CASE( stream )
1298 ! registry-generated file of calls to open filename
1299 !     CASE ( AUXINPUT1_ALARM )
1300 !       CALL open_aux_u( grid, config_flags, stream, AUXINPUT1_ALARM,       &
1301 !                        config_flags%auxinput1_inname, grid%auxinput1_oid, &
1302 !                        input_auxinput1, ierr )
1303 !       CALL input_auxinput1 ( grid%auxinput1_oid, grid , config_flags , ierr )
1304 #include "med_auxinput_in.inc"
1305    END SELECT
1306
1307    SELECT CASE( stream )
1308 ! registry-generated selections and calls top close_dataset for aux streams
1309 #include "med_auxinput_in_closes.inc"
1310    END SELECT
1311
1312    RETURN
1313 END SUBROUTINE med_auxinput_in
1314
1315 SUBROUTINE med_filter_out ( grid , config_flags )
1316   ! Driver layer
1317    USE module_domain    , ONLY : domain , domain_clock_get
1318    USE module_io_domain
1319    USE module_timing
1320    USE module_configure , ONLY : grid_config_rec_type
1321   ! Model layer
1322    USE module_bc_time_utilities
1323
1324    IMPLICIT NONE
1325
1326   ! Arguments
1327    TYPE(domain)                               :: grid
1328    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1329
1330    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1331    CHARACTER*256                          :: rstname , outname
1332    INTEGER                                :: fid , rid
1333    CHARACTER (LEN=256)                    :: message
1334    INTEGER                                :: ierr
1335    INTEGER                                :: myproc
1336    CHARACTER*80                           :: timestr
1337
1338    IF ( config_flags%write_input ) THEN
1339
1340    IF ( wrf_dm_on_monitor() ) THEN
1341      CALL start_timing
1342    END IF
1343
1344      CALL domain_clock_get( grid, current_timestr=timestr )
1345      CALL construct_filename2a ( outname , config_flags%input_outname , grid%id , 2 , timestr )
1346
1347      WRITE ( message , '("med_filter_out 1: opening ",A," for writing. ")') TRIM ( outname )
1348      CALL wrf_debug( 1, message )
1349
1350      CALL open_w_dataset ( fid, TRIM(outname), grid ,  &
1351                            config_flags , output_input , "DATASET=INPUT", ierr )
1352      IF ( ierr .NE. 0 ) THEN
1353        CALL wrf_error_fatal( message )
1354      ENDIF
1355
1356      IF ( ierr .NE. 0 ) THEN
1357        CALL wrf_error_fatal( message )
1358      ENDIF
1359
1360    CALL output_input ( fid, grid , config_flags , ierr )
1361    CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
1362
1363    IF ( wrf_dm_on_monitor() ) THEN
1364      WRITE ( message , FMT = '("Writing filter output for domain ",I8)' ) grid%id
1365      CALL end_timing ( TRIM(message) )
1366    END IF
1367    ENDIF
1368
1369    RETURN
1370 END SUBROUTINE med_filter_out
1371
1372 SUBROUTINE med_latbound_in ( grid , config_flags )
1373   ! Driver layer
1374    USE module_domain    , ONLY : domain , domain_clock_get, head_grid
1375    USE module_io_domain
1376    USE module_timing
1377    USE module_configure , ONLY : grid_config_rec_type
1378   ! Model layer
1379 !   USE module_bc_time_utilities
1380    USE module_utility
1381
1382    IMPLICIT NONE
1383
1384 #include "wrf_status_codes.h"
1385
1386   ! Arguments
1387    TYPE(domain)                               :: grid
1388    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1389
1390   ! Local data
1391    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
1392    LOGICAL                                :: lbc_opened
1393    INTEGER                                :: idum1 , idum2 , ierr , open_status , fid, rc
1394    REAL                                   :: bfrq
1395    CHARACTER (LEN=256)                    :: message
1396    CHARACTER (LEN=256)                    :: bdyname
1397    Type (WRFU_Time )                      :: startTime, stopTime, currentTime
1398    Type (WRFU_TimeInterval )              :: stepTime
1399 integer myproc,i,j,k
1400    CHARACTER(LEN=80)                      :: timestr
1401
1402 #include "wrf_io_flags.h"
1403
1404    CALL wrf_debug ( 200 , 'in med_latbound_in' )
1405
1406 ! #if (EM_CORE == 1)
1407    ! Avoid trying to re-read the boundary conditions if we are doing DFI integration
1408    !    and do not expect to find boundary conditions for the current time
1409    IF ( (grid%dfi_opt .EQ. DFI_DDFI .OR. grid%dfi_opt .EQ. DFI_TDFI) .AND. grid%dfi_stage .EQ. DFI_FWD ) RETURN
1410 ! #endif
1411
1412    IF ( grid%active_this_task .AND. grid%id .EQ. 1 .AND. config_flags%specified .AND. config_flags%io_form_boundary .GT. 0 ) THEN
1413
1414      CALL domain_clock_get( grid, current_time=currentTime, &
1415                                   start_time=startTime,     &
1416                                   stop_time=stopTime,       &
1417                                   time_step=stepTime )
1418
1419 !jm 20110828
1420 !jm The test below never worked because set_time_time_read_again is never called to store a
1421 !jm time that lbc_read_time can compare with currentTime (see module_bc_time_utilities). This means
1422 !jm lbc_read_time will never return anything but false -- will also generate an ESMF error that the
1423 !jm stored time was never initialized.  Removing that branch from the conditional.
1424 !jm     IF ( ( lbc_read_time( currentTime ) ) .AND. &
1425 !jm          ( currentTime + stepTime .GE. stopTime ) .AND. &
1426 !jm          ( currentTime .NE. startTime ) ) THEN
1427 !jm       CALL wrf_debug( 100 , 'med_latbound_in: Skipping attempt to read lateral boundary file during last time step ' )
1428 !jm
1429 !jm     ELSE IF ( WRFU_AlarmIsRinging( grid%alarms( BOUNDARY_ALARM ), rc=rc ) ) THEN
1430 !jm 20110828
1431      IF ( WRFU_AlarmIsRinging( grid%alarms( BOUNDARY_ALARM ), rc=rc ) ) THEN
1432        CALL wrf_debug ( 100 , 'in med_latbound_in preparing to read' )
1433        CALL WRFU_AlarmRingerOff( grid%alarms( BOUNDARY_ALARM ), rc=rc )
1434        IF ( wrf_dm_on_monitor() ) CALL start_timing
1435
1436        ! Possibility to have a <date> as part of the bdy_inname.
1437        IF ( config_flags%multi_bdy_files ) THEN
1438          CALL domain_clock_get( grid, current_timestr=timestr )
1439          CALL construct_filename2a ( bdyname , config_flags%bdy_inname , grid%id , 2 , timestr )
1440
1441        ! typically a <date> wouldn't be part of the bdy_inname, so just pass a dummy
1442        ELSE
1443          CALL construct_filename2a ( bdyname , config_flags%bdy_inname , grid%id , 2 , " " )
1444
1445        END IF
1446
1447        CALL wrf_inquire_opened(grid%lbc_fid , TRIM(bdyname) , open_status , ierr )
1448        IF ( open_status .EQ. WRF_FILE_OPENED_FOR_READ ) THEN
1449          lbc_opened = .TRUE.
1450        ELSE
1451          lbc_opened = .FALSE.
1452        ENDIF
1453        CALL wrf_dm_bcast_bytes ( lbc_opened , LWORDSIZE )
1454        IF ( .NOT. lbc_opened ) THEN
1455           IF ( config_flags%multi_bdy_files ) THEN
1456            CALL construct_filename2a ( bdyname , config_flags%bdy_inname , grid%id , 2 , timestr )
1457           ELSE
1458            CALL construct_filename2a ( bdyname , config_flags%bdy_inname , grid%id , 2 , " " )
1459           END IF
1460           WRITE(message,*)'Opening: ',TRIM(bdyname)
1461           CALL wrf_debug(100,TRIM(message))
1462           CALL open_r_dataset ( grid%lbc_fid, TRIM(bdyname) , grid , config_flags , "DATASET=BOUNDARY", ierr )
1463           IF ( ierr .NE. 0 ) THEN
1464             WRITE( message, * ) 'med_latbound_in: error opening ',TRIM(bdyname), ' for reading. IERR = ',ierr
1465             CALL WRF_ERROR_FATAL( message )
1466           ENDIF
1467        ELSE
1468          CALL wrf_debug( 100 , bdyname // ' is already opened' )
1469        ENDIF
1470        CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
1471        CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
1472
1473 ! #if (EM_CORE == 1)
1474        IF ( (config_flags%dfi_opt .NE. DFI_NODFI) .AND. (head_grid%dfi_stage .NE. DFI_FST) ) THEN
1475           CALL wrf_debug( 100 , 'med_latbound_in: closing boundary file ' )
1476           CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
1477        END IF
1478 ! #endif
1479
1480        CALL domain_clock_get( grid, current_time=currentTime )
1481 #if ( WRFPLUS == 1 )
1482        IF ( config_flags%dyn_opt .NE. dyn_em_ad ) THEN
1483           DO WHILE (currentTime .GE. grid%next_bdy_time )         ! next_bdy_time is set by input_boundary from bdy file
1484              CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
1485              CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
1486           ENDDO
1487        ELSE
1488           DO WHILE (currentTime .GT. grid%next_bdy_time )         ! next_bdy_time is set by input_boundary from bdy file
1489              CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
1490              CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
1491           ENDDO
1492        ENDIF
1493 #else
1494        DO WHILE (currentTime .GE. grid%next_bdy_time )         ! next_bdy_time is set by input_boundary from bdy file
1495          CALL wrf_debug( 100 , 'med_latbound_in: calling input_boundary ' )
1496          CALL input_boundary ( grid%lbc_fid, grid , config_flags , ierr )
1497        ENDDO
1498 #endif
1499        ! Close the bdy file so that next time around, we'll open it again.
1500        IF ( config_flags%multi_bdy_files ) THEN
1501          CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
1502        END IF
1503 #if ( WRFPLUS == 1 )
1504        IF ( config_flags%dyn_opt .NE. dyn_em_ad ) THEN
1505           CALL WRFU_AlarmSet( grid%alarms( BOUNDARY_ALARM ), RingTime=grid%next_bdy_time, rc=rc )
1506        ELSE
1507           CALL WRFU_AlarmSet( grid%alarms( BOUNDARY_ALARM ), RingTime=grid%this_bdy_time, rc=rc )
1508           CALL wrf_inquire_opened(grid%lbc_fid , TRIM(bdyname) , open_status , ierr )
1509           IF ( open_status .EQ. WRF_FILE_OPENED_FOR_READ ) THEN
1510              CALL wrf_debug( 100 , 'med_latbound_in: closing boundary file ' )
1511              CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
1512           ENDIF
1513        ENDIF
1514 #else
1515        CALL WRFU_AlarmSet( grid%alarms( BOUNDARY_ALARM ), RingTime=grid%next_bdy_time, rc=rc )
1516 #endif
1517
1518        IF ( ierr .NE. 0 .and. ierr .NE. WRF_WARN_NETCDF ) THEN
1519          WRITE( message, * ) 'med_latbound_in: error reading ',TRIM(bdyname), ' IERR = ',ierr
1520          CALL WRF_ERROR_FATAL( message )
1521        ENDIF
1522        IF ( currentTime .EQ. grid%this_bdy_time ) grid%dtbc = 0.
1523
1524        IF ( wrf_dm_on_monitor() ) THEN
1525          WRITE ( message , FMT = '("processing lateral boundary for domain ",I8)' ) grid%id
1526          CALL end_timing ( TRIM(message) )
1527        ENDIF
1528      ENDIF
1529    ENDIF
1530    RETURN
1531 END SUBROUTINE med_latbound_in
1532
1533 SUBROUTINE med_setup_step ( grid , config_flags )
1534   ! Driver layer
1535    USE module_domain    , ONLY : domain
1536    USE module_configure , ONLY : grid_config_rec_type
1537   ! Model layer
1538
1539    IMPLICIT NONE
1540 !<DESCRIPTION>
1541 !
1542 !The driver layer routine integrate() calls this mediation layer routine
1543 !prior to initiating a time step on the domain specified by the argument
1544 !grid.  This provides the model-layer contributor an opportunity to make
1545 !any pre-time-step initializations that pertain to a particular model
1546 !domain.  In WRF, this routine is used to call
1547 !set_scalar_indices_from_config for the specified domain.
1548 !
1549 !</DESCRIPTION>
1550
1551   ! Arguments
1552    TYPE(domain)                               :: grid
1553    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1554   ! Local
1555    INTEGER                                    :: idum1 , idum2
1556
1557    CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
1558
1559    RETURN
1560
1561 END SUBROUTINE med_setup_step
1562
1563 SUBROUTINE med_endup_step ( grid , config_flags )
1564   ! Driver layer
1565    USE module_domain    , ONLY : domain
1566    USE module_configure , ONLY : grid_config_rec_type, model_config_rec
1567   ! Model layer
1568
1569    IMPLICIT NONE
1570 !<DESCRIPTION>
1571 !
1572 !The driver layer routine integrate() calls this mediation layer routine
1573 !prior to initiating a time step on the domain specified by the argument
1574 !grid.  This provides the model-layer contributor an opportunity to make
1575 !any pre-time-step initializations that pertain to a particular model
1576 !domain.  In WRF, this routine is used to call
1577 !set_scalar_indices_from_config for the specified domain.
1578 !
1579 !</DESCRIPTION>
1580
1581   ! Arguments
1582    TYPE(domain)                               :: grid
1583    TYPE (grid_config_rec_type) , INTENT(OUT)   :: config_flags
1584   ! Local
1585    INTEGER                                    :: idum1 , idum2
1586
1587    IF ( grid%id .EQ. 1 ) THEN
1588      ! turn off the restart flag after the first mother-domain step is finished
1589      model_config_rec%restart = .FALSE.
1590      config_flags%restart = .FALSE.
1591      CALL nl_set_restart(1, .FALSE.)
1592
1593    ENDIF
1594
1595    RETURN
1596
1597 END SUBROUTINE med_endup_step
1598
1599 SUBROUTINE open_aux_u ( grid , config_flags, stream, alarm_id, &
1600                         auxinput_inname, oid, insub, ierr )
1601   ! Driver layer
1602    USE module_domain    , ONLY : domain , domain_clock_get
1603    USE module_io_domain
1604   ! Model layer
1605    USE module_configure , ONLY : grid_config_rec_type
1606 !   USE module_bc_time_utilities
1607    USE module_utility
1608
1609    IMPLICIT NONE
1610   ! Arguments
1611    TYPE(domain)                                :: grid
1612    TYPE (grid_config_rec_type) , INTENT(IN)    :: config_flags
1613    INTEGER ,                     INTENT(IN)    :: stream
1614    INTEGER ,                     INTENT(IN)    :: alarm_id
1615    CHARACTER*(*) ,               INTENT(IN)    :: auxinput_inname
1616    INTEGER ,                     INTENT(INOUT) :: oid
1617    EXTERNAL                                       insub
1618    INTEGER ,                     INTENT(OUT)   :: ierr
1619   ! Local
1620    INTEGER                                :: stream_l
1621    CHARACTER*256                          :: fname, n2
1622    CHARACTER (LEN=256)                    :: message
1623    CHARACTER*80                           :: timestr
1624    TYPE(WRFU_Time)                        :: ST,CT
1625    LOGICAL                                :: adjust
1626
1627    IF ( stream .LT. first_stream .OR. stream .GT. last_stream ) THEN
1628      WRITE(message,*)'open_aux_u: invalid input stream ',stream
1629      CALL wrf_error_fatal( message )
1630    ENDIF
1631
1632    ierr = 0
1633
1634    IF ( oid .eq. 0 ) THEN
1635      CALL domain_clock_get( grid, current_time=CT, start_time=ST, &
1636                             current_timestr=timestr )
1637      CALL nl_get_adjust_input_times( grid%id, adjust )
1638      IF ( adjust ) THEN
1639        CALL adjust_io_timestr( grid%io_intervals( alarm_id ), CT, ST, timestr )
1640      ENDIF
1641      CALL construct_filename2a ( fname , auxinput_inname, &
1642                                  grid%id , 2 , timestr )
1643      stream_l = stream-auxinput1_only+1
1644      IF ( stream_l .GE. 10 ) THEN
1645        WRITE(n2,'("DATASET=AUXINPUT",I2)')stream_l
1646      ELSE
1647        WRITE(n2,'("DATASET=AUXINPUT",I1)')stream_l
1648      ENDIF
1649      WRITE ( message , '("open_aux_u : opening ",A," for reading. DATASET ",A)') TRIM ( fname ),TRIM(n2)
1650      CALL wrf_debug( 1, message )
1651 !<DESCRIPTION>
1652 !
1653 !Open_u_dataset is called rather than open_r_dataset to allow interfaces
1654 !that can do blending or masking to update an existing field. (MCEL IO does this).
1655 !No effect for other interfaces; open_u_dataset is equivalent to open_r_dataset
1656 !in those cases.
1657 !
1658 !</DESCRIPTION>
1659      CALL open_u_dataset ( oid, TRIM(fname), grid ,  &
1660                            config_flags , insub , n2, ierr )
1661    ENDIF
1662    IF ( ierr .NE. 0 ) THEN
1663      WRITE ( message , '("open_aux_u : error opening ",A," for reading. ",I5)') &
1664        TRIM ( fname ), ierr
1665      CALL wrf_message( message )
1666    ENDIF
1667    RETURN
1668 END SUBROUTINE open_aux_u
1669
1670 SUBROUTINE open_hist_w ( grid , config_flags, stream, alarm_id, &
1671                          hist_outname, oid, outsub, fname, n2, ierr )
1672   ! Driver layer
1673    USE module_domain    , ONLY : domain , domain_clock_get
1674    USE module_io_domain
1675   ! Model layer
1676    USE module_configure , ONLY : grid_config_rec_type
1677 !   USE module_bc_time_utilities
1678    USE module_utility
1679    IMPLICIT NONE
1680   ! Arguments
1681    TYPE(domain)                                :: grid
1682    TYPE (grid_config_rec_type) , INTENT(IN)    :: config_flags
1683    INTEGER ,                     INTENT(IN)    :: stream
1684    INTEGER ,                     INTENT(IN)    :: alarm_id
1685    CHARACTER*(*) ,               INTENT(IN)    :: hist_outname
1686    INTEGER ,                     INTENT(INOUT) :: oid
1687    EXTERNAL                                       outsub
1688    CHARACTER*(*) ,               INTENT(OUT)   :: fname, n2
1689    INTEGER ,                     INTENT(OUT)   :: ierr
1690   ! Local
1691    INTEGER                                :: len_n2
1692    INTEGER                                :: stream_l
1693    CHARACTER (LEN=256)                    :: message
1694    CHARACTER*80                           :: timestr
1695    TYPE(WRFU_Time)                        :: ST,CT
1696    LOGICAL                                :: adjust
1697
1698    IF ( stream .LT. first_history .OR. stream .GT. last_history ) THEN
1699      WRITE(message,*)'open_hist_w: invalid history stream ',stream
1700      CALL wrf_error_fatal( message )
1701    ENDIF
1702
1703    ierr = 0
1704
1705    ! Note that computation of fname and n2 are outside of the oid IF statement
1706    ! since they are OUT args and may be used by callers even if oid/=0.
1707    CALL domain_clock_get( grid, current_time=CT, start_time=ST, &
1708                           current_timestr=timestr )
1709    CALL nl_get_adjust_output_times( grid%id, adjust )
1710    IF ( adjust ) THEN
1711      CALL adjust_io_timestr( grid%io_intervals( alarm_id ), CT, ST, timestr )
1712    ENDIF
1713 #if (DA_CORE != 1 )
1714 !----------------------------------------------------------------------
1715 ! RASM Climate Diagnostics - JR, AS, MS  - October 2016
1716 !----------------------------------------------------------------------
1717    IF( alarm_id .EQ. AUXHIST5_ALARM .AND. config_flags%mean_diag .EQ. 1 ) THEN
1718       WRITE(message, *) "RASM STATS: MEAN AUXHIST5 oid=", oid, " fname=", trim(fname), " alarmI_id=", alarm_id, " Time_outNow=", timestr
1719       CALL wrf_debug(200,  message )
1720       WRITE(message, *) "RASM STATS: MEAN AUXHIST5 Time_outbefore =...", trim(grid%OUTDATE_MEAN)
1721       CALL wrf_debug(200,  message )
1722       timestr = grid%OUTDATE_MEAN
1723    ELSE IF( alarm_id .EQ. AUXHIST6_ALARM .AND. config_flags%diurnal_diag .EQ. 1 ) THEN
1724       WRITE(message, *) "RASM STATS: DIURNAL AUXHIST6 oid=", oid, " fname=", trim(fname), " alarmI_id=", alarm_id, " Time_outNow=", timestr
1725       CALL wrf_debug(200,  message )
1726       WRITE(message, *) "RASM STATS: DIURNAL AUXHIST6 Time_outbefore =...", trim(grid%OUTDATE_DIURN)
1727       CALL wrf_debug(200,  message )
1728       timestr = grid%OUTDATE_DIURN
1729    ENDIF
1730 !----------------------------------------------------------------------
1731 ! end RASM Climate Diagnostics
1732 !----------------------------------------------------------------------
1733 #endif
1734    CALL construct_filename2a ( fname , hist_outname, &
1735                                grid%id , 2 , timestr )
1736    stream_l = stream-auxhist1_only+1
1737    IF ( stream .EQ. history_only ) THEN
1738      WRITE(n2,'("DATASET=HISTORY")')
1739    ELSE IF ( stream_l .GE. 10 ) THEN
1740      WRITE(n2,'("DATASET=AUXHIST",I2)')stream_l
1741    ELSE
1742      WRITE(n2,'("DATASET=AUXHIST",I1)')stream_l
1743    ENDIF
1744    IF ( oid .eq. 0 ) THEN
1745      WRITE ( message , '("open_hist_w : opening ",A," for writing. ")') TRIM ( fname )
1746      CALL wrf_debug( 1, message )
1747 !<DESCRIPTION>
1748 !
1749 !Open_u_dataset is called rather than open_r_dataset to allow interfaces
1750 !that can do blending or masking to update an existing field. (MCEL IO does this).
1751 !No effect for other interfaces; open_u_dataset is equivalent to open_r_dataset
1752 !in those cases.
1753 !
1754 !</DESCRIPTION>
1755      CALL open_w_dataset ( oid, TRIM(fname), grid ,  &
1756                            config_flags , outsub , n2, ierr )
1757    ENDIF
1758    IF ( ierr .NE. 0 ) THEN
1759      WRITE ( message , '("open_hist_w : error opening ",A," for writing. ",I5)') &
1760         TRIM ( fname ), ierr
1761      CALL wrf_message( message )
1762    ENDIF
1763
1764    RETURN
1765 END SUBROUTINE open_hist_w
1766
1767
1768 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1769
1770 #if ( WRF_CHEM == 1 )
1771 #if (DA_CORE != 1)
1772
1773 SUBROUTINE med_read_wrf_chem_input ( grid , config_flags )
1774   ! Driver layer
1775    USE module_domain    , ONLY : domain , domain_clock_get
1776    USE module_io_domain
1777    USE module_timing
1778    USE module_configure , ONLY : grid_config_rec_type
1779   ! Model layer
1780    USE module_bc_time_utilities
1781 #ifdef DM_PARALLEL
1782    USE module_dm
1783 #endif
1784    USE module_date_time
1785    USE module_utility
1786
1787    IMPLICIT NONE
1788
1789   ! Arguments
1790    TYPE(domain)                               :: grid
1791
1792    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1793
1794   ! Local data
1795    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
1796
1797    INTEGER                                :: ierr, efid
1798    REAL                                   :: time, tupdate
1799    real, allocatable :: dumc0(:,:,:)
1800    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
1801    CHARACTER (LEN=256)                    :: inpname
1802
1803 #include "wrf_io_flags.h"
1804 !   IF ( grid%id .EQ. 1 ) THEN
1805
1806       CALL domain_clock_get( grid, current_timestr=current_date_char )
1807
1808       CALL construct_filename1 ( inpname , config_flags%auxinput12_inname , grid%id , 2 )
1809       WRITE(message,*)'mediation_integrate: med_read_wrf_chem_input: Open file ',TRIM(inpname)
1810       CALL wrf_message( TRIM(message) )
1811
1812      if( grid%auxinput12_oid .NE. 0 ) then
1813        CALL close_dataset ( grid%auxinput12_oid , config_flags , "DATASET=AUXINPUT12" )
1814      endif
1815
1816       CALL open_r_dataset ( grid%auxinput12_oid, TRIM(inpname) , grid , config_flags, &
1817                               "DATASET=AUXINPUT12", ierr )
1818         IF ( ierr .NE. 0 ) THEN
1819            WRITE( message , * ) 'med_read_wrf_chem_input error opening ', TRIM( inpname )
1820            CALL wrf_error_fatal( TRIM( message ) )
1821         ENDIF
1822
1823          WRITE(message,*)'mediation_integrate: med_read_wrf_chem_input: Read chemistry from wrfout at time ',&
1824          TRIM(current_date_char)
1825          CALL wrf_message( TRIM(message) )
1826
1827          CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput12' )
1828          CALL input_auxinput12 ( grid%auxinput12_oid, grid , config_flags , ierr )
1829
1830          CALL close_dataset ( grid%auxinput12_oid , config_flags , "DATASET=AUXINPUT12" )
1831
1832 !  ENDIF
1833    CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_input: exit' )
1834
1835 END SUBROUTINE med_read_wrf_chem_input
1836 !------------------------------------------------------------------------
1837 ! Chemistry emissions input control. Three options are available and are
1838 ! set via the namelist variable io_style_emissions:
1839 !
1840 !   0 = Emissions are not read in from a file. They will contain their
1841 !       default values, which can be set in the Registry.
1842 !       (Intended for debugging of chem code)
1843 !
1844 !   1 = Emissions are read in from two 12 hour files that are cycled.
1845 !       With this choice, auxinput5_inname should be set to
1846 !       the value "wrfchemi_hhZ_d<domain>".
1847 !
1848 !   2 = Emissions are read in from files identified by date and that have
1849 !       a length defined by frames_per_auxinput5. Both
1850 !       auxinput5_inname should be set to
1851 !       "wrfchemi_d<domain>_<date>".
1852 !------------------------------------------------------------------------
1853 SUBROUTINE med_read_wrf_chem_emiss ( grid , config_flags )
1854   ! Driver layer
1855    USE module_domain    , ONLY : domain , domain_clock_get
1856    USE module_io_domain
1857    USE module_timing
1858    USE module_configure , ONLY : grid_config_rec_type
1859   ! Model layer
1860    USE module_bc_time_utilities
1861 #ifdef DM_PARALLEL
1862    USE module_dm
1863 #endif
1864    USE module_date_time
1865    USE module_utility
1866
1867    IMPLICIT NONE
1868
1869   ! Arguments
1870    TYPE(domain)                               :: grid
1871
1872 !  TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
1873    TYPE (grid_config_rec_type)            :: config_flags
1874    Type (WRFU_Time )                      :: stopTime, currentTime
1875    Type (WRFU_TimeInterval )              :: stepTime
1876
1877   ! Local data
1878    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
1879
1880    INTEGER                                :: ierr, efid
1881    INTEGER                                :: ihr, ihrdiff, i
1882    REAL                                   :: time, tupdate
1883    real, allocatable :: dumc0(:,:,:)
1884    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
1885    CHARACTER (LEN=256)                    :: inpname
1886
1887 #include "wrf_io_flags.h"
1888
1889      CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
1890
1891 ! This "if" should be commented out when using emission files for nested
1892 ! domains. Also comment out the "ENDIF" line noted below.
1893 !    IF ( grid%id .EQ. 1 ) THEN
1894
1895       CALL domain_clock_get( grid, current_time=currentTime,          &
1896                                    current_timestr=current_date_char, &
1897                                    stop_time=stopTime,                &
1898                                    time_step=stepTime )
1899
1900       time = float(grid%itimestep) * grid%dt
1901
1902 !---
1903 ! io_style_emissions option 0: no emissions read in...
1904 !---
1905       if( config_flags%io_style_emissions == 0 ) then
1906          ! Do nothing.
1907 !---
1908 ! io_style_emissions option 1: cycle through two 12 hour input files...
1909 !---
1910       else if( config_flags%io_style_emissions == 1 ) then
1911
1912          tupdate = mod( time, (12. * 3600.) )
1913          read(current_date_char(12:13),'(I2)') ihr
1914          ihr = MOD(ihr,24)
1915          ihrdiff = 0
1916
1917          IF( tupdate .LT. grid%dt ) THEN
1918             tupdate = 0.
1919          ENDIF
1920          IF( ihr .EQ. 00 .OR. ihr .EQ. 12 ) THEN
1921             tupdate = 0.
1922          ENDIF
1923
1924          IF( currentTime + stepTime .GE. stopTime .AND. &
1925               grid%auxinput5_oid .NE. 0 ) THEN
1926             CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
1927             tupdate = 1.
1928          ENDIF
1929
1930 !        write(message,FMT='(A,F10.1,A)') ' EMISSIONS UPDATE TIME ',time,TRIM(current_date_char(12:13))
1931 !        CALL wrf_message( TRIM(message) )
1932
1933          IF ( tupdate .EQ. 0. .AND.  ihr .LT. 12 ) THEN
1934             ihrdiff = ihr
1935             CALL construct_filename1 ( inpname , 'wrfchemi_00z' , grid%id , 2 )
1936             WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
1937             CALL wrf_message( TRIM(message) )
1938
1939             if( grid%auxinput5_oid .NE. 0 ) then
1940                CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
1941             endif
1942
1943             CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
1944                  "DATASET=AUXINPUT5", ierr )
1945             IF ( ierr .NE. 0 ) THEN
1946                WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
1947                CALL wrf_error_fatal( TRIM( message ) )
1948             ENDIF
1949
1950           ELSE IF ( tupdate .EQ. 0. .AND. ihr .GE. 12 ) THEN
1951              ihrdiff = ihr - 12
1952
1953             CALL construct_filename1 ( inpname , 'wrfchemi_12z' , grid%id , 2 )
1954             WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
1955             CALL wrf_message( TRIM(message) )
1956
1957             if( grid%auxinput5_oid .NE. 0 ) then
1958                CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
1959             endif
1960
1961             CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
1962                  "DATASET=AUXINPUT5", ierr )
1963             IF ( ierr .NE. 0 ) THEN
1964                WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
1965                CALL wrf_error_fatal( TRIM( message ) )
1966             ENDIF
1967           ENDIF
1968
1969          WRITE( message, '(A,2F10.1)' ) ' HOURLY EMISSIONS UPDATE TIME ',time,mod(time,3600.)
1970          CALL wrf_message( TRIM(message) )
1971 !
1972 ! hourly updates to emissions
1973          IF ( ( mod( time, 3600. ) .LT. grid%dt   ) .AND. &
1974               ( currentTime + stepTime .LT. stopTime ) ) THEN
1975 !           IF ( wrf_dm_on_monitor() ) CALL start_timing
1976
1977             WRITE(message,'(A,A)')'mediation_integrate: med_read_wrf_chem_emissions: Read emissions for time ',TRIM(current_date_char)
1978             CALL wrf_message( TRIM(message) )
1979
1980             IF ( tupdate .EQ. 0. .AND. ihrdiff .GT. 0) THEN
1981                IF( ihrdiff .GT. 12) THEN
1982                  WRITE(message,'(A)')'mediation_integrate: med_read_wrf_chem_emissions: Error in emissions time, skipping all times in file '
1983                  CALL wrf_message( TRIM(message) )
1984                ENDIF
1985                DO i=1,ihrdiff
1986                  WRITE(message,'(A,I4)')'mediation_integrate: med_read_wrf_chem_emissions: Skip emissions ',i
1987                  CALL wrf_message( TRIM(message) )
1988                  CALL input_auxinput5 ( grid%auxinput5_oid, grid , config_flags , ierr )
1989                ENDDO
1990             ENDIF
1991
1992             CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput5' )
1993             CALL input_auxinput5 ( grid%auxinput5_oid, grid , config_flags , ierr )
1994          ELSE
1995             CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: Do not read emissions' )
1996          ENDIF
1997
1998 !---
1999 ! io_style_emissions option 2: use dated emission files whose length is
2000 !                             set via frames_per_auxinput5...
2001 !---
2002       else if( config_flags%io_style_emissions == 2 ) then
2003          WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Read emissions for time ',TRIM(current_date_char)
2004          CALL wrf_message( TRIM(message) )
2005 !
2006 ! Code to read hourly emission files...
2007 !
2008          if( grid%auxinput5_oid == 0 ) then
2009             CALL construct_filename2a(inpname , grid%emi_inname, grid%id , 2, current_date_char)
2010             WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
2011             CALL wrf_message( TRIM(message) )
2012             CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
2013                  "DATASET=AUXINPUT5", ierr )
2014             IF ( ierr .NE. 0 ) THEN
2015                WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
2016                CALL wrf_error_fatal( TRIM( message ) )
2017             ENDIF
2018          end if
2019 !
2020 ! Read the emissions data.
2021 !
2022          CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput5' )
2023          CALL input_auxinput5 ( grid%auxinput5_oid, grid , config_flags , ierr )
2024 !
2025 ! If reached the indicated number of frames in the emissions file, close it.
2026 !
2027          grid%emissframes = grid%emissframes + 1
2028          IF ( grid%emissframes >= config_flags%frames_per_auxinput5 ) THEN
2029             CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2030             grid%emissframes = 0
2031             grid%auxinput5_oid = 0
2032          ENDIF
2033
2034 !---
2035 ! unknown io_style_emissions option...
2036 !---
2037       else
2038          call wrf_error_fatal("Unknown emission style selected via io_style_emissions.")
2039       end if
2040
2041 ! The following line should be commented out when using emission files
2042 ! for nested domains. Also comment out the "if" noted above.
2043 !   ENDIF
2044
2045    CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: exit' )
2046
2047 END SUBROUTINE med_read_wrf_chem_emiss
2048
2049 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2050 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2051
2052 SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags )
2053   ! Driver layer
2054    USE module_domain    , ONLY : domain , domain_clock_get
2055    USE module_io_domain
2056    USE module_timing
2057    USE module_configure , ONLY : grid_config_rec_type
2058   ! Model layer
2059    USE module_bc_time_utilities
2060 #ifdef DM_PARALLEL
2061    USE module_dm
2062 #endif
2063    USE module_date_time
2064    USE module_utility
2065
2066    IMPLICIT NONE
2067
2068   ! Arguments
2069    TYPE(domain)                               :: grid
2070
2071    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
2072
2073   ! Local data
2074    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
2075
2076    INTEGER                                :: ierr, efid
2077    REAL                                   :: time, tupdate
2078    real, allocatable :: dumc0(:,:,:)
2079    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
2080    CHARACTER (LEN=256)                    :: inpname
2081
2082 #include "wrf_io_flags.h"
2083 !   IF ( grid%id .EQ. 1 ) THEN
2084
2085       CALL domain_clock_get( grid, current_timestr=current_date_char )
2086
2087       CALL construct_filename1 ( inpname , 'wrfbiochemi' , grid%id , 2 )
2088       WRITE(message,*)'mediation_integrate: med_read_wrf_chem_bioemissions: Open file ',TRIM(inpname)
2089       CALL wrf_message( TRIM(message) )
2090
2091      if( grid%auxinput6_oid .NE. 0 ) then
2092        CALL close_dataset ( grid%auxinput6_oid , config_flags , "DATASET=AUXINPUT6" )
2093      endif
2094
2095       CALL open_r_dataset ( grid%auxinput6_oid, TRIM(inpname) , grid , config_flags, &
2096                               "DATASET=AUXINPUT6", ierr )
2097         IF ( ierr .NE. 0 ) THEN
2098            WRITE( message , * ) 'med_read_wrf_chem_bioemissions: error opening ', TRIM( inpname )
2099            CALL wrf_error_fatal( TRIM( message ) )
2100         ENDIF
2101
2102          WRITE(message,*)'mediation_integrate: med_read_wrf_chem_bioemissions: Read biogenic emissions at time ',&
2103          TRIM(current_date_char)
2104          CALL wrf_message( TRIM(message) )
2105
2106          CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput6' )
2107          CALL input_auxinput6 ( grid%auxinput6_oid, grid , config_flags , ierr )
2108
2109          CALL close_dataset ( grid%auxinput6_oid , config_flags , "DATASET=AUXINPUT6" )
2110
2111 !  ENDIF
2112    CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_bioemissions: exit' )
2113
2114 END SUBROUTINE med_read_wrf_chem_bioemiss
2115 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2116 SUBROUTINE med_read_wrf_chem_emissopt4 ( grid , config_flags )
2117   ! Driver layer
2118    USE module_domain    , ONLY : domain , domain_clock_get
2119    USE module_io_domain
2120    USE module_timing
2121    USE module_configure , ONLY : grid_config_rec_type
2122   ! Model layer
2123    USE module_bc_time_utilities
2124 #ifdef DM_PARALLEL
2125    USE module_dm
2126 #endif
2127    USE module_date_time
2128    USE module_utility
2129
2130    IMPLICIT NONE
2131
2132   ! Arguments
2133    TYPE(domain)                               :: grid
2134
2135    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
2136
2137   ! Local data
2138    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
2139
2140    INTEGER                                :: ierr, efid
2141    REAL                                   :: time, tupdate
2142    real, allocatable :: dumc0(:,:,:)
2143    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
2144    CHARACTER (LEN=256)                    :: inpname
2145
2146 #include "wrf_io_flags.h"
2147 !   IF ( grid%id .EQ. 1 ) THEN
2148
2149       CALL domain_clock_get( grid, current_timestr=current_date_char )
2150
2151       CALL construct_filename1 ( inpname , 'wrfchemi' , grid%id , 2 )
2152       WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Open file ',TRIM(inpname)
2153       CALL wrf_message( TRIM(message) )
2154
2155      if( grid%auxinput5_oid .NE. 0 ) then
2156        CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2157      endif
2158
2159       CALL open_r_dataset ( grid%auxinput5_oid, TRIM(inpname) , grid , config_flags, &
2160                               "DATASET=AUXINPUT5", ierr )
2161         IF ( ierr .NE. 0 ) THEN
2162            WRITE( message , * ) 'med_read_wrf_chem_emissions: error opening ', TRIM( inpname )
2163            CALL wrf_error_fatal( TRIM( message ) )
2164         ENDIF
2165
2166          WRITE(message,*)'mediation_integrate: med_read_wrf_chem_emissions: Read biogenic emissions at time ',&
2167          TRIM(current_date_char)
2168          CALL wrf_message( TRIM(message) )
2169
2170          CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput5' )
2171          CALL input_auxinput5 ( grid%auxinput5_oid, grid , config_flags , ierr )
2172
2173          CALL close_dataset ( grid%auxinput5_oid , config_flags , "DATASET=AUXINPUT5" )
2174
2175 !  ENDIF
2176    CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_emissions: exit' )
2177
2178 END SUBROUTINE med_read_wrf_chem_emissopt4
2179
2180 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2181 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2182
2183 SUBROUTINE med_read_wrf_chem_dms_emiss ( grid , config_flags )
2184   ! Driver layer
2185    USE module_domain    , ONLY : domain , domain_clock_get
2186    USE module_io_domain
2187    USE module_timing
2188    USE module_configure , ONLY : grid_config_rec_type
2189   ! Model layer
2190    USE module_bc_time_utilities
2191 #ifdef DM_PARALLEL
2192    USE module_dm
2193 #endif
2194    USE module_date_time
2195    USE module_utility
2196
2197    IMPLICIT NONE
2198
2199   ! Arguments
2200    TYPE(domain)                               :: grid
2201
2202    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
2203
2204   ! Local data
2205    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
2206
2207    INTEGER                                :: ierr, efid
2208    REAL                                   :: time, tupdate
2209    real, allocatable :: dumc0(:,:,:)
2210    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
2211    CHARACTER (LEN=256)                    :: inpname
2212
2213 #include "wrf_io_flags.h"
2214 !   IF ( grid%id .EQ. 1 ) THEN
2215
2216       CALL domain_clock_get( grid, current_timestr=current_date_char )
2217
2218       CALL construct_filename1 ( inpname , 'wrfchemi_dms' , grid%id , 2 )
2219       WRITE(message,*)'mediation_integrate: med_read_wrf_chem_dms_emiss: Open file ',TRIM(inpname)
2220       CALL wrf_message( TRIM(message) )
2221
2222      if( grid%auxinput7_oid .NE. 0 ) then
2223        CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2224      endif
2225
2226       CALL open_r_dataset ( grid%auxinput7_oid, TRIM(inpname) , grid , config_flags, &
2227                               "DATASET=AUXINPUT7", ierr )
2228         IF ( ierr .NE. 0 ) THEN
2229            WRITE( message , * ) 'med_read_wrf_chem_dms_emiss: error opening ', TRIM( inpname )
2230            CALL wrf_error_fatal( TRIM( message ) )
2231         ENDIF
2232
2233          WRITE(message,*)'mediation_integrate: med_read_wrf_chem_dms_emiss: Read dms reference fields',&
2234          TRIM(current_date_char)
2235          CALL wrf_message( TRIM(message) )
2236
2237          CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput7' )
2238          CALL input_auxinput7 ( grid%auxinput7_oid, grid , config_flags , ierr )
2239
2240          CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2241
2242 !  ENDIF
2243    CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_dms_emiss: exit' )
2244
2245 END SUBROUTINE  med_read_wrf_chem_dms_emiss
2246
2247 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2248 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2249
2250 SUBROUTINE med_read_wrf_chem_gocart_bg ( grid , config_flags )
2251   ! Driver layer
2252    USE module_domain    , ONLY : domain , domain_clock_get
2253    USE module_io_domain
2254    USE module_timing
2255    USE module_configure , ONLY : grid_config_rec_type
2256   ! Model layer
2257    USE module_bc_time_utilities
2258 #ifdef DM_PARALLEL
2259    USE module_dm
2260 #endif
2261    USE module_date_time
2262    USE module_utility
2263
2264    IMPLICIT NONE
2265
2266   ! Arguments
2267    TYPE(domain)                               :: grid
2268
2269    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
2270
2271   ! Local data
2272    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
2273
2274    INTEGER                                :: ierr, efid
2275    REAL                                   :: time, tupdate
2276    real, allocatable :: dumc0(:,:,:)
2277    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
2278    CHARACTER (LEN=256)                    :: inpname
2279
2280 #include "wrf_io_flags.h"
2281 !   IF ( grid%id .EQ. 1 ) THEN
2282
2283       CALL domain_clock_get( grid, current_timestr=current_date_char )
2284
2285       CALL construct_filename1 ( inpname , 'wrfchemi_gocart_bg' , grid%id , 2 )
2286       WRITE(message,*)'mediation_integrate: med_read_wrf_chem_gocart_bg: Open file ',TRIM(inpname)
2287       CALL wrf_message( TRIM(message) )
2288
2289      if( grid%auxinput8_oid .NE. 0 ) then
2290        CALL close_dataset ( grid%auxinput8_oid , config_flags , "DATASET=AUXINPUT8" )
2291      endif
2292
2293       CALL open_r_dataset ( grid%auxinput8_oid, TRIM(inpname) , grid , config_flags, &
2294                               "DATASET=AUXINPUT8", ierr )
2295         IF ( ierr .NE. 0 ) THEN
2296            WRITE( message , * ) 'med_read_wrf_chem_gocart_bg: error opening ', TRIM( inpname )
2297            CALL wrf_error_fatal( TRIM( message ) )
2298         ENDIF
2299
2300          WRITE(message,*)'mediation_integrate: med_read_wrf_chem_gocart_bg: Read gocart_bg at time ',&
2301          TRIM(current_date_char)
2302          CALL wrf_message( TRIM(message) )
2303
2304          CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput8' )
2305          CALL input_auxinput8 ( grid%auxinput8_oid, grid , config_flags , ierr )
2306
2307          CALL close_dataset ( grid%auxinput8_oid , config_flags , "DATASET=AUXINPUT8" )
2308
2309 !
2310 !         CALL wrf_global_to_patch_real ( backg_no3_io , grid%backg_no3 , grid%domdesc, ' ' , 'xyz' ,         &
2311 !                                         ids, ide-1 , jds , jde-1 , kds , kde-1, &
2312 !                                         ims, ime   , jms , jme   , kms , kme  , &
2313 !                                         ips, ipe   , jps , jpe   , kps , kpe    )
2314 !
2315 !  ENDIF
2316    CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_chem_gocart_bg: exit' )
2317
2318 END SUBROUTINE  med_read_wrf_chem_gocart_bg
2319 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2320
2321 SUBROUTINE med_read_wrf_volc_emiss ( grid , config_flags )
2322   ! Driver layer
2323    USE module_domain    , ONLY : domain , domain_clock_get
2324    USE module_io_domain
2325    USE module_timing
2326    USE module_configure , ONLY : grid_config_rec_type
2327   ! Model layer
2328    USE module_bc_time_utilities
2329 #ifdef DM_PARALLEL
2330    USE module_dm
2331 #endif
2332    USE module_date_time
2333    USE module_utility
2334
2335    IMPLICIT NONE
2336
2337   ! Arguments
2338    TYPE(domain)                               :: grid
2339
2340    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
2341
2342   ! Local data
2343    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
2344
2345    INTEGER                                :: ierr, efid
2346    REAL                                   :: time, tupdate
2347    real, allocatable :: dumc0(:,:,:)
2348    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
2349    CHARACTER (LEN=256)                    :: inpname
2350
2351 #include "wrf_io_flags.h"
2352       CALL domain_clock_get( grid, current_timestr=current_date_char )
2353
2354       CALL construct_filename1 ( inpname , 'wrfchemv' , grid%id , 2 )
2355       WRITE(message,*)'mediation_integrate: med_read_wrf_volc_emiss: Open file ',TRIM(inpname)
2356       CALL wrf_message( TRIM(message) )
2357
2358      if( grid%auxinput13_oid .NE. 0 ) then
2359        CALL close_dataset ( grid%auxinput13_oid , config_flags , "DATASET=AUXINPUT13" )
2360      endif
2361
2362       CALL open_r_dataset ( grid%auxinput13_oid, TRIM(inpname) , grid , config_flags, &
2363                               "DATASET=AUXINPUT13", ierr )
2364         IF ( ierr .NE. 0 ) THEN
2365            WRITE( message , * ) 'med_read_wrf_volc_emiss: error opening ', TRIM( inpname )
2366            CALL wrf_error_fatal( TRIM( message ) )
2367         ENDIF
2368
2369          WRITE(message,*)'mediation_integrate: med_read_wrf_volc_emiss: Read volcanic ash emissions',&
2370          TRIM(current_date_char)
2371          CALL wrf_message( TRIM(message) )
2372
2373          CALL wrf_debug (100 , 'mediation_integrate: calling input_auxinput13' )
2374          CALL input_auxinput13 ( grid%auxinput13_oid, grid , config_flags , ierr )
2375
2376          CALL close_dataset ( grid%auxinput13_oid , config_flags , "DATASET=AUXINPUT13" )
2377
2378    CALL wrf_debug (100 , 'mediation_integrate: med_read_wrf_volc_emiss: exit' )
2379
2380 END SUBROUTINE  med_read_wrf_volc_emiss
2381
2382 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2383 SUBROUTINE med_read_wrf_chem_emissopt3 ( grid , config_flags )
2384   ! Driver layer
2385    USE module_domain    , ONLY : domain , domain_clock_get
2386    USE module_io_domain
2387    USE module_timing
2388    USE module_configure , ONLY : grid_config_rec_type
2389   ! Model layer
2390    USE module_bc_time_utilities
2391 #ifdef DM_PARALLEL
2392    USE module_dm
2393 #endif
2394    USE module_date_time
2395    USE module_utility
2396
2397    IMPLICIT NONE
2398
2399   ! Arguments
2400    TYPE(domain)                               :: grid
2401
2402    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
2403
2404   ! Local data
2405    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
2406
2407    INTEGER                                :: ierr, efid
2408    REAL                                   :: time, tupdate
2409    real, allocatable :: dumc0(:,:,:)
2410    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
2411    CHARACTER (LEN=256)                    :: inpname
2412
2413 #include "wrf_io_flags.h"
2414 !   IF ( grid%id .EQ. 1 ) THEN
2415
2416       CALL domain_clock_get( grid, current_timestr=current_date_char )
2417
2418       CALL construct_filename1 ( inpname , 'wrffirechemi' , grid%id , 2 )
2419       WRITE(message,*)'mediation_integrate: med_read_wrf_chem_fireemissions: Open file ',TRIM(inpname)
2420       CALL wrf_message( TRIM(message) )
2421
2422      if( grid%auxinput7_oid .NE. 0 ) then
2423        CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2424      endif
2425
2426       CALL open_r_dataset ( grid%auxinput7_oid, TRIM(inpname) , grid , config_flags, &
2427                               "DATASET=AUXINPUT7", ierr )
2428         IF ( ierr .NE. 0 ) THEN
2429            WRITE( message , * ) 'med_read_wrf_chem_fireemissions: error opening ', TRIM( inpname )
2430            CALL wrf_error_fatal( TRIM( message ) )
2431         ENDIF
2432
2433          WRITE(message,*)'mediation_integrate: med_read_wrf_chem_fireemissions: Read fire emissions at time ',&
2434          TRIM(current_date_char)
2435          CALL wrf_message( TRIM(message) )
2436
2437          CALL wrf_debug (00 , 'mediation_integrate: calling input_auxinput7' )
2438          CALL input_auxinput7 ( grid%auxinput7_oid, grid , config_flags , ierr )
2439
2440          CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
2441
2442 !  ENDIF
2443    CALL wrf_debug (00 , 'mediation_integrate: med_read_wrf_chem_fireemissions: exit' )
2444
2445 END SUBROUTINE med_read_wrf_chem_emissopt3
2446 #endif
2447 #endif
2448
2449 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2450
2451 SUBROUTINE med_read_qna_emissions ( grid , config_flags )
2452   ! Driver layer
2453    USE module_domain    , ONLY : domain , domain_clock_get
2454    USE module_io_domain
2455    USE module_timing
2456    USE module_configure , ONLY : grid_config_rec_type
2457   ! Model layer
2458    USE module_bc_time_utilities
2459 #ifdef DM_PARALLEL
2460    USE module_dm
2461 #endif
2462    USE module_date_time
2463    USE module_utility
2464
2465    IMPLICIT NONE
2466
2467   ! Arguments
2468    TYPE(domain)                               :: grid
2469
2470    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
2471
2472   ! Local data
2473    LOGICAL, EXTERNAL                      :: wrf_dm_on_monitor
2474
2475    INTEGER                                :: ierr, efid
2476    REAL                                   :: time, tupdate
2477    real, allocatable :: dumc0(:,:,:)
2478    CHARACTER (LEN=256)                    :: message, current_date_char, date_string
2479    CHARACTER (LEN=256)                    :: inpname
2480
2481 #include "wrf_io_flags.h"
2482
2483       CALL domain_clock_get( grid, current_timestr=current_date_char )
2484
2485       CALL construct_filename1 ( inpname , 'wrfqnainp' , grid%id , 2 )
2486       WRITE(message,*)'mediation_integrate: med_read_qna_emissions: Open file ',TRIM(inpname)
2487       CALL wrf_message( TRIM(message) )
2488
2489      if( grid%auxinput17_oid .NE. 0 ) then
2490        CALL close_dataset ( grid%auxinput17_oid , config_flags , "DATASET=AUXINPUT17" )
2491      endif
2492
2493       CALL open_r_dataset ( grid%auxinput17_oid, TRIM(inpname) , grid , config_flags, &
2494                               "DATASET=AUXINPUT17", ierr )
2495         IF ( ierr .NE. 0 ) THEN
2496            WRITE( message , * ) 'med_read_qna_emissions: error opening ', TRIM( inpname )
2497            CALL wrf_error_fatal( TRIM( message ) )
2498         ENDIF
2499
2500          WRITE(message,*)'mediation_integrate: med_read_qna_emissions: Read surface aerosol emissions at time ',&
2501          TRIM(current_date_char)
2502          CALL wrf_message( TRIM(message) )
2503
2504          CALL wrf_debug (00 , 'mediation_integrate: calling input_auxinput17' )
2505          CALL input_auxinput17 ( grid%auxinput17_oid, grid , config_flags , ierr )
2506
2507          CALL close_dataset ( grid%auxinput17_oid , config_flags , "DATASET=AUXINPUT17" )
2508
2509    CALL wrf_debug (00 , 'mediation_integrate: med_read_qna_emissions: exit' )
2510
2511 END SUBROUTINE med_read_qna_emissions