Context Navigation

real_em.F @ 73

Last change on this file since 73 was 55, checked in by aslmd, 15 years ago

LMD_MM_MARS: element manquant pour runs traceurs avec nouvelle physique
--> avec mars=0 et non actif, le modele fonctionne toujours bien [avec starts JBM et conditions de ses runs]
--> mettre les traceurs avec mars=11 [actifs ou non] semble faire crasher le modele: pourquoi ?

M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/call_meso_physiq1.inc
M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/call_meso_physiq2.inc
M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/call_meso_physiq3.inc
M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/call_meso_physiq4.inc
M 54 mars/libf/phymars/meso_physiq.F
le tableau tnom est defini dans module_lmd_driver en fonction de config_flag%mars [MARS_MODE]

et passe dans meso_physiq [pour ensuite servir dans initracer]

--> le COMMON advtrac.h est alors necessaire

M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/Registry/Registry.EM
config_flag%mars defini une serie de traceurs ordonnee dans le tableau scalar

M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/share/module_model_constants.F
on passe au cp et R du GCM martien pour une complete correspondance

M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/call_meso_physiq.inc
ce fichier est en fait inutile et pourrait etre supprime

M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/module_initialize_real.F
M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/solve_em.F
M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_lmd_driver.F
M 54 mesoscale/LMD_MM_MARS/SRC/WRFV2/main/real_em.F
modifications pour prise en compte des traceurs avec la nouvelle physique
--> avantage des traceurs generiques dans la physique
--> pour l'instant dans SCALAR l'indice 1 est dummy, 2/3 water vapor/ice et dernier CO2

M 54 mesoscale/LMD_MM_MARS/SRC/PREP_MARS/readmeteo_newphys.F90
M 54 mesoscale/LMD_MM_MARS/SRC/WPS/wps_mars/metgrid/METGRID.TBL.ARW_MarsBase_newphys
modifications pour possibilites de passer les tableaux necessaires pour

initialiser et guider les traceurs dans la nouvelle physique

M mars/libf/phymars/dimradmars.h
M mars/libf/phymars/callradite.F
version traceurs non actifs pour tests basiques

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

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

Download in other formats:

Original Format