Context Navigation

module_physics_addtendc.F @ 3667

Last change on this file since 3667 was 94, checked in by aslmd, 15 years ago

LMD_MM_MARS et LMD_LES_MARS:

routines physique terrestres commentees dans WRF
pour accelerer la compilation des sources dans le cas martien
--> la premiere compilation est toujours un peu longue, mais les recompilations sont desormais plus rapides
--> les executables sont plus legers (passe de 15-20 Mo a 5-10 Mo)
--> bien que les .F soient presents, la plupart des routines de phys/ ne sont plus compilees
--> regle le bug avec certaines routines dans le cas de g95

NB: verifie sur LMD_MM_MARS
NB: a confirmer sur LMD_LES_MARS

Routines modifiees:

M 93 mesoscale/LMD_LES_MARS/modif_mars/module_first_rk_step_part2.F
M 93 mesoscale/LMD_LES_MARS/modif_mars/solve_em.F
A 0 mesoscale/LMD_LES_MARS/modif_mars/module_physics_init.F
M 93 mesoscale/LMD_LES_MARS/modif_mars/module_physics_addtendc.F
A 0 mesoscale/LMD_LES_MARS/modif_mars/Makefile_dyn_em
M 93 mesoscale/LMD_LES_MARS/modif_mars/Makefile
M 93 mesoscale/LMD_LES_MARS/modif_mars/module_first_rk_step_part1.F
M 93 mesoscale/LMD_LES_MARS/LMD_LES_MARS_install
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/Makefile
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/solve_em.F
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/Makefile
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_lmd_driver.F
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_physics_init.F
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_physics_addtendc.F

File size: 46.5 KB

