PageRenderTime 67ms CodeModel.GetById 22ms RepoModel.GetById 0ms app.codeStats 1ms

/wrfv2_fire/share/mediation_integrate.F

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