Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mediation_integrate.F @ 1939

Last change on this file since 1939 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 96.8 KB

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

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

Download in other formats:

Original Format