Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mediation_integrate.F @ 3709

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

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

Download in other formats:

Original Format