Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

real_em.F @ 1531

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

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 53.7 KB

Line
1	! Create an initial data set for the WRF model based on real data. This
2	! program is specifically set up for the Eulerian, mass-based coordinate.
3	PROGRAM real_data
4
5	USE module_machine
6	USE module_domain, ONLY : domain, alloc_and_configure_domain, &
7	domain_clock_set, head_grid, program_name, domain_clockprint
8	USE module_initialize_real, ONLY : wrfu_initialize, find_my_parent, find_my_parent2
9	USE module_initialize_real
10	USE module_io_domain
11	USE module_driver_constants
12	USE module_configure, ONLY : grid_config_rec_type, model_config_rec, &
13	initial_config, get_config_as_buffer, set_config_as_buffer
14	USE module_timing
15	USE module_state_description, ONLY : realonly
16	USE module_symbols_util, ONLY: wrfu_cal_gregorian
17	USE module_check_a_mundo
18	#ifdef WRF_CHEM
19	USE module_input_chem_data
20	USE module_input_chem_bioemiss
21	! USE module_input_chem_emissopt3
22	#endif
23	USE module_utility, ONLY : WRFU_finalize
24
25	IMPLICIT NONE
26
27	#ifdef WRF_CHEM
28	! interface
29	INTERFACE
30	! mediation-supplied
31	SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
32	USE module_domain
33	TYPE (domain) grid
34	TYPE (grid_config_rec_type) config_flags
35	END SUBROUTINE med_read_wrf_chem_bioemiss
36	END INTERFACE
37	#endif
38
39	REAL :: time , bdyfrq
40
41	INTEGER :: loop , levels_to_process , debug_level
42
43
44	TYPE(domain) , POINTER :: null_domain
45	TYPE(domain) , POINTER :: grid , another_grid
46	TYPE(domain) , POINTER :: grid_ptr , grid_ptr2
47	TYPE (grid_config_rec_type) :: config_flags
48	INTEGER :: number_at_same_level
49
50	INTEGER :: max_dom, domain_id , grid_id , parent_id , parent_id1 , id
51	INTEGER :: e_we , e_sn , i_parent_start , j_parent_start
52	INTEGER :: idum1, idum2
53	#ifdef DM_PARALLEL
54	INTEGER :: nbytes
55	INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
56	INTEGER :: configbuf( configbuflen )
57	LOGICAL , EXTERNAL :: wrf_dm_on_monitor
58	#endif
59	LOGICAL found_the_id
60
61	INTEGER :: ids , ide , jds , jde , kds , kde
62	INTEGER :: ims , ime , jms , jme , kms , kme
63	INTEGER :: ips , ipe , jps , jpe , kps , kpe
64	INTEGER :: ijds , ijde , spec_bdy_width
65	INTEGER :: i , j , k , idts, rc
66	INTEGER :: sibling_count , parent_id_hold , dom_loop
67
68	CHARACTER (LEN=80) :: message
69
70	INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
71	INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
72	INTEGER :: interval_seconds , real_data_init_type
73	INTEGER :: time_loop_max , time_loop
74	real::t1,t2
75	INTERFACE
76	SUBROUTINE Setup_Timekeeping( grid )
77	USE module_domain, ONLY : domain
78	TYPE(domain), POINTER :: grid
79	END SUBROUTINE Setup_Timekeeping
80	END INTERFACE
81
82	LOGICAL :: ok_so_far
83
84	#include "version_decl"
85
86	! Define the name of this program (program_name defined in module_domain)
87
88	! NOTE: share/input_wrf.F tests first 7 chars of this name to decide
89	! whether to read P_TOP as metadata from the SI (yes, if .eq. REAL_EM)
90
91	program_name = "REAL_EM " // TRIM(release_version) // " PREPROCESSOR"
92
93	#ifdef DM_PARALLEL
94	CALL disable_quilting
95	#endif
96
97	! Initialize the modules used by the WRF system. Many of the CALLs made from the
98	! init_modules routine are NO-OPs. Typical initializations are: the size of a
99	! REAL, setting the file handles to a pre-use value, defining moisture and
100	! chemistry indices, etc.
101
102	CALL wrf_debug ( 100 , 'real_em: calling init_modules ' )
103	CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
104	#ifdef NO_LEAP_CALENDAR
105	CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_NOLEAP, rc=rc )
106	#else
107	CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
108	#endif
109	CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
110
111	! The configuration switches mostly come from the NAMELIST input.
112
113	#ifdef DM_PARALLEL
114	IF ( wrf_dm_on_monitor() ) THEN
115	CALL initial_config
116	END IF
117	CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
118	CALL wrf_dm_bcast_bytes( configbuf, nbytes )
119	CALL set_config_as_buffer( configbuf, configbuflen )
120	CALL wrf_dm_initialize
121	#else
122	CALL initial_config
123	#endif
124	CALL check_nml_consistency
125	CALL set_physics_rconfigs
126
127	CALL nl_get_debug_level ( 1, debug_level )
128	CALL set_wrf_debug_level ( debug_level )
129
130	CALL wrf_message ( program_name )
131
132	! There are variables in the Registry that are only required for the real
133	! program, fields that come from the WPS package. We define the run-time
134	! flag that says to allocate space for these input-from-WPS-only arrays.
135
136	CALL nl_set_use_wps_input ( 1 , REALONLY )
137
138	! Allocate the space for the mother of all domains.
139
140	NULLIFY( null_domain )
141	CALL wrf_debug ( 100 , 'real_em: calling alloc_and_configure_domain ' )
142	CALL alloc_and_configure_domain ( domain_id = 1 , &
143	grid = head_grid , &
144	parent = null_domain , &
145	kid = -1 )
146
147	grid => head_grid
148	CALL nl_get_max_dom ( 1 , max_dom )
149
150	IF ( model_config_rec%interval_seconds .LE. 0 ) THEN
151	CALL wrf_error_fatal( 'namelist value for interval_seconds must be > 0')
152	END IF
153
154	all_domains : DO domain_id = 1 , max_dom
155
156	IF ( ( model_config_rec%input_from_file(domain_id) ) .OR. &
157	( domain_id .EQ. 1 ) ) THEN
158
159	IF ( domain_id .GT. 1 ) THEN
160
161	CALL nl_get_grid_id ( domain_id, grid_id )
162	CALL nl_get_parent_id ( domain_id, parent_id )
163	CALL nl_get_e_we ( domain_id, e_we )
164	CALL nl_get_e_sn ( domain_id, e_sn )
165	CALL nl_get_i_parent_start ( domain_id, i_parent_start )
166	CALL nl_get_j_parent_start ( domain_id, j_parent_start )
167	WRITE (message,FMT='(A,2I3,2I4,2I3)') &
168	'new allocated domain: id, par id, dims i/j, start i/j =', &
169	grid_id, parent_id, e_we, e_sn, i_parent_start, j_parent_start
170
171	CALL wrf_debug ( 100 , message )
172	CALL nl_get_grid_id ( parent_id, grid_id )
173	CALL nl_get_parent_id ( parent_id, parent_id1 )
174	CALL nl_get_e_we ( parent_id, e_we )
175	CALL nl_get_e_sn ( parent_id, e_sn )
176	CALL nl_get_i_parent_start ( parent_id, i_parent_start )
177	CALL nl_get_j_parent_start ( parent_id, j_parent_start )
178	WRITE (message,FMT='(A,2I3,2I4,2I3)') &
179	'parent domain: id, par id, dims i/j, start i/j =', &
180	grid_id, parent_id1, e_we, e_sn, i_parent_start, j_parent_start
181	CALL wrf_debug ( 100 , message )
182
183	CALL nl_get_grid_id ( domain_id, grid_id )
184	CALL nl_get_parent_id ( domain_id, parent_id )
185	CALL nl_get_e_we ( domain_id, e_we )
186	CALL nl_get_e_sn ( domain_id, e_sn )
187	CALL nl_get_i_parent_start ( domain_id, i_parent_start )
188	CALL nl_get_j_parent_start ( domain_id, j_parent_start )
189	grid_ptr2 => head_grid
190	found_the_id = .FALSE.
191	! CALL find_my_parent ( grid_ptr2 , grid_ptr , domain_id , parent_id , found_the_id )
192	CALL find_my_parent2( grid_ptr2 , grid_ptr , parent_id , found_the_id )
193	IF ( found_the_id ) THEN
194
195	sibling_count = 0
196	DO dom_loop = 2 , domain_id
197	CALL nl_get_parent_id ( dom_loop, parent_id_hold )
198	IF ( parent_id_hold .EQ. parent_id ) THEN
199	sibling_count = sibling_count + 1
200	END IF
201	END DO
202	CALL alloc_and_configure_domain ( domain_id = domain_id , &
203	grid = another_grid , &
204	parent = grid_ptr , &
205	kid = sibling_count )
206	grid => another_grid
207	ELSE
208	CALL wrf_error_fatal( 'real_em.F: Could not find the parent domain')
209	END IF
210	END IF
211
212	CALL Setup_Timekeeping ( grid )
213	CALL set_current_grid_ptr( grid )
214	CALL domain_clockprint ( 150, grid, &
215	'DEBUG real: clock after Setup_Timekeeping,' )
216	CALL domain_clock_set( grid, &
217	time_step_seconds=model_config_rec%interval_seconds )
218	CALL domain_clockprint ( 150, grid, &
219	'DEBUG real: clock after timeStep set,' )
220
221
222	CALL wrf_debug ( 100 , 'real_em: calling set_scalar_indices_from_config ' )
223	CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
224
225	CALL wrf_debug ( 100 , 'real_em: calling model_to_grid_config_rec ' )
226	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
227
228	! Some simple checks.
229
230	ok_so_far = .TRUE.
231
232	DO loop = 2 , model_config_rec%max_dom
233	IF ( model_config_rec%e_vert(loop) .NE. model_config_rec%e_vert(1) ) THEN
234	CALL wrf_message ( 'e_vert must be the same for each domain' )
235	ok_so_far = .FALSE.
236	END IF
237	END DO
238	IF ( .NOT. ok_so_far ) THEN
239	CALL wrf_error_fatal( 'fix namelist.input settings' )
240	END IF
241
242	! Initialize the WRF IO: open files, init file handles, etc.
243
244	CALL wrf_debug ( 100 , 'real_em: calling init_wrfio' )
245	CALL init_wrfio
246
247	! Some of the configuration values may have been modified from the initial READ
248	! of the NAMELIST, so we re-broadcast the configuration records.
249
250	#ifdef DM_PARALLEL
251	CALL wrf_debug ( 100 , 'real_em: re-broadcast the configuration records' )
252	CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
253	CALL wrf_dm_bcast_bytes( configbuf, nbytes )
254	CALL set_config_as_buffer( configbuf, configbuflen )
255	#endif
256
257	! No looping in this layer.
258
259	CALL wrf_debug ( 100 , 'calling med_sidata_input' )
260	CALL med_sidata_input ( grid , config_flags )
261	CALL wrf_debug ( 100 , 'backfrom med_sidata_input' )
262
263	ELSE
264	CYCLE all_domains
265	END IF
266
267	END DO all_domains
268
269	CALL set_current_grid_ptr( head_grid )
270
271	! We are done.
272
273	CALL wrf_debug ( 0 , 'real_em: SUCCESS COMPLETE REAL_EM INIT' )
274
275	CALL wrf_shutdown
276
277	CALL WRFU_Finalize( rc=rc )
278
279	END PROGRAM real_data
280
281	SUBROUTINE med_sidata_input ( grid , config_flags )
282	! Driver layer
283	USE module_domain
284	USE module_io_domain
285	! Model layer
286	USE module_configure
287	USE module_bc_time_utilities
288	USE module_initialize_real
289	USE module_optional_input
290	#ifdef WRF_CHEM
291	USE module_input_chem_data
292	USE module_input_chem_bioemiss
293	! USE module_input_chem_emissopt3
294	#endif
295
296	USE module_date_time
297	USE module_utility
298
299	IMPLICIT NONE
300
301
302	! Interface
303	INTERFACE
304	SUBROUTINE start_domain ( grid , allowed_to_read ) ! comes from module_start in appropriate dyn_ directory
305	USE module_domain
306	TYPE (domain) grid
307	LOGICAL, INTENT(IN) :: allowed_to_read
308	END SUBROUTINE start_domain
309	END INTERFACE
310
311	! Arguments
312	TYPE(domain) :: grid
313	TYPE (grid_config_rec_type) :: config_flags
314	! Local
315	INTEGER :: time_step_begin_restart
316	INTEGER :: idsi , ierr , myproc
317	CHARACTER (LEN=80) :: si_inpname
318	CHARACTER (LEN=80) :: message
319
320	CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
321
322	INTEGER :: time_loop_max , loop, rc
323	INTEGER :: julyr , julday
324	REAL :: gmt
325	real::t1,t2,t3,t4
326
327	grid%input_from_file = .true.
328	grid%input_from_file = .false.
329
330	CALL compute_si_start_and_end ( model_config_rec%start_year (grid%id) , &
331	model_config_rec%start_month (grid%id) , &
332	model_config_rec%start_day (grid%id) , &
333	model_config_rec%start_hour (grid%id) , &
334	model_config_rec%start_minute(grid%id) , &
335	model_config_rec%start_second(grid%id) , &
336	model_config_rec% end_year (grid%id) , &
337	model_config_rec% end_month (grid%id) , &
338	model_config_rec% end_day (grid%id) , &
339	model_config_rec% end_hour (grid%id) , &
340	model_config_rec% end_minute(grid%id) , &
341	model_config_rec% end_second(grid%id) , &
342	model_config_rec%interval_seconds , &
343	model_config_rec%real_data_init_type , &
344	start_date_char , end_date_char , time_loop_max )
345
346	! Override stop time with value computed above.
347	CALL domain_clock_set( grid, stop_timestr=end_date_char )
348
349	! TBH: for now, turn off stop time and let it run data-driven
350	CALL WRFU_ClockStopTimeDisable( grid%domain_clock, rc=rc )
351	CALL wrf_check_error( WRFU_SUCCESS, rc, &
352	'WRFU_ClockStopTimeDisable(grid%domain_clock) FAILED', &
353	__FILE__ , &
354	__LINE__ )
355	CALL domain_clockprint ( 150, grid, &
356	'DEBUG med_sidata_input: clock after stopTime set,' )
357
358	! Here we define the initial time to process, for later use by the code.
359
360	current_date_char = start_date_char
361	start_date = start_date_char // '.0000'
362	current_date = start_date
363
364	CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
365
366	!!!!!!! Loop over each time period to process.
367
368	CALL cpu_time ( t1 )
369	DO loop = 1 , time_loop_max
370
371	internal_time_loop = loop
372	IF ( ( grid%id .GT. 1 ) .AND. ( loop .GT. 1 ) .AND. &
373	( model_config_rec%grid_fdda(grid%id) .EQ. 0 ) .AND. &
374	( model_config_rec%sst_update .EQ. 0 ) ) EXIT
375
376	print *,' '
377	print *,'-----------------------------------------------------------------------------'
378	print *,' '
379	print '(A,I2,A,A,A,I4,A,I4)' , &
380	' Domain ',grid%id,': Current date being processed: ',current_date, ', which is loop #',loop,' out of ',time_loop_max
381
382	! After current_date has been set, fill in the julgmt stuff.
383
384	CALL geth_julgmt ( config_flags%julyr , config_flags%julday , config_flags%gmt )
385
386	print *,'configflags%julyr, %julday, %gmt:',config_flags%julyr, config_flags%julday, config_flags%gmt
387	! Now that the specific Julian info is available, save these in the model config record.
388
389	CALL nl_set_gmt (grid%id, config_flags%gmt)
390	CALL nl_set_julyr (grid%id, config_flags%julyr)
391	CALL nl_set_julday (grid%id, config_flags%julday)
392
393	! Open the input file for real. This is either the "new" one or the "old" one. The "new" one could have
394	! a suffix for the type of the data format. Check to see if either is around.
395
396	CALL cpu_time ( t3 )
397	WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ', &
398	TRIM(config_flags%auxinput1_inname)
399	CALL wrf_debug ( 100 , wrf_err_message )
400	IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
401	CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
402	current_date_char , config_flags%io_form_auxinput1 )
403	ELSE
404	CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
405	current_date_char )
406	END IF
407	CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
408	IF ( ierr .NE. 0 ) THEN
409	CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // &
410	' for input; bad date in namelist or file not in directory' )
411	END IF
412
413	! Input data.
414
415	CALL wrf_debug ( 100 , 'med_sidata_input: calling input_auxinput1' )
416	CALL input_auxinput1 ( idsi , grid , config_flags , ierr )
417	CALL cpu_time ( t4 )
418	WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for input ',NINT(t4-t3) ,' s.'
419	CALL wrf_debug( 0, wrf_err_message )
420
421	! Possible optional SI input. This sets flags used by init_domain.
422
423	CALL cpu_time ( t3 )
424	IF ( loop .EQ. 1 ) THEN
425	already_been_here = .FALSE.
426	CALL wrf_debug ( 100 , 'med_sidata_input: calling init_module_optional_input' )
427	CALL init_module_optional_input ( grid , config_flags )
428	END IF
429	CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
430	CALL optional_input ( grid , idsi , config_flags )
431
432	! Initialize the mother domain for this time period with input data.
433
434	CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
435	grid%input_from_file = .true.
436	CALL init_domain ( grid )
437	CALL cpu_time ( t4 )
438	WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for processing ',NINT(t4-t3) ,' s.'
439	CALL wrf_debug( 0, wrf_err_message )
440	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
441
442	! Close this file that is output from the SI and input to this pre-proc.
443
444	CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
445	CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
446
447	#ifdef WRF_CHEM
448	IF ( loop == 1 ) THEN
449	IF( grid%chem_opt > 0 ) then
450	! Read the chemistry data from a previous wrf forecast (wrfout file)
451	IF(grid%chem_in_opt == 1 ) THEN
452	message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
453	CALL wrf_message ( message )
454
455	CALL med_read_wrf_chem_input ( grid , config_flags)
456
457	IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC &
458	.or. grid%biomass_burn_opt == BIOMASSB) THEN
459	message = 'READING EMISSIONS DATA OPT 3'
460	CALL wrf_message ( message )
461	CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
462	END IF
463
464	IF(grid%bio_emiss_opt == 2 ) THEN
465	message = 'READING BEIS3.11 EMISSIONS DATA'
466	CALL wrf_message ( message )
467	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
468	else IF(grid%bio_emiss_opt == 3 ) THEN !shc
469	message = 'READING MEGAN 2 EMISSIONS DATA'
470	CALL wrf_message ( message )
471	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
472	END IF
473
474	IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
475	message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
476	CALL wrf_message ( message )
477	CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
478	END IF
479
480	ELSEIF(grid%chem_in_opt == 0)then
481	! Generate chemistry data from a idealized vertical profile
482	message = 'STARTING WITH BACKGROUND CHEMISTRY '
483	CALL wrf_message ( message )
484
485	CALL input_chem_profile ( grid )
486
487	IF(grid%bio_emiss_opt == 2 ) THEN
488	message = 'READING BEIS3.11 EMISSIONS DATA'
489	CALL wrf_message ( message )
490	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
491	else IF(grid%bio_emiss_opt == 3 ) THEN !shc
492	message = 'READING MEGAN 2 EMISSIONS DATA'
493	CALL wrf_message ( message )
494	CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
495	END IF
496	IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC &
497	.or. grid%biomass_burn_opt == BIOMASSB) THEN
498	message = 'READING EMISSIONS DATA OPT 3'
499	CALL wrf_message ( message )
500	! CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
501	CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
502	END IF
503
504	IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
505	message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
506	CALL wrf_message ( message )
507	CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
508	END IF
509
510	ELSE
511	message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
512	CALL wrf_message ( message )
513	END IF
514	END IF
515	END IF
516	#endif
517
518	CALL cpu_time ( t3 )
519	CALL assemble_output ( grid , config_flags , loop , time_loop_max )
520	CALL cpu_time ( t4 )
521	WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for output ',NINT(t4-t3) ,' s.'
522	CALL wrf_debug( 0, wrf_err_message )
523	CALL cpu_time ( t2 )
524	WRITE ( wrf_err_message , FMT='(A,I4,A,I10,A)' ) 'Timing for loop # ',loop,' = ',NINT(t2-t1) ,' s.'
525	CALL wrf_debug( 0, wrf_err_message )
526
527	! If this is not the last time, we define the next time that we are going to process.
528
529	IF ( loop .NE. time_loop_max ) THEN
530	CALL geth_newdate ( current_date_char , start_date_char , loop * model_config_rec%interval_seconds )
531	current_date = current_date_char // '.0000'
532	CALL domain_clockprint ( 150, grid, &
533	'DEBUG med_sidata_input: clock before current_date set,' )
534	WRITE (wrf_err_message,*) &
535	'DEBUG med_sidata_input: before currTime set, current_date = ',TRIM(current_date)
536	CALL wrf_debug ( 150 , wrf_err_message )
537	CALL domain_clock_set( grid, current_date(1:19) )
538	CALL domain_clockprint ( 150, grid, &
539	'DEBUG med_sidata_input: clock after current_date set,' )
540	END IF
541	CALL cpu_time ( t1 )
542	END DO
543
544	END SUBROUTINE med_sidata_input
545
546	SUBROUTINE compute_si_start_and_end ( &
547	start_year , start_month , start_day , start_hour , start_minute , start_second , &
548	end_year , end_month , end_day , end_hour , end_minute , end_second , &
549	interval_seconds , real_data_init_type , &
550	start_date_char , end_date_char , time_loop_max )
551
552	USE module_date_time
553
554	IMPLICIT NONE
555
556	INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
557	INTEGER :: end_year , end_month , end_day , end_hour , end_minute , end_second
558	INTEGER :: interval_seconds , real_data_init_type
559	INTEGER :: time_loop_max , time_loop
560
561	CHARACTER(LEN=19) :: current_date_char , start_date_char , end_date_char , next_date_char
562
563	#ifdef PLANET
564	WRITE ( start_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
565	start_year,start_day,start_hour,start_minute,start_second
566	WRITE ( end_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
567	end_year, end_day, end_hour, end_minute, end_second
568	#else
569	WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
570	start_year,start_month,start_day,start_hour,start_minute,start_second
571	WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
572	end_year, end_month, end_day, end_hour, end_minute, end_second
573	#endif
574
575	IF ( end_date_char .LT. start_date_char ) THEN
576	CALL wrf_error_fatal( 'Ending date in namelist ' // end_date_char // ' prior to beginning date ' // start_date_char )
577	END IF
578
579	! start_date = start_date_char // '.0000'
580
581	! Figure out our loop count for the processing times.
582
583	time_loop = 1
584	PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',start_date_char,'.'
585	current_date_char = start_date_char
586	loop_count : DO
587	CALL geth_newdate ( next_date_char , current_date_char , interval_seconds )
588	IF ( next_date_char .LT. end_date_char ) THEN
589	time_loop = time_loop + 1
590	PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
591	current_date_char = next_date_char
592	ELSE IF ( next_date_char .EQ. end_date_char ) THEN
593	time_loop = time_loop + 1
594	PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
595	PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
596	time_loop_max = time_loop
597	EXIT loop_count
598	ELSE IF ( next_date_char .GT. end_date_char ) THEN
599	PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
600	time_loop_max = time_loop
601	EXIT loop_count
602	END IF
603	END DO loop_count
604	END SUBROUTINE compute_si_start_and_end
605
606	SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
607
608	USE module_big_step_utilities_em
609	USE module_domain
610	USE module_io_domain
611	USE module_configure
612	USE module_date_time
613	USE module_bc
614	IMPLICIT NONE
615
616	TYPE(domain) :: grid
617	TYPE (grid_config_rec_type) :: config_flags
618	INTEGER , INTENT(IN) :: loop , time_loop_max
619
620	INTEGER :: ids , ide , jds , jde , kds , kde
621	INTEGER :: ims , ime , jms , jme , kms , kme
622	INTEGER :: ips , ipe , jps , jpe , kps , kpe
623	INTEGER :: ijds , ijde , spec_bdy_width
624	INTEGER :: i , j , k , idts
625
626	INTEGER :: id1 , interval_seconds , ierr, rc, sst_update, grid_fdda
627	INTEGER , SAVE :: id, id2, id4
628	CHARACTER (LEN=80) :: inpname , bdyname
629	CHARACTER(LEN= 4) :: loop_char
630	character *19 :: temp19
631	character *24 :: temp24 , temp24b
632
633	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
634	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp1
635	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
636	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp2
637	real::t1,t2
638
639	! Various sizes that we need to be concerned about.
640
641	ids = grid%sd31
642	ide = grid%ed31
643	kds = grid%sd32
644	kde = grid%ed32
645	jds = grid%sd33
646	jde = grid%ed33
647
648	ims = grid%sm31
649	ime = grid%em31
650	kms = grid%sm32
651	kme = grid%em32
652	jms = grid%sm33
653	jme = grid%em33
654
655	ips = grid%sp31
656	ipe = grid%ep31
657	kps = grid%sp32
658	kpe = grid%ep32
659	jps = grid%sp33
660	jpe = grid%ep33
661
662	ijds = MIN ( ids , jds )
663	ijde = MAX ( ide , jde )
664
665	! Boundary width, scalar value.
666
667	spec_bdy_width = model_config_rec%spec_bdy_width
668	interval_seconds = model_config_rec%interval_seconds
669	sst_update = model_config_rec%sst_update
670	grid_fdda = model_config_rec%grid_fdda(grid%id)
671
672
673	IF ( loop .EQ. 1 ) THEN
674
675	IF ( ( time_loop_max .EQ. 1 ) .OR. ( config_flags%polar ) ) THEN
676
677	! No need to allocate space since we do not need the lateral boundary data yet
678	! or at all (in case of the polar flag).
679
680	ELSE
681
682	! This is the space needed to save the current 3d data for use in computing
683	! the lateral boundary tendencies.
684
685	IF ( ALLOCATED ( ubdy3dtemp1 ) ) DEALLOCATE ( ubdy3dtemp1 )
686	IF ( ALLOCATED ( vbdy3dtemp1 ) ) DEALLOCATE ( vbdy3dtemp1 )
687	IF ( ALLOCATED ( tbdy3dtemp1 ) ) DEALLOCATE ( tbdy3dtemp1 )
688	IF ( ALLOCATED ( pbdy3dtemp1 ) ) DEALLOCATE ( pbdy3dtemp1 )
689	IF ( ALLOCATED ( qbdy3dtemp1 ) ) DEALLOCATE ( qbdy3dtemp1 )
690	IF ( ALLOCATED ( mbdy2dtemp1 ) ) DEALLOCATE ( mbdy2dtemp1 )
691	IF ( ALLOCATED ( ubdy3dtemp2 ) ) DEALLOCATE ( ubdy3dtemp2 )
692	IF ( ALLOCATED ( vbdy3dtemp2 ) ) DEALLOCATE ( vbdy3dtemp2 )
693	IF ( ALLOCATED ( tbdy3dtemp2 ) ) DEALLOCATE ( tbdy3dtemp2 )
694	IF ( ALLOCATED ( pbdy3dtemp2 ) ) DEALLOCATE ( pbdy3dtemp2 )
695	IF ( ALLOCATED ( qbdy3dtemp2 ) ) DEALLOCATE ( qbdy3dtemp2 )
696	IF ( ALLOCATED ( mbdy2dtemp2 ) ) DEALLOCATE ( mbdy2dtemp2 )
697
698	ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
699	ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
700	ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
701	ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
702	ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
703	ALLOCATE ( mbdy2dtemp1(ims:ime,1:1, jms:jme) )
704	ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
705	ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
706	ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
707	ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
708	ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
709	ALLOCATE ( mbdy2dtemp2(ims:ime,1:1, jms:jme) )
710
711	END IF
712
713	! Open the wrfinput file. From this program, this is an output file.
714
715	CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
716	CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_input , "DATASET=INPUT", ierr )
717	IF ( ierr .NE. 0 ) THEN
718	CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
719	END IF
720	CALL output_input ( id1, grid , config_flags , ierr )
721	CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
722
723	IF ( time_loop_max .NE. 1 ) THEN
724	IF(sst_update .EQ. 1)THEN
725	CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
726	CALL open_w_dataset ( id4, TRIM(inpname) , grid , config_flags , output_auxinput4 , "DATASET=AUXINPUT4", ierr )
727	IF ( ierr .NE. 0 ) THEN
728	CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
729	END IF
730	CALL output_auxinput4 ( id4, grid , config_flags , ierr )
731	END IF
732	END IF
733
734	IF ( ( time_loop_max .EQ. 1 ) .OR. ( config_flags%polar ) ) THEN
735
736	! No need to couple data since no lateral BCs required.
737
738	ELSE
739
740	! We need to save the 3d data to compute a difference during the next loop. Couple the
741	! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
742
743	! u, theta, h, scalars coupled with my; v coupled with mx
744	CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp1 , grid%u_2 , 'u' , grid%msfuy , &
745	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
746	CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp1 , grid%v_2 , 'v' , grid%msfvx , &
747	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
748	CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp1 , grid%t_2 , 't' , grid%msfty , &
749	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
750	CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp1 , grid%ph_2 , 'h' , grid%msfty , &
751	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
752	CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp1 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , &
753	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
754
755	DO j = jps , MIN(jde-1,jpe)
756	DO i = ips , MIN(ide-1,ipe)
757	mbdy2dtemp1(i,1,j) = grid%mu_2(i,j)
758	END DO
759	END DO
760
761	END IF
762
763	IF(grid_fdda .GE. 1)THEN
764	DO j = jps , jpe
765	DO k = kps , kpe
766	DO i = ips , ipe
767	grid%fdda3d(i,k,j,p_u_ndg_old) = grid%u_2(i,k,j)
768	grid%fdda3d(i,k,j,p_v_ndg_old) = grid%v_2(i,k,j)
769	grid%fdda3d(i,k,j,p_t_ndg_old) = grid%t_2(i,k,j)
770	grid%fdda3d(i,k,j,p_q_ndg_old) = grid%moist(i,k,j,P_QV)
771	grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%ph_2(i,k,j)
772	END DO
773	END DO
774	END DO
775
776	DO j = jps , jpe
777	DO i = ips , ipe
778	grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%mu_2(i,j)
779	! grid%fdda2d(i,1,j,p_t2_ndg_old) = grid%t2(i,j)
780	! grid%fdda2d(i,1,j,p_q2_ndg_old) = grid%q2(i,j)
781	! grid%fdda2d(i,1,j,p_sn_ndg_old) = grid%snow(i,j)
782	END DO
783	END DO
784	END IF
785
786	IF ( ( time_loop_max .EQ. 1 ) .OR. ( config_flags%polar ) ) THEN
787
788	! No need to build boundary arrays, since no lateral BCs are being generated.
789
790	ELSE
791
792	! There are 2 components to the lateral boundaries. First, there is the starting
793	! point of this time period - just the outer few rows and columns.
794
795	CALL stuff_bdy ( ubdy3dtemp1 , grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
796	'U' , spec_bdy_width , &
797	ids , ide , jds , jde , kds , kde , &
798	ims , ime , jms , jme , kms , kme , &
799	ips , ipe , jps , jpe , kps , kpe )
800	CALL stuff_bdy ( vbdy3dtemp1 , grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
801	'V' , spec_bdy_width , &
802	ids , ide , jds , jde , kds , kde , &
803	ims , ime , jms , jme , kms , kme , &
804	ips , ipe , jps , jpe , kps , kpe )
805	CALL stuff_bdy ( tbdy3dtemp1 , grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
806	'T' , spec_bdy_width , &
807	ids , ide , jds , jde , kds , kde , &
808	ims , ime , jms , jme , kms , kme , &
809	ips , ipe , jps , jpe , kps , kpe )
810	CALL stuff_bdy ( pbdy3dtemp1 , grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
811	'W' , spec_bdy_width , &
812	ids , ide , jds , jde , kds , kde , &
813	ims , ime , jms , jme , kms , kme , &
814	ips , ipe , jps , jpe , kps , kpe )
815	CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV), &
816	grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV), &
817	'T' , spec_bdy_width , &
818	ids , ide , jds , jde , kds , kde , &
819	ims , ime , jms , jme , kms , kme , &
820	ips , ipe , jps , jpe , kps , kpe )
821	CALL stuff_bdy ( mbdy2dtemp1 , grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
822	'M' , spec_bdy_width , &
823	ids , ide , jds , jde , 1 , 1 , &
824	ims , ime , jms , jme , 1 , 1 , &
825	ips , ipe , jps , jpe , 1 , 1 )
826	END IF
827
828
829	ELSE IF ( loop .GT. 1 ) THEN
830
831	IF(sst_update .EQ. 1)THEN
832	CALL output_auxinput4 ( id4, grid , config_flags , ierr )
833	END IF
834
835	! Open the boundary and the fdda file.
836
837	IF ( loop .eq. 2 ) THEN
838	IF ( (grid%id .eq. 1) .and. ( .NOT. config_flags%polar ) ) THEN
839	CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
840	CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
841	IF ( ierr .NE. 0 ) THEN
842	CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
843	END IF
844	END IF
845	IF(grid_fdda .GE. 1)THEN
846	CALL construct_filename1( inpname , 'wrffdda' , grid%id , 2 )
847	CALL open_w_dataset ( id2, TRIM(inpname) , grid , config_flags , output_auxinput10 , "DATASET=AUXINPUT10", ierr )
848	IF ( ierr .NE. 0 ) THEN
849	CALL wrf_error_fatal( 'real: error opening wrffdda for writing' )
850	END IF
851	END IF
852	ELSE
853	IF ( .NOT. domain_clockisstoptime(grid) ) THEN
854	CALL domain_clockadvance( grid )
855	CALL domain_clockprint ( 150, grid, &
856	'DEBUG assemble_output: clock after ClockAdvance,' )
857	END IF
858	END IF
859
860	IF ( config_flags%polar ) THEN
861
862	! No need to couple fields, since no lateral BCs are required.
863
864	ELSE
865
866	! Couple this time period's data with total mu, and save it in the *bdy3dtemp2 arrays.
867
868	! u, theta, h, scalars coupled with my; v coupled with mx
869	CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp2 , grid%u_2 , 'u' , grid%msfuy , &
870	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
871	CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp2 , grid%v_2 , 'v' , grid%msfvx , &
872	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
873	CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp2 , grid%t_2 , 't' , grid%msfty , &
874	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
875	CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp2 , grid%ph_2 , 'h' , grid%msfty , &
876	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
877	CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp2 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , &
878	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
879
880	DO j = jps , jpe
881	DO i = ips , ipe
882	mbdy2dtemp2(i,1,j) = grid%mu_2(i,j)
883	END DO
884	END DO
885
886	END IF
887
888	IF(grid_fdda .GE. 1)THEN
889	DO j = jps , jpe
890	DO k = kps , kpe
891	DO i = ips , ipe
892	grid%fdda3d(i,k,j,p_u_ndg_new) = grid%u_2(i,k,j)
893	grid%fdda3d(i,k,j,p_v_ndg_new) = grid%v_2(i,k,j)
894	grid%fdda3d(i,k,j,p_t_ndg_new) = grid%t_2(i,k,j)
895	grid%fdda3d(i,k,j,p_q_ndg_new) = grid%moist(i,k,j,P_QV)
896	grid%fdda3d(i,k,j,p_ph_ndg_new) = grid%ph_2(i,k,j)
897	END DO
898	END DO
899	END DO
900
901	DO j = jps , jpe
902	DO i = ips , ipe
903	grid%fdda2d(i,1,j,p_mu_ndg_new) = grid%mu_2(i,j)
904	! grid%fdda2d(i,1,j,p_t2_ndg_new) = grid%t2(i,j)
905	! grid%fdda2d(i,1,j,p_q2_ndg_new) = grid%q2(i,j)
906	! grid%fdda2d(i,1,j,p_sn_ndg_new) = grid%snow(i,j)
907	END DO
908	END DO
909	END IF
910
911	IF ( config_flags%polar ) THEN
912
913	! No need to build boundary arrays, since no lateral BCs are being generated.
914
915	ELSE
916
917	! During all of the loops after the first loop, we first compute the boundary
918	! tendencies with the current data values (*bdy3dtemp2 arrays) and the previously
919	! saved information stored in the *bdy3dtemp1 arrays.
920
921	CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds) , &
922	grid%u_btxs, grid%u_btxe, &
923	grid%u_btys, grid%u_btye, &
924	'U' , &
925	spec_bdy_width , &
926	ids , ide , jds , jde , kds , kde , &
927	ims , ime , jms , jme , kms , kme , &
928	ips , ipe , jps , jpe , kps , kpe )
929	CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds) , &
930	grid%v_btxs, grid%v_btxe, &
931	grid%v_btys, grid%v_btye, &
932	'V' , &
933	spec_bdy_width , &
934	ids , ide , jds , jde , kds , kde , &
935	ims , ime , jms , jme , kms , kme , &
936	ips , ipe , jps , jpe , kps , kpe )
937	CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds) , &
938	grid%t_btxs, grid%t_btxe, &
939	grid%t_btys, grid%t_btye, &
940	'T' , &
941	spec_bdy_width , &
942	ids , ide , jds , jde , kds , kde , &
943	ims , ime , jms , jme , kms , kme , &
944	ips , ipe , jps , jpe , kps , kpe )
945	CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , REAL(interval_seconds) , &
946	grid%ph_btxs, grid%ph_btxe, &
947	grid%ph_btys, grid%ph_btye, &
948	'W' , &
949	spec_bdy_width , &
950	ids , ide , jds , jde , kds , kde , &
951	ims , ime , jms , jme , kms , kme , &
952	ips , ipe , jps , jpe , kps , kpe )
953	CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , &
954	grid%moist_btxs(:,:,:,P_QV), grid%moist_btxe(:,:,:,P_QV), &
955	grid%moist_btys(:,:,:,P_QV), grid%moist_btye(:,:,:,P_QV), &
956	'T' , &
957	spec_bdy_width , &
958	ids , ide , jds , jde , kds , kde , &
959	ims , ime , jms , jme , kms , kme , &
960	ips , ipe , jps , jpe , kps , kpe )
961	CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , REAL(interval_seconds) , &
962	grid%mu_btxs, grid%mu_btxe, &
963	grid%mu_btys, grid%mu_btye, &
964	'M' , &
965	spec_bdy_width , &
966	ids , ide , jds , jde , 1 , 1 , &
967	ims , ime , jms , jme , 1 , 1 , &
968	ips , ipe , jps , jpe , 1 , 1 )
969	END IF
970
971	! Both pieces of the boundary data are now available to be written (initial time and tendency).
972	! This looks ugly, these date shifting things. What's it for? We want the "Times" variable
973	! in the lateral BDY file to have the valid times of when the initial fields are written.
974	! That's what the loop-2 thingy is for with the start date. We increment the start_date so
975	! that the starting time in the attributes is the second time period. Why you may ask. I
976	! agree, why indeed.
977
978	CALL domain_clockprint ( 150, grid, &
979	'DEBUG assemble_output: clock before 1st current_date set,' )
980	WRITE (wrf_err_message,*) &
981	'DEBUG assemble_output: before 1st currTime set, current_date = ',TRIM(current_date)
982	CALL wrf_debug ( 150 , wrf_err_message )
983	CALL domain_clock_set( grid, current_date(1:19) )
984	CALL domain_clockprint ( 150, grid, &
985	'DEBUG assemble_output: clock after 1st current_date set,' )
986
987	temp24= current_date
988	temp24b=start_date
989	start_date = current_date
990	CALL geth_newdate ( temp19 , temp24b(1:19) , (loop-2) * model_config_rec%interval_seconds )
991	current_date = temp19 // '.0000'
992	CALL domain_clockprint ( 150, grid, &
993	'DEBUG assemble_output: clock before 2nd current_date set,' )
994	WRITE (wrf_err_message,*) &
995	'DEBUG assemble_output: before 2nd currTime set, current_date = ',TRIM(current_date)
996	CALL wrf_debug ( 150 , wrf_err_message )
997	CALL domain_clock_set( grid, current_date(1:19) )
998	CALL domain_clockprint ( 150, grid, &
999	'DEBUG assemble_output: clock after 2nd current_date set,' )
1000
1001	IF ( config_flags%polar ) THEN
1002
1003	! No need to ouput boundary data for polar cases.
1004
1005	ELSE
1006
1007	! Output boundary file.
1008
1009	IF(grid%id .EQ. 1)THEN
1010	print *,'LBC valid between these times ',current_date, ' ',start_date
1011	CALL output_boundary ( id, grid , config_flags , ierr )
1012	END IF
1013
1014	END IF
1015
1016	! Output gridded/analysis FDDA file.
1017
1018	IF(grid_fdda .GE. 1) THEN
1019	CALL output_auxinput10 ( id2, grid , config_flags , ierr )
1020	END IF
1021
1022	current_date = temp24
1023	start_date = temp24b
1024	CALL domain_clockprint ( 150, grid, &
1025	'DEBUG assemble_output: clock before 3rd current_date set,' )
1026	WRITE (wrf_err_message,*) &
1027	'DEBUG assemble_output: before 3rd currTime set, current_date = ',TRIM(current_date)
1028	CALL wrf_debug ( 150 , wrf_err_message )
1029	CALL domain_clock_set( grid, current_date(1:19) )
1030	CALL domain_clockprint ( 150, grid, &
1031	'DEBUG assemble_output: clock after 3rd current_date set,' )
1032
1033	! OK, for all of the loops, we output the initialzation data, which would allow us to
1034	! start the model at any of the available analysis time periods.
1035
1036	IF ( config_flags%all_ic_times ) THEN
1037	CALL construct_filename2a ( inpname , 'wrfinput_d<domain>.<date>' , grid%id , 2 , TRIM(current_date) )
1038	CALL open_w_dataset ( id1, inpname , grid , config_flags , output_input , "DATASET=INPUT", ierr )
1039	IF ( ierr .NE. 0 ) THEN
1040	CALL wrf_error_fatal( 'real: error opening' // inpname // ' for writing' )
1041	END IF
1042	CALL output_input ( id1, grid , config_flags , ierr )
1043	CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
1044	END IF
1045
1046	! Is this or is this not the last time time? We can remove some unnecessary
1047	! stores if it is not.
1048
1049	IF ( loop .LT. time_loop_max ) THEN
1050
1051	IF ( config_flags%polar ) THEN
1052
1053	! No need to swap old for new for the boundary data, it is not required.
1054
1055	ELSE
1056
1057	! We need to save the 3d data to compute a difference during the next loop. Couple the
1058	! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
1059	! We load up the boundary data again for use in the next loop.
1060
1061	DO j = jps , jpe
1062	DO k = kps , kpe
1063	DO i = ips , ipe
1064	ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
1065	vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
1066	tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
1067	pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
1068	qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
1069	END DO
1070	END DO
1071	END DO
1072
1073	DO j = jps , jpe
1074	DO i = ips , ipe
1075	mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
1076	END DO
1077	END DO
1078
1079	END IF
1080
1081	IF(grid_fdda .GE. 1)THEN
1082	DO j = jps , jpe
1083	DO k = kps , kpe
1084	DO i = ips , ipe
1085	grid%fdda3d(i,k,j,p_u_ndg_old) = grid%fdda3d(i,k,j,p_u_ndg_new)
1086	grid%fdda3d(i,k,j,p_v_ndg_old) = grid%fdda3d(i,k,j,p_v_ndg_new)
1087	grid%fdda3d(i,k,j,p_t_ndg_old) = grid%fdda3d(i,k,j,p_t_ndg_new)
1088	grid%fdda3d(i,k,j,p_q_ndg_old) = grid%fdda3d(i,k,j,p_q_ndg_new)
1089	grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%fdda3d(i,k,j,p_ph_ndg_new)
1090	END DO
1091	END DO
1092	END DO
1093
1094	DO j = jps , jpe
1095	DO i = ips , ipe
1096	grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%fdda2d(i,1,j,p_mu_ndg_new)
1097	! grid%fdda2d(i,1,j,p_t2_ndg_old) = grid%fdda2d(i,1,j,p_t2_ndg_new)
1098	! grid%fdda2d(i,1,j,p_q2_ndg_old) = grid%fdda2d(i,1,j,p_q2_ndg_new)
1099	! grid%fdda2d(i,1,j,p_sn_ndg_old) = grid%fdda2d(i,1,j,p_sn_ndg_new)
1100	END DO
1101	END DO
1102	END IF
1103
1104	IF ( config_flags%polar ) THEN
1105
1106	! No need to build boundary arrays, since no lateral BCs are being generated.
1107
1108	ELSE
1109
1110	! There are 2 components to the lateral boundaries. First, there is the starting
1111	! point of this time period - just the outer few rows and columns.
1112
1113	CALL stuff_bdy ( ubdy3dtemp1 , grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
1114	'U' , spec_bdy_width , &
1115	ids , ide , jds , jde , kds , kde , &
1116	ims , ime , jms , jme , kms , kme , &
1117	ips , ipe , jps , jpe , kps , kpe )
1118	CALL stuff_bdy ( vbdy3dtemp1 , grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
1119	'V' , spec_bdy_width , &
1120	ids , ide , jds , jde , kds , kde , &
1121	ims , ime , jms , jme , kms , kme , &
1122	ips , ipe , jps , jpe , kps , kpe )
1123	CALL stuff_bdy ( tbdy3dtemp1 , grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
1124	'T' , spec_bdy_width , &
1125	ids , ide , jds , jde , kds , kde , &
1126	ims , ime , jms , jme , kms , kme , &
1127	ips , ipe , jps , jpe , kps , kpe )
1128	CALL stuff_bdy ( pbdy3dtemp1 , grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
1129	'W' , spec_bdy_width , &
1130	ids , ide , jds , jde , kds , kde , &
1131	ims , ime , jms , jme , kms , kme , &
1132	ips , ipe , jps , jpe , kps , kpe )
1133	CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV), &
1134	grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV), &
1135	'T' , spec_bdy_width , &
1136	ids , ide , jds , jde , kds , kde , &
1137	ims , ime , jms , jme , kms , kme , &
1138	ips , ipe , jps , jpe , kps , kpe )
1139	CALL stuff_bdy ( mbdy2dtemp1 , grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
1140	'M' , spec_bdy_width , &
1141	ids , ide , jds , jde , 1 , 1 , &
1142	ims , ime , jms , jme , 1 , 1 , &
1143	ips , ipe , jps , jpe , 1 , 1 )
1144
1145	END IF
1146
1147	ELSE IF ( loop .EQ. time_loop_max ) THEN
1148
1149	! If this is the last time through here, we need to close the files.
1150
1151	IF ( config_flags%polar ) THEN
1152
1153	! No need to close the boundary file, it was never used.
1154
1155	ELSE
1156	IF(grid%id .EQ. 1) THEN
1157	CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1158	END IF
1159	END IF
1160
1161	IF(grid_fdda .GE. 1) THEN
1162	CALL close_dataset ( id2 , config_flags , "DATASET=AUXINPUT10" )
1163	END IF
1164
1165	IF(sst_update .EQ. 1)THEN
1166	CALL close_dataset ( id4 , config_flags , "DATASET=AUXINPUT4" )
1167	END IF
1168
1169	END IF
1170
1171	END IF
1172
1173	END SUBROUTINE assemble_output

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

Download in other formats:

Original Format