Context Navigation

real_em.F @ 134

Last change on this file since 134 was 76, checked in by aslmd, 14 years ago

LMD_MM_MARS: remise a plat du traitement des traceurs terminee

[en particulier en vue de l'utilisation nouvelle physique]
--> fonctionnement concluant sur un cas Tharsis hydro 61x61x61
--> ne pas utiliser le cas FASTCASE trop instable avec traceurs
--> reste a tester l'effet d'especes radiativement actives

options dans namelist.input :
mars = 0 ---> pas de traceurs
mars = 1 ---> cycle de l'eau : water vapour + ice
mars = 2 ---> cycle poussieres : un dust bin
mars = 3 ---> cycle poussieres : dustq + dustn [NOUVELLE PHYS seulement]
mars = 11 ---> cycle de l'eau + poussieres [1+3] [NOUVELLE PHYS seulement]

NB: pour les deux derniers, reste un petit travail mineur sur qsurf

(voir dans module_lmd_driver.F)

il faut definir conjointement le callphys.def associe et relancer real.exe

(sinon on transporte juste dynamiquement des 'dummy' traceurs)

il n'est necessaire de recompiler que si le nombre total de traceurs change

Fichiers a mettre a jour si l'on ajoute une option "mars" dans le Registry

Attention suivant les inputs GCM, il faut peut etre egalement changer

readmeteo.F90 dans PREP_MARS et 2. METGRID.TBL dans WPS/metgrid

M 75 mesoscale/LMD_MM_MARS/SRC/WRFV2/Registry/Registry.EM
---> definition du scenario et de l'ordre des traceurs dans SCALAR

M 75 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/module_initialize_real.F
---> definition des interpolations verticales des champs de traceurs venant du GCM

M 75 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/solve_em.F
---> definition du traitement a reserver aux bornes
---> --- dans les 4 scenarios precites, on passe aux bornes les champs du GCM

[y compris QH2O_ICE contrairement a ce qui etait par defaut precedemment]

---> --- les lignes relatives a un flux nul aux bornes sont laissees a un cas hypothetique mars>50

M 75 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_lmd_driver.F
---> definition de l'ordre correct des traceurs pour le passage a la physique
---> recuperation des tendances de la physique pour passage a la dynamique
---> NB: c'est dans ce module que sont presents des STOP si mars = 4-10 ou mars > 11

.... il faut donc modifier si l'on ajoute des options

M 75 mesoscale/LMD_MM_MARS/SRC/WRFV2/main/real_em.F
---> definition et calcul des champs a appliquer aux bornes
---> generalise desormais, il n'y a plus qu'a ajouter d'eventuelles nouvelles options 'mars'
---> .... des modifications sont necessaires si on passe plus de 4 traceurs aux bornes

M 75 mesoscale/LMD_MM_MARS/SIMU/runmeso
---> definition du bon nombre de traceurs dans la compilation de la physique puis l'execution

[l'option mars est lue par le script dans namelist.input]

Fichiers tests

A 0 mesoscale/TESTS/newphys_tracers/*
---> pour la nouvelle physique (ici seulement les fichiers def)
---> toutes les options precitees ont ete testes avec succes a l'execution [pas de crash]
---> ... plausibilite physique verifiee rapidement, PAS d'ANALYSE APPROFONDIE pour le moment

A 0 mesoscale/TESTS/LMD_MM_MARS_TESTCASE_water.tar.gz
---> pour l'ancienne physique (introduit precedemment mais n'avait pas ete synchronise)

M 75 mars/libf/phymars/meso_dustlift.F
NB: correction mineure, de facon a recuperer alpha_lift de initracer

File size: 55.3 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 >>
565	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q2bdy3dtemp1
566	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q3bdy3dtemp1
567	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q4bdy3dtemp1
568	!!!!***MARS <<
569	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp1
570	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
571	!!!!***MARS >>
572	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q2bdy3dtemp2
573	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q3bdy3dtemp2
574	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: q4bdy3dtemp2
575	!!!!***MARS <<
576	REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp2
577	real::t1,t2
578
579	! Various sizes that we need to be concerned about.
580
581	ids = grid%sd31
582	ide = grid%ed31
583	kds = grid%sd32
584	kde = grid%ed32
585	jds = grid%sd33
586	jde = grid%ed33
587
588	ims = grid%sm31
589	ime = grid%em31
590	kms = grid%sm32
591	kme = grid%em32
592	jms = grid%sm33
593	jme = grid%em33
594
595	ips = grid%sp31
596	ipe = grid%ep31
597	kps = grid%sp32
598	kpe = grid%ep32
599	jps = grid%sp33
600	jpe = grid%ep33
601
602	ijds = MIN ( ids , jds )
603	ijde = MAX ( ide , jde )
604
605	! Boundary width, scalar value.
606
607	spec_bdy_width = model_config_rec%spec_bdy_width
608	interval_seconds = model_config_rec%interval_seconds
609	sst_update = model_config_rec%sst_update
610	grid_fdda = model_config_rec%grid_fdda(grid%id)
611
612
613	IF ( loop .EQ. 1 ) THEN
614
615	! This is the space needed to save the current 3d data for use in computing
616	! the lateral boundary tendencies.
617
618	IF ( ALLOCATED ( ubdy3dtemp1 ) ) DEALLOCATE ( ubdy3dtemp1 )
619	IF ( ALLOCATED ( vbdy3dtemp1 ) ) DEALLOCATE ( vbdy3dtemp1 )
620	IF ( ALLOCATED ( tbdy3dtemp1 ) ) DEALLOCATE ( tbdy3dtemp1 )
621	IF ( ALLOCATED ( pbdy3dtemp1 ) ) DEALLOCATE ( pbdy3dtemp1 )
622	IF ( ALLOCATED ( qbdy3dtemp1 ) ) DEALLOCATE ( qbdy3dtemp1 )
623	!!!!***MARS >>
624	IF ( ALLOCATED ( q2bdy3dtemp1 ) ) DEALLOCATE ( q2bdy3dtemp1 )
625	IF ( ALLOCATED ( q3bdy3dtemp1 ) ) DEALLOCATE ( q3bdy3dtemp1 )
626	IF ( ALLOCATED ( q4bdy3dtemp1 ) ) DEALLOCATE ( q4bdy3dtemp1 )
627	!!!!***MARS <<
628	IF ( ALLOCATED ( mbdy2dtemp1 ) ) DEALLOCATE ( mbdy2dtemp1 )
629	IF ( ALLOCATED ( ubdy3dtemp2 ) ) DEALLOCATE ( ubdy3dtemp2 )
630	IF ( ALLOCATED ( vbdy3dtemp2 ) ) DEALLOCATE ( vbdy3dtemp2 )
631	IF ( ALLOCATED ( tbdy3dtemp2 ) ) DEALLOCATE ( tbdy3dtemp2 )
632	IF ( ALLOCATED ( pbdy3dtemp2 ) ) DEALLOCATE ( pbdy3dtemp2 )
633	IF ( ALLOCATED ( qbdy3dtemp2 ) ) DEALLOCATE ( qbdy3dtemp2 )
634	!!!!***MARS >>
635	IF ( ALLOCATED ( q2bdy3dtemp2 ) ) DEALLOCATE ( q2bdy3dtemp2 )
636	IF ( ALLOCATED ( q3bdy3dtemp2 ) ) DEALLOCATE ( q3bdy3dtemp2 )
637	IF ( ALLOCATED ( q4bdy3dtemp2 ) ) DEALLOCATE ( q4bdy3dtemp2 )
638	!!!!***MARS <<
639	IF ( ALLOCATED ( mbdy2dtemp2 ) ) DEALLOCATE ( mbdy2dtemp2 )
640
641	ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
642	ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
643	ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
644	ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
645	ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
646	!!!!***MARS >>
647	ALLOCATE ( q2bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
648	ALLOCATE ( q3bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
649	ALLOCATE ( q4bdy3dtemp1(ims:ime,kms:kme,jms:jme) )
650	!!!!***MARS <<
651	ALLOCATE ( mbdy2dtemp1(ims:ime,1:1, jms:jme) )
652	ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
653	ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
654	ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
655	ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
656	ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
657	!!!!***MARS >>
658	ALLOCATE ( q2bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
659	ALLOCATE ( q3bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
660	ALLOCATE ( q4bdy3dtemp2(ims:ime,kms:kme,jms:jme) )
661	!!!!***MARS <<
662	ALLOCATE ( mbdy2dtemp2(ims:ime,1:1, jms:jme) )
663
664	! Open the wrfinput file. From this program, this is an output file.
665
666	CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
667	CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
668	IF ( ierr .NE. 0 ) THEN
669	CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
670	ENDIF
671	IF(sst_update .EQ. 1)THEN
672	CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
673	CALL open_w_dataset ( id5, TRIM(inpname) , grid , config_flags , output_aux_model_input5 , "DATASET=AUXINPUT5", ierr )
674	IF ( ierr .NE. 0 ) THEN
675	CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
676	ENDIF
677	ENDIF
678	! CALL calc_current_date ( grid%id , 0. )
679	CALL output_model_input ( id1, grid , config_flags , ierr )
680	CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
681	IF(sst_update .EQ. 1)THEN
682	CALL output_aux_model_input5 ( id5, grid , config_flags , ierr )
683	ENDIF
684
685	! We need to save the 3d data to compute a difference during the next loop. Couple the
686	! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
687
688	CALL couple ( grid%em_mu_2 , grid%em_mub , ubdy3dtemp1 , grid%em_u_2 , 'u' , grid%msfu , &
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 , vbdy3dtemp1 , grid%em_v_2 , 'v' , grid%msfv , &
691	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
692	CALL couple ( grid%em_mu_2 , grid%em_mub , tbdy3dtemp1 , grid%em_t_2 , 't' , grid%msft , &
693	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
694	CALL couple ( grid%em_mu_2 , grid%em_mub , pbdy3dtemp1 , grid%em_ph_2 , 'h' , grid%msft , &
695	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
696	! CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp1 , grid%moist(:,:,:,P_QV) , 't' , grid%msft , &
697	! ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
698
699	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
700	!!!!!MARS: si config_flags%mars != 0 il y a au moins un autre traceur (indice 2 a cause du dummy tracer)
701	!!!!!MARS: -- il faut donc definir ses conditions aux bornes
702	!!!!!MARS: -- cas generique ici, les choix de flux ou non-flux sont dans solve_em
703	!!!!!MARS: ensuite faire au cas par cas (ou un jour une boucle sur le nombre de traceurs ???) !!!q2bdy3dtemp1
704	!!!!!MARS: NB NB: si on ne veut pas passer un traceur aux bornes, tout ce qui suit n'est pas utile
705	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
706	IF (config_flags%mars .gt. 0) THEN
707	CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp1 , grid%scalar(:,:,:,2) , 't' , grid%msft , &
708	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
709	ENDIF
710	!!!!!MARS: autres possibilites. pour le moment seuls 4 traceurs aux bornes sont supportes.
711	!!!!!MARS: ... mais il est facile d'en ajouter... ajouter simplement des tableaux type q2bdy3dtemp1
712	IF ( (config_flags%mars .eq. 1) .OR. &
713	(config_flags%mars .eq. 3) .OR. &
714	(config_flags%mars .eq. 11) ) THEN
715	CALL couple ( grid%em_mu_2 , grid%em_mub , q2bdy3dtemp1 , grid%scalar(:,:,:,3) , 't' , grid%msft , &
716	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
717	ENDIF
718	IF (config_flags%mars .eq. 11) THEN
719	CALL couple ( grid%em_mu_2 , grid%em_mub , q3bdy3dtemp1 , grid%scalar(:,:,:,4) , 't' , grid%msft , &
720	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
721	CALL couple ( grid%em_mu_2 , grid%em_mub , q4bdy3dtemp1 , grid%scalar(:,:,:,5) , 't' , grid%msft , &
722	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
723	ENDIF
724	!!!!!MARS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
725
726
727
728	DO j = jps , MIN(jde-1,jpe)
729	DO i = ips , MIN(ide-1,ipe)
730	mbdy2dtemp1(i,1,j) = grid%em_mu_2(i,j)
731	END DO
732	END DO
733
734	IF(grid_fdda .EQ. 1)THEN
735	! for fdda
736	DO j = jps , jpe
737	DO k = kps , kpe
738	DO i = ips , ipe
739	grid%fdda3d(i,k,j,p_u_ndg_old) = grid%em_u_2(i,k,j)
740	grid%fdda3d(i,k,j,p_v_ndg_old) = grid%em_v_2(i,k,j)
741	grid%fdda3d(i,k,j,p_t_ndg_old) = grid%em_t_2(i,k,j)
742	grid%fdda3d(i,k,j,p_q_ndg_old) = grid%moist(i,k,j,P_QV)
743	grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%em_ph_2(i,k,j)
744	END DO
745	END DO
746	END DO
747
748	DO j = jps , jpe
749	DO i = ips , ipe
750	grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%em_mu_2(i,j)
751	END DO
752	END DO
753	ENDIF
754
755
756	! There are 2 components to the lateral boundaries. First, there is the starting
757	! point of this time period - just the outer few rows and columns.
758
759	CALL stuff_bdy ( ubdy3dtemp1 , grid%em_u_b , 'U' , ijds , ijde , spec_bdy_width , &
760	ids , ide , jds , jde , kds , kde , &
761	ims , ime , jms , jme , kms , kme , &
762	ips , ipe , jps , jpe , kps , kpe )
763	CALL stuff_bdy ( vbdy3dtemp1 , grid%em_v_b , 'V' , ijds , ijde , spec_bdy_width , &
764	ids , ide , jds , jde , kds , kde , &
765	ims , ime , jms , jme , kms , kme , &
766	ips , ipe , jps , jpe , kps , kpe )
767	CALL stuff_bdy ( tbdy3dtemp1 , grid%em_t_b , 'T' , ijds , ijde , spec_bdy_width , &
768	ids , ide , jds , jde , kds , kde , &
769	ims , ime , jms , jme , kms , kme , &
770	ips , ipe , jps , jpe , kps , kpe )
771	CALL stuff_bdy ( pbdy3dtemp1 , grid%em_ph_b , 'W' , ijds , ijde , spec_bdy_width , &
772	ids , ide , jds , jde , kds , kde , &
773	ims , ime , jms , jme , kms , kme , &
774	ips , ipe , jps , jpe , kps , kpe )
775	! CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_b(:,:,:,:,P_QV) , '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	!!!!!MARS >>
780	IF (config_flags%mars .gt. 0) THEN
781	CALL stuff_bdy ( qbdy3dtemp1 , grid%scalar_b(:,:,:,:,2) , 'T' , ijds , ijde , spec_bdy_width , &
782	ids , ide , jds , jde , kds , kde , &
783	ims , ime , jms , jme , kms , kme , &
784	ips , ipe , jps , jpe , kps , kpe )
785	ENDIF
786	IF ( (config_flags%mars .eq. 1) .OR. &
787	(config_flags%mars .eq. 3) .OR. &
788	(config_flags%mars .eq. 11) ) THEN
789	CALL stuff_bdy ( q2bdy3dtemp1 , grid%scalar_b(:,:,:,:,3) , 'T' , ijds , ijde , spec_bdy_width , &
790	ids , ide , jds , jde , kds , kde , &
791	ims , ime , jms , jme , kms , kme , &
792	ips , ipe , jps , jpe , kps , kpe )
793	ENDIF
794	IF (config_flags%mars .eq. 11) THEN
795	CALL stuff_bdy ( q3bdy3dtemp1 , grid%scalar_b(:,:,:,:,4) , 'T' , ijds , ijde , spec_bdy_width , &
796	ids , ide , jds , jde , kds , kde , &
797	ims , ime , jms , jme , kms , kme , &
798	ips , ipe , jps , jpe , kps , kpe )
799	CALL stuff_bdy ( q4bdy3dtemp1 , grid%scalar_b(:,:,:,:,5) , 'T' , ijds , ijde , spec_bdy_width , &
800	ids , ide , jds , jde , kds , kde , &
801	ims , ime , jms , jme , kms , kme , &
802	ips , ipe , jps , jpe , kps , kpe )
803	ENDIF
804	!!!!MARS <<
805
806	CALL stuff_bdy ( mbdy2dtemp1 , grid%em_mu_b , 'M' , ijds , ijde , spec_bdy_width , &
807	ids , ide , jds , jde , 1 , 1 , &
808	ims , ime , jms , jme , 1 , 1 , &
809	ips , ipe , jps , jpe , 1 , 1 )
810
811
812	ELSE IF ( loop .GT. 1 ) THEN
813
814	IF(sst_update .EQ. 1)THEN
815	CALL output_aux_model_input5 ( id5, grid , config_flags , ierr )
816	ENDIF
817
818	! Open the boundary file.
819
820
821	IF ( loop .eq. 2 ) THEN
822	IF(grid%id .eq. 1)THEN
823	CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
824	CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
825	IF ( ierr .NE. 0 ) THEN
826	CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
827	ENDIF
828	ENDIF
829	IF(grid_fdda .EQ. 1)THEN
830	! for fdda
831	CALL construct_filename1( inpname , 'wrffdda' , grid%id , 2 )
832	CALL open_w_dataset ( id2, TRIM(inpname) , grid , config_flags , output_aux_model_input10 , "DATASET=AUXINPUT10", ierr )
833	IF ( ierr .NE. 0 ) THEN
834	CALL wrf_error_fatal( 'real: error opening wrffdda for writing' )
835	ENDIF
836	ENDIF
837	ELSE
838	IF ( .NOT. domain_clockisstoptime(grid) ) THEN
839	CALL domain_clockadvance( grid )
840	CALL domain_clockprint ( 150, grid, &
841	'DEBUG assemble_output: clock after ClockAdvance,' )
842	ENDIF
843	END IF
844
845
846	! Couple this time period's data with total mu, and save it in the *bdy3dtemp2 arrays.
847
848	CALL couple ( grid%em_mu_2 , grid%em_mub , ubdy3dtemp2 , grid%em_u_2 , 'u' , grid%msfu , &
849	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
850	CALL couple ( grid%em_mu_2 , grid%em_mub , vbdy3dtemp2 , grid%em_v_2 , 'v' , grid%msfv , &
851	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
852	CALL couple ( grid%em_mu_2 , grid%em_mub , tbdy3dtemp2 , grid%em_t_2 , 't' , grid%msft , &
853	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
854	CALL couple ( grid%em_mu_2 , grid%em_mub , pbdy3dtemp2 , grid%em_ph_2 , 'h' , grid%msft , &
855	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
856	! CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp2 , grid%moist(:,:,:,P_QV) , 't' , grid%msft , &
857	! ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
858	!!!!!MARS >>
859	IF (config_flags%mars .gt. 0) THEN
860	CALL couple ( grid%em_mu_2 , grid%em_mub , qbdy3dtemp2 , grid%scalar(:,:,:,2) , 't' , grid%msft , &
861	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
862	ENDIF
863	IF ( (config_flags%mars .eq. 1) .OR. &
864	(config_flags%mars .eq. 3) .OR. &
865	(config_flags%mars .eq. 11) ) THEN
866	CALL couple ( grid%em_mu_2 , grid%em_mub , q2bdy3dtemp2 , grid%scalar(:,:,:,3) , 't' , grid%msft , &
867	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
868	ENDIF
869	IF (config_flags%mars .eq. 11) THEN
870	CALL couple ( grid%em_mu_2 , grid%em_mub , q3bdy3dtemp2 , grid%scalar(:,:,:,4) , 't' , grid%msft , &
871	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
872	CALL couple ( grid%em_mu_2 , grid%em_mub , q4bdy3dtemp2 , grid%scalar(:,:,:,5) , 't' , grid%msft , &
873	ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
874	ENDIF
875	!!!!!MARS <<
876
877	DO j = jps , jpe
878	DO i = ips , ipe
879	mbdy2dtemp2(i,1,j) = grid%em_mu_2(i,j)
880	END DO
881	END DO
882
883	IF(grid_fdda .EQ. 1)THEN
884	! for fdda
885	DO j = jps , jpe
886	DO k = kps , kpe
887	DO i = ips , ipe
888	grid%fdda3d(i,k,j,p_u_ndg_new) = grid%em_u_2(i,k,j)
889	grid%fdda3d(i,k,j,p_v_ndg_new) = grid%em_v_2(i,k,j)
890	grid%fdda3d(i,k,j,p_t_ndg_new) = grid%em_t_2(i,k,j)
891	grid%fdda3d(i,k,j,p_q_ndg_new) = grid%moist(i,k,j,P_QV)
892	grid%fdda3d(i,k,j,p_ph_ndg_new) = grid%em_ph_2(i,k,j)
893	END DO
894	END DO
895	END DO
896
897	DO j = jps , jpe
898	DO i = ips , ipe
899	grid%fdda2d(i,1,j,p_mu_ndg_new) = grid%em_mu_2(i,j)
900	END DO
901	END DO
902	ENDIF
903
904	! During all of the loops after the first loop, we first compute the boundary
905	! tendencies with the current data values (*bdy3dtemp2 arrays) and the previously
906	! saved information stored in the *bdy3dtemp1 arrays.
907
908	CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds) , grid%em_u_bt , 'U' , &
909	ijds , ijde , spec_bdy_width , &
910	ids , ide , jds , jde , kds , kde , &
911	ims , ime , jms , jme , kms , kme , &
912	ips , ipe , jps , jpe , kps , kpe )
913	CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds) , grid%em_v_bt , 'V' , &
914	ijds , ijde , spec_bdy_width , &
915	ids , ide , jds , jde , kds , kde , &
916	ims , ime , jms , jme , kms , kme , &
917	ips , ipe , jps , jpe , kps , kpe )
918	CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds) , grid%em_t_bt , '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	CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , REAL(interval_seconds) , grid%em_ph_bt , 'W' , &
924	ijds , ijde , spec_bdy_width , &
925	ids , ide , jds , jde , kds , kde , &
926	ims , ime , jms , jme , kms , kme , &
927	ips , ipe , jps , jpe , kps , kpe )
928	! CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , grid%moist_bt(:,:,:,:,P_QV) , 'T' , &
929	! ijds , ijde , spec_bdy_width , &
930	! ids , ide , jds , jde , kds , kde , &
931	! ims , ime , jms , jme , kms , kme , &
932	! ips , ipe , jps , jpe , kps , kpe )
933	!!!!!MARS >>
934	IF (config_flags%mars .gt. 0) THEN
935	CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,2) , 'T' , &
936	ijds , ijde , spec_bdy_width , &
937	ids , ide , jds , jde , kds , kde , &
938	ims , ime , jms , jme , kms , kme , &
939	ips , ipe , jps , jpe , kps , kpe )
940	ENDIF
941	IF ( (config_flags%mars .eq. 1) .OR. &
942	(config_flags%mars .eq. 3) .OR. &
943	(config_flags%mars .eq. 11) ) THEN
944	CALL stuff_bdytend ( q2bdy3dtemp2 , q2bdy3dtemp1 , REAL(interval_seconds) ,grid%scalar_bt(:,:,:,:,3) , 'T' , &
945	ijds , ijde , spec_bdy_width , &
946	ids , ide , jds , jde , kds , kde , &
947	ims , ime , jms , jme , kms , kme , &
948	ips , ipe , jps , jpe , kps , kpe )
949	ENDIF
950	IF (config_flags%mars .eq. 11) THEN
951	CALL stuff_bdytend ( q3bdy3dtemp2 , q3bdy3dtemp1 , REAL(interval_seconds) , grid%scalar_bt(:,:,:,:,4) , 'T' , &
952	ijds , ijde , spec_bdy_width , &
953	ids , ide , jds , jde , kds , kde , &
954	ims , ime , jms , jme , kms , kme , &
955	ips , ipe , jps , jpe , kps , kpe )
956	CALL stuff_bdytend ( q4bdy3dtemp2 , q4bdy3dtemp1 , REAL(interval_seconds) ,grid%scalar_bt(:,:,:,:,5) , 'T' , &
957	ijds , ijde , 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	ENDIF
962	!!!!!MARS <<
963
964	CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , REAL(interval_seconds) , grid%em_mu_bt , 'M' , &
965	ijds , ijde , 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
970	! Both pieces of the boundary data are now available to be written (initial time and tendency).
971	! This looks ugly, these date shifting things. What's it for? We want the "Times" variable
972	! in the lateral BDY file to have the valid times of when the initial fields are written.
973	! That's what the loop-2 thingy is for with the start date. We increment the start_date so
974	! that the starting time in the attributes is the second time period. Why you may ask. I
975	! agree, why indeed.
976
977	CALL domain_clockprint ( 150, grid, &
978	'DEBUG assemble_output: clock before 1st current_date set,' )
979	WRITE (wrf_err_message,*) &
980	'DEBUG assemble_output: before 1st currTime set, current_date = ',TRIM(current_date)
981	CALL wrf_debug ( 150 , wrf_err_message )
982	CALL domain_clock_set( grid, current_date(1:19) )
983	CALL domain_clockprint ( 150, grid, &
984	'DEBUG assemble_output: clock after 1st current_date set,' )
985
986	temp24= current_date
987	temp24b=start_date
988	start_date = current_date
989	CALL geth_newdate ( temp19 , temp24b(1:19) , (loop-2) * model_config_rec%interval_seconds )
990	current_date = temp19 // '.0000'
991	CALL domain_clockprint ( 150, grid, &
992	'DEBUG assemble_output: clock before 2nd current_date set,' )
993	WRITE (wrf_err_message,*) &
994	'DEBUG assemble_output: before 2nd currTime set, current_date = ',TRIM(current_date)
995	CALL wrf_debug ( 150 , wrf_err_message )
996	CALL domain_clock_set( grid, current_date(1:19) )
997	CALL domain_clockprint ( 150, grid, &
998	'DEBUG assemble_output: clock after 2nd current_date set,' )
999	IF(grid%id .EQ. 1)THEN
1000	print *,'LBC valid between these times ',current_date, ' ',start_date
1001	CALL output_boundary ( id, grid , config_flags , ierr )
1002	ENDIF
1003	! for fdda
1004	IF(grid_fdda .EQ. 1) THEN
1005	CALL output_aux_model_input10 ( id2, grid , config_flags , ierr )
1006	END IF
1007	current_date = temp24
1008	start_date = temp24b
1009	CALL domain_clockprint ( 150, grid, &
1010	'DEBUG assemble_output: clock before 3rd current_date set,' )
1011	WRITE (wrf_err_message,*) &
1012	'DEBUG assemble_output: before 3rd currTime set, current_date = ',TRIM(current_date)
1013	CALL wrf_debug ( 150 , wrf_err_message )
1014	CALL domain_clock_set( grid, current_date(1:19) )
1015	CALL domain_clockprint ( 150, grid, &
1016	'DEBUG assemble_output: clock after 3rd current_date set,' )
1017
1018	! OK, for all of the loops, we output the initialzation data, which would allow us to
1019	! start the model at any of the available analysis time periods.
1020
1021	! WRITE ( loop_char , FMT = '(I4.4)' ) loop
1022	! CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
1023	! IF ( ierr .NE. 0 ) THEN
1024	! CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
1025	! ENDIF
1026
1027	! CALL calc_current_date ( grid%id , 0. )
1028	! CALL output_model_input ( id1, grid , config_flags , ierr )
1029	! CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
1030	! Is this or is this not the last time time? We can remove some unnecessary
1031	! stores if it is not.
1032	IF ( loop .LT. time_loop_max ) THEN
1033
1034	! We need to save the 3d data to compute a difference during the next loop. Couple the
1035	! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
1036	! We load up the boundary data again for use in the next loop.
1037
1038	DO j = jps , jpe
1039	DO k = kps , kpe
1040	DO i = ips , ipe
1041	ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
1042	vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
1043	tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
1044	pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
1045	qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
1046	!!!!MARS >>
1047	q2bdy3dtemp1(i,k,j) = q2bdy3dtemp2(i,k,j)
1048	q3bdy3dtemp1(i,k,j) = q3bdy3dtemp2(i,k,j)
1049	q4bdy3dtemp1(i,k,j) = q4bdy3dtemp2(i,k,j)
1050	!!!!MARS <<
1051	END DO
1052	END DO
1053	END DO
1054
1055	DO j = jps , jpe
1056	DO i = ips , ipe
1057	mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
1058	END DO
1059	END DO
1060
1061	IF(grid_fdda .EQ. 1)THEN
1062	! for fdda
1063	DO j = jps , jpe
1064	DO k = kps , kpe
1065	DO i = ips , ipe
1066	grid%fdda3d(i,k,j,p_u_ndg_old) = grid%fdda3d(i,k,j,p_u_ndg_new)
1067	grid%fdda3d(i,k,j,p_v_ndg_old) = grid%fdda3d(i,k,j,p_v_ndg_new)
1068	grid%fdda3d(i,k,j,p_t_ndg_old) = grid%fdda3d(i,k,j,p_t_ndg_new)
1069	grid%fdda3d(i,k,j,p_q_ndg_old) = grid%fdda3d(i,k,j,p_q_ndg_new)
1070	grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%fdda3d(i,k,j,p_ph_ndg_new)
1071	END DO
1072	END DO
1073	END DO
1074
1075	DO j = jps , jpe
1076	DO i = ips , ipe
1077	grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%fdda2d(i,1,j,p_mu_ndg_new)
1078	END DO
1079	END DO
1080	ENDIF
1081
1082	! There are 2 components to the lateral boundaries. First, there is the starting
1083	! point of this time period - just the outer few rows and columns.
1084
1085	CALL stuff_bdy ( ubdy3dtemp1 , grid%em_u_b , 'U' , ijds , ijde , spec_bdy_width , &
1086	ids , ide , jds , jde , kds , kde , &
1087	ims , ime , jms , jme , kms , kme , &
1088	ips , ipe , jps , jpe , kps , kpe )
1089	CALL stuff_bdy ( vbdy3dtemp1 , grid%em_v_b , 'V' , ijds , ijde , spec_bdy_width , &
1090	ids , ide , jds , jde , kds , kde , &
1091	ims , ime , jms , jme , kms , kme , &
1092	ips , ipe , jps , jpe , kps , kpe )
1093	CALL stuff_bdy ( tbdy3dtemp1 , grid%em_t_b , 'T' , ijds , ijde , spec_bdy_width , &
1094	ids , ide , jds , jde , kds , kde , &
1095	ims , ime , jms , jme , kms , kme , &
1096	ips , ipe , jps , jpe , kps , kpe )
1097	CALL stuff_bdy ( pbdy3dtemp1 , grid%em_ph_b , 'W' , ijds , ijde , spec_bdy_width , &
1098	ids , ide , jds , jde , kds , kde , &
1099	ims , ime , jms , jme , kms , kme , &
1100	ips , ipe , jps , jpe , kps , kpe )
1101	! CALL stuff_bdy ( qbdy3dtemp1 , grid%moist_b(:,:,:,:,P_QV) , 'T' , ijds , ijde , spec_bdy_width , &
1102	! ids , ide , jds , jde , kds , kde , &
1103	! ims , ime , jms , jme , kms , kme , &
1104	! ips , ipe , jps , jpe , kps , kpe )
1105	!!!!!MARS >>
1106	IF (config_flags%mars .gt. 0) THEN
1107	CALL stuff_bdy ( qbdy3dtemp1 , grid%scalar_b(:,:,:,:,2) , 'T', ijds , ijde , spec_bdy_width , &
1108	ids , ide , jds , jde , kds , kde , &
1109	ims , ime , jms , jme , kms , kme , &
1110	ips , ipe , jps , jpe , kps , kpe )
1111	ENDIF
1112	IF ( (config_flags%mars .eq. 1) .OR. &
1113	(config_flags%mars .eq. 3) .OR. &
1114	(config_flags%mars .eq. 11) ) THEN
1115	CALL stuff_bdy ( q2bdy3dtemp1 , grid%scalar_b(:,:,:,:,3) , 'T', ijds , ijde , spec_bdy_width , &
1116	ids , ide , jds , jde , kds , kde , &
1117	ims , ime , jms , jme , kms , kme , &
1118	ips , ipe , jps , jpe , kps , kpe )
1119	ENDIF
1120	IF (config_flags%mars .eq. 11) THEN
1121	CALL stuff_bdy ( q3bdy3dtemp1 , grid%scalar_b(:,:,:,:,4) , 'T', ijds , ijde , spec_bdy_width , &
1122	ids , ide , jds , jde , kds , kde , &
1123	ims , ime , jms , jme , kms , kme , &
1124	ips , ipe , jps , jpe , kps , kpe )
1125	CALL stuff_bdy ( q4bdy3dtemp1 , grid%scalar_b(:,:,:,:,5) , 'T', ijds , ijde , spec_bdy_width , &
1126	ids , ide , jds , jde , kds , kde , &
1127	ims , ime , jms , jme , kms , kme , &
1128	ips , ipe , jps , jpe , kps , kpe )
1129	ENDIF
1130	!!!!MARS <<
1131	CALL stuff_bdy ( mbdy2dtemp1 , grid%em_mu_b , 'M' , ijds , ijde , spec_bdy_width , &
1132	ids , ide , jds , jde , 1 , 1 , &
1133	ims , ime , jms , jme , 1 , 1 , &
1134	ips , ipe , jps , jpe , 1 , 1 )
1135
1136	ELSE IF ( loop .EQ. time_loop_max ) THEN
1137
1138	! If this is the last time through here, we need to close the files.
1139
1140	IF(grid%id .EQ. 1)CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1141	IF(grid_fdda .EQ. 1)CALL close_dataset ( id2 , config_flags , "DATASET=AUXINPUT10" )
1142	IF(sst_update .EQ. 1)THEN
1143	CALL close_dataset ( id5 , config_flags , "DATASET=AUXINPUT5" )
1144	ENDIF
1145
1146	END IF
1147
1148	END IF
1149
1150	END SUBROUTINE assemble_output

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

Download in other formats:

Original Format