Context Navigation

module_physics_addtendc.F

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

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

Download in other formats:

Original Format