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