Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mediation_integrate.F.v3.6.1 @ 1577

Last change on this file since 1577 was 594, checked in by lfita, 9 years ago
Adding version 3.6.1
File size: 107.7 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format