Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mediation_integrate.F @ 2853

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

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

Download in other formats:

Original Format