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