Line
1	!WRF:MODEL_LAYER: PHYSICS
2	!
3	! note: this module really belongs in the dyn_em directory since it is
4	! specific only to the EM core. Leaving here for now, with an
5	! #if ( EM_CORE == 1 ) directive. JM 20031201
6	!
7
8	! This MODULE holds the routines which are used to perform updates of the
9	! model C-grid tendencies with physics A-grid tendencies
10	! The module consolidates code that was (up to v1.2) duplicated in
11	! module_em and module_rk and in
12	! module_big_step_utilities.F and module_big_step_utilities_em.F
13
14	! This MODULE CONTAINS the following routines:
15	! update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt,
16	! add_a2a, add_a2c_u, and add_a2c_v
17
18
19	MODULE module_physics_addtendc
20
21	#if ( EM_CORE == 1 )
22
23	USE module_state_description
24	USE module_configure
25
26	CONTAINS
27
28	SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
29	mu_tendf, &
30	RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN, &
31	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
32	RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,&
33	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN, &
34	RMUNDGDTEN, &
35	n_moist,config_flags,rk_step, &
36	ids, ide, jds, jde, kds, kde, &
37	ims, ime, jms, jme, kms, kme, &
38	its, ite, jts, jte, kts, kte )
39	!-------------------------------------------------------------------
40	IMPLICIT NONE
41	!-------------------------------------------------------------------
42
43	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
44
45	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
46	ims, ime, jms, jme, kms, kme, &
47	its, ite, jts, jte, kts, kte, &
48	n_moist,rk_step
49
50	REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: &
51	ru_tendf, &
52	rv_tendf, &
53	rt_tendf
54
55	REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf
56
57	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
58	INTENT(INOUT) :: moist_tendf
59
60	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
61	RTHRATEN, &
62	RTHBLTEN, &
63	RTHCUTEN, &
64	RUBLTEN, &
65	RVBLTEN, &
66	RQVBLTEN, &
67	RQCBLTEN, &
68	RQIBLTEN, &
69	RQVCUTEN, &
70	RQCCUTEN, &
71	RQRCUTEN, &
72	RQICUTEN, &
73	RQSCUTEN, &
74	RTHNDGDTEN, &
75	RQVNDGDTEN, &
76	RUNDGDTEN, &
77	RVNDGDTEN
78
79	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
80	!------------------------------------------------------------------
81
82	! set up loop bounds for this grid's boundary conditions
83
84
85	if (config_flags%ra_lw_physics .gt. 0 .or. &
86	config_flags%ra_sw_physics .gt. 0) &
87	CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
88	ids, ide, jds, jde, kds, kde, &
89	ims, ime, jms, jme, kms, kme, &
90	its, ite, jts, jte, kts, kte )
91
92
93	!****MARS
94	! - All the LMD physics packages provide one tendency in the WRF sense
95	! - PBL was chosen for practical reasons (U+V+T)
96	! - The tendencies are supposed to be A-gridded
97	if ( (config_flags%bl_pbl_physics .gt. 0) &
98	.OR. (config_flags%modif_wrf) ) &
99	CALL phy_bl_ten(config_flags,rk_step,n_moist, &
100	rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
101	RTHBLTEN,RUBLTEN,RVBLTEN, &
102	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
103	ids, ide, jds, jde, kds, kde, &
104	ims, ime, jms, jme, kms, kme, &
105	its, ite, jts, jte, kts, kte )
106
107	if (config_flags%cu_physics .gt. 0) &
108	CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, &
109	RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
110	RQICUTEN,RQSCUTEN,moist_tendf, &
111	ids, ide, jds, jde, kds, kde, &
112	ims, ime, jms, jme, kms, kme, &
113	its, ite, jts, jte, kts, kte )
114	if (config_flags%grid_fdda .gt. 0) &
115	CALL phy_fg_ten(config_flags,rk_step,n_moist, &
116	rt_tendf,ru_tendf,rv_tendf, &
117	mu_tendf, moist_tendf, &
118	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
119	RQVNDGDTEN,RMUNDGDTEN, &
120	ids, ide, jds, jde, kds, kde, &
121	ims, ime, jms, jme, kms, kme, &
122	its, ite, jts, jte, kts, kte )
123
124	END SUBROUTINE update_phy_ten
125
126	!=================================================================
127	SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
128	ids, ide, jds, jde, kds, kde, &
129	ims, ime, jms, jme, kms, kme, &
130	its, ite, jts, jte, kts, kte )
131	!-----------------------------------------------------------------
132	IMPLICIT NONE
133	!-----------------------------------------------------------------
134	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
135
136	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
137	ims, ime, jms, jme, kms, kme, &
138	its, ite, jts, jte, kts, kte
139
140	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
141	RTHRATEN
142
143	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
144	rt_tendf
145
146	! LOCAL VARS
147
148	INTEGER :: i,j,k
149
150	CALL add_a2a(rt_tendf,RTHRATEN,config_flags, &
151	ids,ide, jds, jde, kds, kde, &
152	ims, ime, jms, jme, kms, kme, &
153	its, ite, jts, jte, kts, kte )
154
155	END SUBROUTINE phy_ra_ten
156
157	!=================================================================
158	SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist, &
159	rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
160	RTHBLTEN,RUBLTEN,RVBLTEN, &
161	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
162	ids, ide, jds, jde, kds, kde, &
163	ims, ime, jms, jme, kms, kme, &
164	its, ite, jts, jte, kts, kte )
165	!-----------------------------------------------------------------
166	IMPLICIT NONE
167	!-----------------------------------------------------------------
168	TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
169
170	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
171	ims, ime, jms, jme, kms, kme, &
172	its, ite, jts, jte, kts, kte, &
173	n_moist, rk_step
174
175	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
176	INTENT(INOUT) :: moist_tendf
177
178	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
179	RTHBLTEN, &
180	RUBLTEN, &
181	RVBLTEN, &
182	RQVBLTEN, &
183	RQCBLTEN, &
184	RQIBLTEN
185
186	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
187	rt_tendf, &
188	ru_tendf, &
189	rv_tendf
190	! LOCAL VARS
191
192	INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
193
194	!-----------------------------------------------------------------
195
196
197	!****MARS
198	!****MARS
199	!update with LMD physics tendencies
200	if (config_flags%modif_wrf) then
201	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
202	ids,ide, jds, jde, kds, kde, &
203	ims, ime, jms, jme, kms, kme, &
204	its, ite, jts, jte, kts, kte )
205	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
206	ids,ide, jds, jde, kds, kde, &
207	ims, ime, jms, jme, kms, kme, &
208	its, ite, jts, jte, kts, kte )
209	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
210	ids,ide, jds, jde, kds, kde, &
211	ims, ime, jms, jme, kms, kme, &
212	its, ite, jts, jte, kts, kte )
213	endif
214	!****MARS
215	!****MARS
216
217
218	SELECT CASE(config_flags%bl_pbl_physics)
219
220	CASE (YSUSCHEME)
221
222	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
223	ids,ide, jds, jde, kds, kde, &
224	ims, ime, jms, jme, kms, kme, &
225	its, ite, jts, jte, kts, kte )
226
227	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
228	ids,ide, jds, jde, kds, kde, &
229	ims, ime, jms, jme, kms, kme, &
230	its, ite, jts, jte, kts, kte )
231
232	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
233	ids,ide, jds, jde, kds, kde, &
234	ims, ime, jms, jme, kms, kme, &
235	its, ite, jts, jte, kts, kte )
236
237	if (P_QV .ge. PARAM_FIRST_SCALAR) &
238	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
239	config_flags, &
240	ids,ide, jds, jde, kds, kde, &
241	ims, ime, jms, jme, kms, kme, &
242	its, ite, jts, jte, kts, kte )
243
244	if (P_QC .ge. PARAM_FIRST_SCALAR) &
245	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
246	config_flags, &
247	ids,ide, jds, jde, kds, kde, &
248	ims, ime, jms, jme, kms, kme, &
249	its, ite, jts, jte, kts, kte )
250
251	if (P_QI .ge. PARAM_FIRST_SCALAR) &
252	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
253	config_flags, &
254	ids,ide, jds, jde, kds, kde, &
255	ims, ime, jms, jme, kms, kme, &
256	its, ite, jts, jte, kts, kte )
257
258	CASE (MRFSCHEME)
259
260	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
261	ids,ide, jds, jde, kds, kde, &
262	ims, ime, jms, jme, kms, kme, &
263	its, ite, jts, jte, kts, kte )
264
265	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
266	ids,ide, jds, jde, kds, kde, &
267	ims, ime, jms, jme, kms, kme, &
268	its, ite, jts, jte, kts, kte )
269
270	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
271	ids,ide, jds, jde, kds, kde, &
272	ims, ime, jms, jme, kms, kme, &
273	its, ite, jts, jte, kts, kte )
274
275	if (P_QV .ge. PARAM_FIRST_SCALAR) &
276	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
277	config_flags, &
278	ids,ide, jds, jde, kds, kde, &
279	ims, ime, jms, jme, kms, kme, &
280	its, ite, jts, jte, kts, kte )
281
282	if (P_QC .ge. PARAM_FIRST_SCALAR) &
283	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
284	config_flags, &
285	ids,ide, jds, jde, kds, kde, &
286	ims, ime, jms, jme, kms, kme, &
287	its, ite, jts, jte, kts, kte )
288
289	if (P_QI .ge. PARAM_FIRST_SCALAR) &
290	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
291	config_flags, &
292	ids,ide, jds, jde, kds, kde, &
293	ims, ime, jms, jme, kms, kme, &
294	its, ite, jts, jte, kts, kte )
295
296	CASE (MYJPBLSCHEME)
297
298	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
299	ids,ide, jds, jde, kds, kde, &
300	ims, ime, jms, jme, kms, kme, &
301	its, ite, jts, jte, kts, kte )
302
303	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
304	ids,ide, jds, jde, kds, kde, &
305	ims, ime, jms, jme, kms, kme, &
306	its, ite, jts, jte, kts, kte )
307
308	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
309	ids,ide, jds, jde, kds, kde, &
310	ims, ime, jms, jme, kms, kme, &
311	its, ite, jts, jte, kts, kte )
312
313	if (P_QV .ge. PARAM_FIRST_SCALAR) &
314	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
315	config_flags, &
316	ids,ide, jds, jde, kds, kde, &
317	ims, ime, jms, jme, kms, kme, &
318	its, ite, jts, jte, kts, kte )
319
320	CASE (GFSSCHEME)
321
322	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
323	ids,ide, jds, jde, kds, kde, &
324	ims, ime, jms, jme, kms, kme, &
325	its, ite, jts, jte, kts, kte )
326
327	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
328	ids,ide, jds, jde, kds, kde, &
329	ims, ime, jms, jme, kms, kme, &
330	its, ite, jts, jte, kts, kte )
331
332	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
333	ids,ide, jds, jde, kds, kde, &
334	ims, ime, jms, jme, kms, kme, &
335	its, ite, jts, jte, kts, kte )
336
337	if (P_QV .ge. PARAM_FIRST_SCALAR) &
338	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
339	config_flags, &
340	ids,ide, jds, jde, kds, kde, &
341	ims, ime, jms, jme, kms, kme, &
342	its, ite, jts, jte, kts, kte )
343
344	if (P_QC .ge. PARAM_FIRST_SCALAR) &
345	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
346	config_flags, &
347	ids,ide, jds, jde, kds, kde, &
348	ims, ime, jms, jme, kms, kme, &
349	its, ite, jts, jte, kts, kte )
350
351	if (P_QI .ge. PARAM_FIRST_SCALAR) &
352	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
353	config_flags, &
354	ids,ide, jds, jde, kds, kde, &
355	ims, ime, jms, jme, kms, kme, &
356	its, ite, jts, jte, kts, kte )
357	CASE DEFAULT
358
359	!print*,'phy_bl_ten: The pbl scheme does not exist'
360
361	END SELECT
362
363	END SUBROUTINE phy_bl_ten
364
365	!=================================================================
366	SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, &
367	RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
368	RQICUTEN,RQSCUTEN,moist_tendf, &
369	ids, ide, jds, jde, kds, kde, &
370	ims, ime, jms, jme, kms, kme, &
371	its, ite, jts, jte, kts, kte )
372	!-----------------------------------------------------------------
373	IMPLICIT NONE
374	!-----------------------------------------------------------------
375	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
376
377	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
378	ims, ime, jms, jme, kms, kme, &
379	its, ite, jts, jte, kts, kte, &
380	n_moist, rk_step
381
382	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
383	INTENT(INOUT) :: moist_tendf
384
385	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
386	RTHCUTEN, &
387	RQVCUTEN, &
388	RQCCUTEN, &
389	RQRCUTEN, &
390	RQICUTEN, &
391	RQSCUTEN
392
393	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
394	rt_tendf
395
396	! LOCAL VARS
397
398	INTEGER :: i,j,k
399
400	SELECT CASE (config_flags%cu_physics)
401
402	CASE (KFSCHEME)
403	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
404	ids,ide, jds, jde, kds, kde, &
405	ims, ime, jms, jme, kms, kme, &
406	its, ite, jts, jte, kts, kte )
407
408	if (P_QV .ge. PARAM_FIRST_SCALAR) &
409	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
410	config_flags, &
411	ids,ide, jds, jde, kds, kde, &
412	ims, ime, jms, jme, kms, kme, &
413	its, ite, jts, jte, kts, kte )
414
415	if (P_QC .ge. PARAM_FIRST_SCALAR) &
416	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
417	config_flags, &
418	ids,ide, jds, jde, kds, kde, &
419	ims, ime, jms, jme, kms, kme, &
420	its, ite, jts, jte, kts, kte )
421
422	if (P_QR .ge. PARAM_FIRST_SCALAR) &
423	CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
424	config_flags, &
425	ids,ide, jds, jde, kds, kde, &
426	ims, ime, jms, jme, kms, kme, &
427	its, ite, jts, jte, kts, kte )
428
429	if (P_QI .ge. PARAM_FIRST_SCALAR) &
430	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
431	config_flags, &
432	ids,ide, jds, jde, kds, kde, &
433	ims, ime, jms, jme, kms, kme, &
434	its, ite, jts, jte, kts, kte )
435
436	if (P_QS .ge. PARAM_FIRST_SCALAR) &
437	CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
438	config_flags, &
439	ids,ide, jds, jde, kds, kde, &
440	ims, ime, jms, jme, kms, kme, &
441	its, ite, jts, jte, kts, kte )
442
443	CASE (BMJSCHEME)
444	CALL add_a2a(rt_tendf,RTHCUTEN, &
445	config_flags, &
446	ids,ide, jds, jde, kds, kde, &
447	ims, ime, jms, jme, kms, kme, &
448	its, ite, jts, jte, kts, kte )
449
450	if (P_QV .ge. PARAM_FIRST_SCALAR) &
451	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
452	config_flags, &
453	ids,ide, jds, jde, kds, kde, &
454	ims, ime, jms, jme, kms, kme, &
455	its, ite, jts, jte, kts, kte )
456
457	CASE (KFETASCHEME)
458	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
459	ids,ide, jds, jde, kds, kde, &
460	ims, ime, jms, jme, kms, kme, &
461	its, ite, jts, jte, kts, kte )
462
463	if (P_QV .ge. PARAM_FIRST_SCALAR) &
464	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
465	config_flags, &
466	ids,ide, jds, jde, kds, kde, &
467	ims, ime, jms, jme, kms, kme, &
468	its, ite, jts, jte, kts, kte )
469
470	if (P_QC .ge. PARAM_FIRST_SCALAR) &
471	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
472	config_flags, &
473	ids,ide, jds, jde, kds, kde, &
474	ims, ime, jms, jme, kms, kme, &
475	its, ite, jts, jte, kts, kte )
476
477	if (P_QR .ge. PARAM_FIRST_SCALAR) &
478	CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
479	config_flags, &
480	ids,ide, jds, jde, kds, kde, &
481	ims, ime, jms, jme, kms, kme, &
482	its, ite, jts, jte, kts, kte )
483
484	if (P_QI .ge. PARAM_FIRST_SCALAR) &
485	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
486	config_flags, &
487	ids,ide, jds, jde, kds, kde, &
488	ims, ime, jms, jme, kms, kme, &
489	its, ite, jts, jte, kts, kte )
490
491	if (P_QS .ge. PARAM_FIRST_SCALAR) &
492	CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
493	config_flags, &
494	ids,ide, jds, jde, kds, kde, &
495	ims, ime, jms, jme, kms, kme, &
496	its, ite, jts, jte, kts, kte )
497
498	CASE (GDSCHEME)
499	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
500	ids,ide, jds, jde, kds, kde, &
501	ims, ime, jms, jme, kms, kme, &
502	its, ite, jts, jte, kts, kte )
503
504	if (P_QV .ge. PARAM_FIRST_SCALAR) &
505	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
506	config_flags, &
507	ids,ide, jds, jde, kds, kde, &
508	ims, ime, jms, jme, kms, kme, &
509	its, ite, jts, jte, kts, kte )
510
511	if (P_QC .ge. PARAM_FIRST_SCALAR) &
512	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
513	config_flags, &
514	ids,ide, jds, jde, kds, kde, &
515	ims, ime, jms, jme, kms, kme, &
516	its, ite, jts, jte, kts, kte )
517
518	if (P_QI .ge. PARAM_FIRST_SCALAR) &
519	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
520	config_flags, &
521	ids,ide, jds, jde, kds, kde, &
522	ims, ime, jms, jme, kms, kme, &
523	its, ite, jts, jte, kts, kte )
524
525	CASE (SASSCHEME)
526	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
527	ids,ide, jds, jde, kds, kde, &
528	ims, ime, jms, jme, kms, kme, &
529	its, ite, jts, jte, kts, kte )
530
531	if (P_QV .ge. PARAM_FIRST_SCALAR) &
532	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
533	config_flags, &
534	ids,ide, jds, jde, kds, kde, &
535	ims, ime, jms, jme, kms, kme, &
536	its, ite, jts, jte, kts, kte )
537
538	if (P_QC .ge. PARAM_FIRST_SCALAR) &
539	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
540	config_flags, &
541	ids,ide, jds, jde, kds, kde, &
542	ims, ime, jms, jme, kms, kme, &
543	its, ite, jts, jte, kts, kte )
544
545	if (P_QI .ge. PARAM_FIRST_SCALAR) &
546	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
547	config_flags, &
548	ids,ide, jds, jde, kds, kde, &
549	ims, ime, jms, jme, kms, kme, &
550	its, ite, jts, jte, kts, kte )
551
552	CASE DEFAULT
553
554	END SELECT
555
556	END SUBROUTINE phy_cu_ten
557
558	!=================================================================
559	SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, &
560	rt_tendf,ru_tendf,rv_tendf, &
561	mu_tendf, moist_tendf, &
562	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
563	RQVNDGDTEN,RMUNDGDTEN, &
564	ids, ide, jds, jde, kds, kde, &
565	ims, ime, jms, jme, kms, kme, &
566	its, ite, jts, jte, kts, kte )
567	!-----------------------------------------------------------------
568	IMPLICIT NONE
569	!-----------------------------------------------------------------
570	TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
571
572	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
573	ims, ime, jms, jme, kms, kme, &
574	its, ite, jts, jte, kts, kte, &
575	n_moist, rk_step
576
577	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
578	INTENT(INOUT) :: moist_tendf
579
580	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
581	RTHNDGDTEN, &
582	RUNDGDTEN, &
583	RVNDGDTEN, &
584	RQVNDGDTEN
585
586	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
587
588	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
589	rt_tendf, &
590	ru_tendf, &
591	rv_tendf
592
593	REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
594
595	! LOCAL VARS
596
597	INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
598
599	!-----------------------------------------------------------------
600
601	SELECT CASE(config_flags%grid_fdda)
602
603	CASE (PSUFDDAGD)
604
605	CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
606	ids,ide, jds, jde, kds, kde, &
607	ims, ime, jms, jme, kms, kme, &
608	its, ite, jts, jte, kts, kte )
609
610	! note fdda u and v tendencies are staggered
611	CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
612	ids,ide, jds, jde, kds, kde, &
613	ims, ime, jms, jme, kms, kme, &
614	its, ite, jts, jte, kts, kte )
615
616	CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
617	ids,ide, jds, jde, kds, kde, &
618	ims, ime, jms, jme, kms, kme, &
619	its, ite, jts, jte, kts, kte )
620
621	CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, &
622	ids,ide, jds, jde, kds, kds, &
623	ims, ime, jms, jme, kms, kms, &
624	its, ite, jts, jte, kts, kts )
625
626	if (P_QV .ge. PARAM_FIRST_SCALAR) &
627	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, &
628	config_flags, &
629	ids,ide, jds, jde, kds, kde, &
630	ims, ime, jms, jme, kms, kme, &
631	its, ite, jts, jte, kts, kte )
632
633
634	CASE DEFAULT
635
636	END SELECT
637
638	END SUBROUTINE phy_fg_ten
639
640	!----------------------------------------------------------------------
641	SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
642	RQICUTEN,RQSCUTEN,RAINC,RAINCV,NCA, &
643	HTOP,HBOT,CUTOP,CUBOT, &
644	CUPPT, config_flags, &
645	ids,ide, jds,jde, kds,kde, &
646	ims,ime, jms,jme, kms,kme, &
647	its,ite, jts,jte, kts,kte )
648	!----------------------------------------------------------------------
649	USE module_state_description
650
651	!!!******MARS MARS
652	!!!******MARS MARS
653	!!!******MARS MARS
654
655	! USE module_cu_kf
656	! USE module_cu_kfeta
657	!----------------------------------------------------------------------
658	IMPLICIT NONE
659	!----------------------------------------------------------------------
660	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
661
662	INTEGER, INTENT(IN ) :: &
663	ids,ide, jds,jde, kds,kde, &
664	ims,ime, jms,jme, kms,kme, &
665	its,ite, jts,jte, kts,kte
666
667
668	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
669	INTENT(INOUT) :: RTHCUTEN, &
670	RQVCUTEN, &
671	RQCCUTEN, &
672	RQRCUTEN, &
673	RQICUTEN, &
674	RQSCUTEN
675
676	REAL, DIMENSION( ims:ime , jms:jme ), &
677	INTENT(INOUT) :: RAINC, &
678	RAINCV, &
679	NCA, &
680	HTOP, &
681	HBOT, &
682	CUTOP, &
683	CUBOT, &
684	CUPPT
685
686	! LOCAL VAR
687
688	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
689	INTEGER :: NCUTOP, NCUBOT
690
691	!-----------------------------------------------------------------
692
693	IF (config_flags%cu_physics .eq. 0) return
694
695	! SET START AND END POINTS FOR TILES
696
697	i_start = its
698	i_end = min( ite,ide-1 )
699	j_start = jts
700	j_end = min( jte,jde-1 )
701	!
702	! IF( config_flags%nested .or. config_flags%specified ) THEN
703	! i_start = max( its,ids+1 )
704	! i_end = min( ite,ide-2 )
705	! j_start = max( jts,jds+1 )
706	! j_end = min( jte,jde-2 )
707	! ENDIF
708	!
709	k_start = kts
710	k_end = min( kte, kde-1 )
711
712	! Update total cumulus scheme precipitation
713
714	! in mm
715
716	DO J = j_start,j_end
717	DO i = i_start,i_end
718	RAINC(I,J)=RAINC(I,J)+RAINCV(I,J)
719	CUPPT(I,J)=CUPPT(I,J)+RAINCV(I,J)/1000.
720	ENDDO
721	ENDDO
722
723	SELECT CASE (config_flags%cu_physics)
724
725	CASE (KFSCHEME)
726
727	DO J = j_start,j_end
728	DO i = i_start,i_end
729
730	IF ( NINT(NCA(I,J)).GT. 0 ) THEN
731
732	IF ( NINT(NCA(I,J)) .eq. 1 ) THEN
733
734	! set tendency to zero
735	RAINCV(I,J)=0.
736	DO k = k_start,k_end
737	RTHCUTEN(i,k,j)=0.
738	RQVCUTEN(i,k,j)=0.
739	RQCCUTEN(i,k,j)=0.
740	RQRCUTEN(i,k,j)=0.
741	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
742	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
743	ENDDO
744	ENDIF
745
746	NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
747
748	ENDIF
749	!
750	ENDDO
751	ENDDO
752
753	CASE (BMJSCHEME)
754
755	DO J = j_start,j_end
756	DO i = i_start,i_end
757
758	! HTOP, HBOT FOR GFDL RADIATION
759	NCUTOP=NINT(CUTOP(I,J))
760	NCUBOT=NINT(CUBOT(I,J))
761	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
762	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
763	ENDIF
764	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
765	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
766	ENDIF
767
768	ENDDO
769	ENDDO
770
771	CASE (KFETASCHEME)
772
773	DO J = j_start,j_end
774	DO i = i_start,i_end
775
776	! HTOP, HBOT FOR GFDL RADIATION
777	NCUTOP=NINT(CUTOP(I,J))
778	NCUBOT=NINT(CUBOT(I,J))
779	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
780	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
781	ENDIF
782	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
783	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
784	ENDIF
785
786	IF ( NINT(NCA(I,J)).GT. 0 ) THEN
787
788	IF ( NINT(NCA(I,J)) .eq. 1 ) THEN
789
790	! set tendency to zero
791	RAINCV(I,J)=0.
792	DO k = k_start,k_end
793	RTHCUTEN(i,k,j)=0.
794	RQVCUTEN(i,k,j)=0.
795	RQCCUTEN(i,k,j)=0.
796	RQRCUTEN(i,k,j)=0.
797	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
798	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
799	ENDDO
800	ENDIF
801
802	NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
803
804	ENDIF
805	!
806	ENDDO
807	ENDDO
808
809	CASE DEFAULT
810
811	END SELECT
812
813	END SUBROUTINE advance_ppt
814
815	SUBROUTINE add_a2a(lvar,rvar,config_flags, &
816	ids,ide, jds, jde, kds, kde, &
817	ims, ime, jms, jme, kms, kme, &
818	its, ite, jts, jte, kts, kte )
819	!------------------------------------------------------------
820	IMPLICIT NONE
821	!------------------------------------------------------------
822	TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
823
824	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
825	ims, ime, jms, jme, kms, kme, &
826	its, ite, jts, jte, kts, kte
827
828	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
829	rvar
830	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
831	lvar
832
833	! LOCAL VARS
834	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
835
836	i_start = its
837	i_end = MIN(ite,ide-1)
838	j_start = jts
839	j_end = MIN(jte,jde-1)
840	ktf = min(kte,kde-1)
841
842	IF ( config_flags%specified .or. &
843	config_flags%nested) i_start = MAX(ids+1,its)
844	IF ( config_flags%specified .or. &
845	config_flags%nested) i_end = MIN(ide-2,ite)
846	IF ( config_flags%specified .or. &
847	config_flags%nested) j_start = MAX(jds+1,jts)
848	IF ( config_flags%specified .or. &
849	config_flags%nested) j_end = MIN(jde-2,jte)
850	IF ( config_flags%periodic_x ) i_start = its
851	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
852
853	DO j = j_start,j_end
854	DO k = kts,ktf
855	DO i = i_start,i_end
856	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
857	ENDDO
858	ENDDO
859	ENDDO
860
861	END SUBROUTINE add_a2a
862
863	!------------------------------------------------------------
864	SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
865	ids,ide, jds, jde, kds, kde, &
866	ims, ime, jms, jme, kms, kme, &
867	its, ite, jts, jte, kts, kte )
868	!------------------------------------------------------------
869	!------------------------------------------------------------
870	IMPLICIT NONE
871	!------------------------------------------------------------
872
873	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
874
875	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
876	ims, ime, jms, jme, kms, kme, &
877	its, ite, jts, jte, kts, kte
878
879	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
880	rvar
881	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
882	lvar
883
884	! LOCAL VARS
885
886	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
887
888	ktf=min(kte,kde-1)
889
890	i_start = its
891	i_end = ite
892	j_start = jts
893	j_end = MIN(jte,jde-1)
894
895	IF ( config_flags%specified .or. &
896	config_flags%nested) i_start = MAX(ids+1,its)
897	IF ( config_flags%specified .or. &
898	config_flags%nested) i_end = MIN(ide-1,ite)
899	IF ( config_flags%specified .or. &
900	config_flags%nested) j_start = MAX(jds+1,jts)
901	IF ( config_flags%specified .or. &
902	config_flags%nested) j_end = MIN(jde-2,jte)
903	IF ( config_flags%periodic_x ) i_start = its
904	IF ( config_flags%periodic_x ) i_end = ite
905
906	DO j = j_start,j_end
907	DO k = kts,ktf
908	DO i = i_start,i_end
909	lvar(i,k,j) = lvar(i,k,j) + &
910	0.5*(rvar(i,k,j)+rvar(i-1,k,j))
911	ENDDO
912	ENDDO
913	ENDDO
914
915	END SUBROUTINE add_a2c_u
916
917	!------------------------------------------------------------
918	SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
919	ids,ide, jds, jde, kds, kde, &
920	ims, ime, jms, jme, kms, kme, &
921	its, ite, jts, jte, kts, kte )
922	!------------------------------------------------------------
923	!------------------------------------------------------------
924	IMPLICIT NONE
925	!------------------------------------------------------------
926
927	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
928
929	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
930	ims, ime, jms, jme, kms, kme, &
931	its, ite, jts, jte, kts, kte
932
933	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
934	rvar
935	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
936	lvar
937
938	! LOCAL VARS
939
940	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
941
942	ktf=min(kte,kde-1)
943
944	i_start = its
945	i_end = MIN(ite,ide-1)
946	j_start = jts
947	j_end = jte
948
949	IF ( config_flags%specified .or. &
950	config_flags%nested) i_start = MAX(ids+1,its)
951	IF ( config_flags%specified .or. &
952	config_flags%nested) i_end = MIN(ide-2,ite)
953	IF ( config_flags%specified .or. &
954	config_flags%nested) j_start = MAX(jds+1,jts)
955	IF ( config_flags%specified .or. &
956	config_flags%nested) j_end = MIN(jde-1,jte)
957	IF ( config_flags%periodic_x ) i_start = its
958	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
959
960	DO j = j_start,j_end
961	DO k = kts,kte
962	DO i = i_start,i_end
963	lvar(i,k,j) = lvar(i,k,j) + &
964	0.5*(rvar(i,k,j)+rvar(i,k,j-1))
965	ENDDO
966	ENDDO
967	ENDDO
968
969	END SUBROUTINE add_a2c_v
970
971	!------------------------------------------------------------
972	SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
973	ids,ide, jds, jde, kds, kde, &
974	ims, ime, jms, jme, kms, kme, &
975	its, ite, jts, jte, kts, kte )
976	!------------------------------------------------------------
977	!------------------------------------------------------------
978	IMPLICIT NONE
979	!------------------------------------------------------------
980
981	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
982
983	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
984	ims, ime, jms, jme, kms, kme, &
985	its, ite, jts, jte, kts, kte
986
987	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
988	rvar
989	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
990	lvar
991
992	! LOCAL VARS
993
994	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
995
996	ktf=min(kte,kde-1)
997
998	i_start = its
999	i_end = ite
1000	j_start = jts
1001	j_end = MIN(jte,jde-1)
1002
1003
1004	IF ( config_flags%specified .or. &
1005	config_flags%nested) i_start = MAX(ids+1,its)
1006	IF ( config_flags%specified .or. &
1007	config_flags%nested) i_end = MIN(ide-1,ite)
1008	IF ( config_flags%specified .or. &
1009	config_flags%nested) j_start = MAX(jds+1,jts)
1010	IF ( config_flags%specified .or. &
1011	config_flags%nested) j_end = MIN(jde-2,jte)
1012
1013	! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1014
1015	DO j = j_start,j_end
1016	DO k = kts,ktf
1017	DO i = i_start,i_end
1018	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1019	ENDDO
1020	ENDDO
1021	ENDDO
1022
1023	END SUBROUTINE add_c2c_u
1024
1025	SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
1026	ids,ide, jds, jde, kds, kde, &
1027	ims, ime, jms, jme, kms, kme, &
1028	its, ite, jts, jte, kts, kte )
1029	!------------------------------------------------------------
1030	!------------------------------------------------------------
1031	IMPLICIT NONE
1032	!------------------------------------------------------------
1033
1034	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1035
1036	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1037	ims, ime, jms, jme, kms, kme, &
1038	its, ite, jts, jte, kts, kte
1039
1040	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1041	rvar
1042	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1043	lvar
1044
1045	! LOCAL VARS
1046
1047	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1048
1049	ktf=min(kte,kde-1)
1050
1051	i_start = its
1052	i_end = MIN(ite,ide-1)
1053	j_start = jts
1054	j_end = jte
1055
1056	IF ( config_flags%specified .or. &
1057	config_flags%nested) i_start = MAX(ids+1,its)
1058	IF ( config_flags%specified .or. &
1059	config_flags%nested) i_end = MIN(ide-2,ite)
1060	IF ( config_flags%specified .or. &
1061	config_flags%nested) j_start = MAX(jds+1,jts)
1062	IF ( config_flags%specified .or. &
1063	config_flags%nested) j_end = MIN(jde-1,jte)
1064
1065	! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1066
1067	DO j = j_start,j_end
1068	DO k = kts,kte
1069	DO i = i_start,i_end
1070	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1071	ENDDO
1072	ENDDO
1073	ENDDO
1074
1075	END SUBROUTINE add_c2c_v
1076
1077	#endif
1078
1079	END MODULE module_physics_addtendc

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

Download in other formats:

Original Format