Context Navigation

mediation_integrate.F

Last change on this file was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 99.7 KB

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

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

Download in other formats:

Original Format