Context Navigation

module_physics_addtendc.F

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

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 94.6 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(rph_tendf,rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
29	scalar_tendf,mu_tendf, &
30	RTHRATEN,RTHBLTEN,RTHCUTEN,RTHSHTEN, &
31	RUBLTEN,RUCUTEN,RUSHTEN, &
32	RVBLTEN,RVCUTEN,RVSHTEN, &
33	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
34	RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN, &
35	RQVSHTEN,RQCSHTEN,RQRSHTEN,RQISHTEN,RQSSHTEN,RQGSHTEN,&
36	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN, &
37	RQVNDGDTEN,RMUNDGDTEN, &
38	rthfrten,rqvfrten, & !fire
39	n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
40	ids, ide, jds, jde, kds, kde, &
41	ims, ime, jms, jme, kms, kme, &
42	its, ite, jts, jte, kts, kte )
43	!-------------------------------------------------------------------
44	IMPLICIT NONE
45	!-------------------------------------------------------------------
46
47	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
48
49	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
50	ims, ime, jms, jme, kms, kme, &
51	its, ite, jts, jte, kts, kte, &
52	n_moist,n_scalar,rk_step
53
54	LOGICAL , INTENT(IN) :: adv_moist_cond
55
56	REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: &
57	ru_tendf, &
58	rv_tendf, &
59	rt_tendf, &
60	rph_tendf
61
62	REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf
63
64	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
65	INTENT(INOUT) :: moist_tendf
66
67	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
68	INTENT(INOUT) :: scalar_tendf
69
70	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
71	RTHRATEN, &
72	RTHBLTEN, &
73	RTHCUTEN, &
74	RTHSHTEN, &
75	RUBLTEN, &
76	RUCUTEN, &
77	RUSHTEN, &
78	RVBLTEN, &
79	RVCUTEN, &
80	RVSHTEN, &
81	RQVBLTEN, &
82	RQCBLTEN, &
83	RQIBLTEN, &
84	RQVCUTEN, &
85	RQCCUTEN, &
86	RQRCUTEN, &
87	RQICUTEN, &
88	RQSCUTEN, &
89	RQVSHTEN, &
90	RQCSHTEN, &
91	RQRSHTEN, &
92	RQISHTEN, &
93	RQSSHTEN, &
94	RQGSHTEN, &
95	RTHNDGDTEN, &
96	RPHNDGDTEN, &
97	RQVNDGDTEN, &
98	RUNDGDTEN, &
99	RVNDGDTEN
100
101	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
102
103	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & ! fire
104	rthfrten, &
105	rqvfrten
106	!------------------------------------------------------------------
107	! set up loop bounds for this grid's boundary conditions
108
109	if (config_flags%ra_lw_physics .gt. 0 .or. &
110	config_flags%ra_sw_physics .gt. 0) &
111	CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
112	ids, ide, jds, jde, kds, kde, &
113	ims, ime, jms, jme, kms, kme, &
114	its, ite, jts, jte, kts, kte )
115
116	if (config_flags%bl_pbl_physics .gt. 0) &
117	CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
118	rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
119	scalar_tendf,adv_moist_cond, &
120	RTHBLTEN,RUBLTEN,RVBLTEN, &
121	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
122	ids, ide, jds, jde, kds, kde, &
123	ims, ime, jms, jme, kms, kme, &
124	its, ite, jts, jte, kts, kte )
125
126	if (config_flags%cu_physics .gt. 0) &
127	CALL phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, &
128	rt_tendf,ru_tendf,rv_tendf, &
129	RUCUTEN,RVCUTEN,RTHCUTEN, &
130	RQVCUTEN,RQCCUTEN,RQRCUTEN, &
131	RQICUTEN,RQSCUTEN,moist_tendf, &
132	scalar_tendf,adv_moist_cond, &
133	ids, ide, jds, jde, kds, kde, &
134	ims, ime, jms, jme, kms, kme, &
135	its, ite, jts, jte, kts, kte )
136
137	if (config_flags%shcu_physics .gt. 0) &
138	CALL phy_shcu_ten(config_flags,rk_step,n_moist, &
139	rt_tendf,ru_tendf,rv_tendf, &
140	RUSHTEN,RVSHTEN,RTHSHTEN, &
141	RQVSHTEN,RQCSHTEN,RQRSHTEN, &
142	RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf, &
143	ids, ide, jds, jde, kds, kde, &
144	ims, ime, jms, jme, kms, kme, &
145	its, ite, jts, jte, kts, kte )
146
147	if (config_flags%grid_fdda .gt. 0) &
148	CALL phy_fg_ten(config_flags,rk_step,n_moist, &
149	rph_tendf,rt_tendf,ru_tendf,rv_tendf, &
150	mu_tendf, moist_tendf, &
151	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
152	RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
153	ids, ide, jds, jde, kds, kde, &
154	ims, ime, jms, jme, kms, kme, &
155	its, ite, jts, jte, kts, kte )
156
157	if (config_flags%ifire .gt. 0) & ! fire
158	CALL phy_fr_ten(config_flags,rk_step,n_moist, &
159	rt_tendf,ru_tendf,rv_tendf, &
160	mu_tendf, moist_tendf, &
161	rthfrten,rqvfrten, &
162	ids, ide, jds, jde, kds, kde, &
163	ims, ime, jms, jme, kms, kme, &
164	its, ite, jts, jte, kts, kte )
165
166	END SUBROUTINE update_phy_ten
167
168	!=================================================================
169	SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
170	ids, ide, jds, jde, kds, kde, &
171	ims, ime, jms, jme, kms, kme, &
172	its, ite, jts, jte, kts, kte )
173	!-----------------------------------------------------------------
174	IMPLICIT NONE
175	!-----------------------------------------------------------------
176	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
177
178	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
179	ims, ime, jms, jme, kms, kme, &
180	its, ite, jts, jte, kts, kte
181
182	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
183	RTHRATEN
184
185	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
186	rt_tendf
187
188	! LOCAL VARS
189
190	INTEGER :: i,j,k
191
192	CALL add_a2a(rt_tendf,RTHRATEN,config_flags, &
193	ids,ide, jds, jde, kds, kde, &
194	ims, ime, jms, jme, kms, kme, &
195	its, ite, jts, jte, kts, kte )
196
197	END SUBROUTINE phy_ra_ten
198
199	!=================================================================
200	SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
201	rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
202	scalar_tendf,adv_moist_cond, &
203	RTHBLTEN,RUBLTEN,RVBLTEN, &
204	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
205	ids, ide, jds, jde, kds, kde, &
206	ims, ime, jms, jme, kms, kme, &
207	its, ite, jts, jte, kts, kte )
208	!-----------------------------------------------------------------
209	IMPLICIT NONE
210	!-----------------------------------------------------------------
211	TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
212
213	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
214	ims, ime, jms, jme, kms, kme, &
215	its, ite, jts, jte, kts, kte, &
216	n_moist, n_scalar, rk_step
217
218	LOGICAL , INTENT(IN) :: adv_moist_cond
219
220	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
221	INTENT(INOUT) :: moist_tendf
222
223	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
224	INTENT(INOUT) :: scalar_tendf
225
226	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
227	RTHBLTEN, &
228	RUBLTEN, &
229	RVBLTEN, &
230	RQVBLTEN, &
231	RQCBLTEN, &
232	RQIBLTEN
233
234	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
235	rt_tendf, &
236	ru_tendf, &
237	rv_tendf
238	! LOCAL VARS
239
240	INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
241
242	!-----------------------------------------------------------------
243
244	SELECT CASE(config_flags%bl_pbl_physics)
245
246	CASE (YSUSCHEME)
247
248	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
249	ids,ide, jds, jde, kds, kde, &
250	ims, ime, jms, jme, kms, kme, &
251	its, ite, jts, jte, kts, kte )
252
253	CALL add_a2c_u(ru_tendf,RUBLTEN,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	CALL add_a2c_v(rv_tendf,RVBLTEN,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_QV .ge. PARAM_FIRST_SCALAR) &
264	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
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 (P_QC .ge. PARAM_FIRST_SCALAR) &
271	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
272	config_flags, &
273	ids,ide, jds, jde, kds, kde, &
274	ims, ime, jms, jme, kms, kme, &
275	its, ite, jts, jte, kts, kte )
276
277	if (P_QI .ge. PARAM_FIRST_SCALAR) &
278	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
279	config_flags, &
280	ids,ide, jds, jde, kds, kde, &
281	ims, ime, jms, jme, kms, kme, &
282	its, ite, jts, jte, kts, kte )
283
284	IF(.not. adv_moist_cond)THEN
285
286	if (P_QT .ge. PARAM_FIRST_SCALAR) &
287	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
288	config_flags, &
289	ids,ide, jds, jde, kds, kde, &
290	ims, ime, jms, jme, kms, kme, &
291	its, ite, jts, jte, kts, kte )
292
293	if (P_QT .ge. PARAM_FIRST_SCALAR) &
294	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
295	config_flags, &
296	ids,ide, jds, jde, kds, kde, &
297	ims, ime, jms, jme, kms, kme, &
298	its, ite, jts, jte, kts, kte )
299	ENDIF
300
301	CASE (MRFSCHEME)
302
303	CALL add_a2a(rt_tendf,RTHBLTEN,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_u(ru_tendf,RUBLTEN,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	CALL add_a2c_v(rv_tendf,RVBLTEN,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_QV .ge. PARAM_FIRST_SCALAR) &
319	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
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 (P_QC .ge. PARAM_FIRST_SCALAR) &
326	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
327	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	if (P_QI .ge. PARAM_FIRST_SCALAR) &
333	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
334	config_flags, &
335	ids,ide, jds, jde, kds, kde, &
336	ims, ime, jms, jme, kms, kme, &
337	its, ite, jts, jte, kts, kte )
338
339	IF(.not. adv_moist_cond)THEN
340
341	if (P_QT .ge. PARAM_FIRST_SCALAR) &
342	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
343	config_flags, &
344	ids,ide, jds, jde, kds, kde, &
345	ims, ime, jms, jme, kms, kme, &
346	its, ite, jts, jte, kts, kte )
347
348	if (P_QT .ge. PARAM_FIRST_SCALAR) &
349	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
350	config_flags, &
351	ids,ide, jds, jde, kds, kde, &
352	ims, ime, jms, jme, kms, kme, &
353	its, ite, jts, jte, kts, kte )
354	ENDIF
355
356	CASE (ACMPBLSCHEME)
357
358	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
359	ids,ide, jds, jde, kds, kde, &
360	ims, ime, jms, jme, kms, kme, &
361	its, ite, jts, jte, kts, kte )
362
363	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
364	ids,ide, jds, jde, kds, kde, &
365	ims, ime, jms, jme, kms, kme, &
366	its, ite, jts, jte, kts, kte )
367
368	CALL add_a2c_v(rv_tendf,RVBLTEN,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_QV .ge. PARAM_FIRST_SCALAR) &
374	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
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 (P_QC .ge. PARAM_FIRST_SCALAR) &
381	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
382	config_flags, &
383	ids,ide, jds, jde, kds, kde, &
384	ims, ime, jms, jme, kms, kme, &
385	its, ite, jts, jte, kts, kte )
386
387	if (P_QI .ge. PARAM_FIRST_SCALAR) &
388	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
389	config_flags, &
390	ids,ide, jds, jde, kds, kde, &
391	ims, ime, jms, jme, kms, kme, &
392	its, ite, jts, jte, kts, kte )
393
394	IF(.not. adv_moist_cond)THEN
395
396	if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
397	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
398	config_flags, &
399	ids,ide, jds, jde, kds, kde, &
400	ims, ime, jms, jme, kms, kme, &
401	its, ite, jts, jte, kts, kte )
402
403	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
404	config_flags, &
405	ids,ide, jds, jde, kds, kde, &
406	ims, ime, jms, jme, kms, kme, &
407	its, ite, jts, jte, kts, kte )
408	ENDIF
409
410	ENDIF
411
412	CASE (MYJPBLSCHEME)
413
414	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
415	ids,ide, jds, jde, kds, kde, &
416	ims, ime, jms, jme, kms, kme, &
417	its, ite, jts, jte, kts, kte )
418
419	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
420	ids,ide, jds, jde, kds, kde, &
421	ims, ime, jms, jme, kms, kme, &
422	its, ite, jts, jte, kts, kte )
423
424	CALL add_a2c_v(rv_tendf,RVBLTEN,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_QV .ge. PARAM_FIRST_SCALAR) &
430	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
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(.not. adv_moist_cond)THEN
437
438	if (P_QT .ge. PARAM_FIRST_SCALAR) &
439	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
440	config_flags, &
441	ids,ide, jds, jde, kds, kde, &
442	ims, ime, jms, jme, kms, kme, &
443	its, ite, jts, jte, kts, kte )
444
445	if (P_QT .ge. PARAM_FIRST_SCALAR) &
446	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
447	config_flags, &
448	ids,ide, jds, jde, kds, kde, &
449	ims, ime, jms, jme, kms, kme, &
450	its, ite, jts, jte, kts, kte )
451
452	! if (P_QT .ge. PARAM_FIRST_SCALAR) &
453	! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSBLTEN, &
454	! 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_QT .ge. PARAM_FIRST_SCALAR) &
460	! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRBLTEN, &
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_QT .ge. PARAM_FIRST_SCALAR) &
467	! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQGBLTEN, &
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	ELSE
474
475	if (P_QC .ge. PARAM_FIRST_SCALAR) &
476	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
477	config_flags, &
478	ids,ide, jds, jde, kds, kde, &
479	ims, ime, jms, jme, kms, kme, &
480	its, ite, jts, jte, kts, kte )
481
482	if (P_QI .ge. PARAM_FIRST_SCALAR) &
483	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
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_QS .ge. PARAM_FIRST_SCALAR) &
490	! CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSBLTEN, &
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	!
496	! if (P_QR .ge. PARAM_FIRST_SCALAR) &
497	! CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRBLTEN, &
498	! config_flags, &
499	! ids,ide, jds, jde, kds, kde, &
500	! ims, ime, jms, jme, kms, kme, &
501	! its, ite, jts, jte, kts, kte )
502	!
503	! if (P_QG .ge. PARAM_FIRST_SCALAR) &
504	! CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGBLTEN, &
505	! config_flags, &
506	! ids,ide, jds, jde, kds, kde, &
507	! ims, ime, jms, jme, kms, kme, &
508	! its, ite, jts, jte, kts, kte )
509
510	ENDIF
511
512	CASE (QNSEPBLSCHEME)
513
514	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
515	ids,ide, jds, jde, kds, kde, &
516	ims, ime, jms, jme, kms, kme, &
517	its, ite, jts, jte, kts, kte )
518
519	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
520	ids,ide, jds, jde, kds, kde, &
521	ims, ime, jms, jme, kms, kme, &
522	its, ite, jts, jte, kts, kte )
523
524	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
525	ids,ide, jds, jde, kds, kde, &
526	ims, ime, jms, jme, kms, kme, &
527	its, ite, jts, jte, kts, kte )
528
529	if (P_QV .ge. PARAM_FIRST_SCALAR) &
530	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
531	config_flags, &
532	ids,ide, jds, jde, kds, kde, &
533	ims, ime, jms, jme, kms, kme, &
534	its, ite, jts, jte, kts, kte )
535
536	IF(.not. adv_moist_cond)THEN
537
538	if (P_QT .ge. PARAM_FIRST_SCALAR) &
539	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
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	ELSE
546
547	if (P_QC .ge. PARAM_FIRST_SCALAR) &
548	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
549	config_flags, &
550	ids,ide, jds, jde, kds, kde, &
551	ims, ime, jms, jme, kms, kme, &
552	its, ite, jts, jte, kts, kte )
553
554	ENDIF
555
556	CASE (GFSSCHEME)
557
558	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
559	ids,ide, jds, jde, kds, kde, &
560	ims, ime, jms, jme, kms, kme, &
561	its, ite, jts, jte, kts, kte )
562
563	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
564	ids,ide, jds, jde, kds, kde, &
565	ims, ime, jms, jme, kms, kme, &
566	its, ite, jts, jte, kts, kte )
567
568	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
569	ids,ide, jds, jde, kds, kde, &
570	ims, ime, jms, jme, kms, kme, &
571	its, ite, jts, jte, kts, kte )
572
573	if (P_QV .ge. PARAM_FIRST_SCALAR) &
574	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
575	config_flags, &
576	ids,ide, jds, jde, kds, kde, &
577	ims, ime, jms, jme, kms, kme, &
578	its, ite, jts, jte, kts, kte )
579
580	if (P_QC .ge. PARAM_FIRST_SCALAR) &
581	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
582	config_flags, &
583	ids,ide, jds, jde, kds, kde, &
584	ims, ime, jms, jme, kms, kme, &
585	its, ite, jts, jte, kts, kte )
586
587	if (P_QI .ge. PARAM_FIRST_SCALAR) &
588	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
589	config_flags, &
590	ids,ide, jds, jde, kds, kde, &
591	ims, ime, jms, jme, kms, kme, &
592	its, ite, jts, jte, kts, kte )
593
594	IF(.not. adv_moist_cond)THEN
595
596	if (P_QT .ge. PARAM_FIRST_SCALAR) &
597	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
598	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_QT .ge. PARAM_FIRST_SCALAR) &
604	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
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	ENDIF
610
611	CASE (MYNNPBLSCHEME2,MYNNPBLSCHEME3)
612
613	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
614	ids,ide, jds, jde, kds, kde, &
615	ims, ime, jms, jme, kms, kme, &
616	its, ite, jts, jte, kts, kte )
617
618	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
619	ids,ide, jds, jde, kds, kde, &
620	ims, ime, jms, jme, kms, kme, &
621	its, ite, jts, jte, kts, kte )
622
623	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
624	ids,ide, jds, jde, kds, kde, &
625	ims, ime, jms, jme, kms, kme, &
626	its, ite, jts, jte, kts, kte )
627
628	if (P_QV .ge. PARAM_FIRST_SCALAR) &
629	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
630	config_flags, &
631	ids,ide, jds, jde, kds, kde, &
632	ims, ime, jms, jme, kms, kme, &
633	its, ite, jts, jte, kts, kte )
634
635	if (P_QC .ge. PARAM_FIRST_SCALAR) &
636	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
637	config_flags, &
638	ids,ide, jds, jde, kds, kde, &
639	ims, ime, jms, jme, kms, kme, &
640	its, ite, jts, jte, kts, kte )
641
642	IF(.not. adv_moist_cond)THEN
643
644	if (P_QT .ge. PARAM_FIRST_SCALAR) &
645	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
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	ENDIF
652
653	CASE (BOULACSCHEME)
654
655	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
656	ids,ide, jds, jde, kds, kde, &
657	ims, ime, jms, jme, kms, kme, &
658	its, ite, jts, jte, kts, kte )
659
660	CALL add_a2c_u(ru_tendf,RUBLTEN,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	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
666	ids,ide, jds, jde, kds, kde, &
667	ims, ime, jms, jme, kms, kme, &
668	its, ite, jts, jte, kts, kte )
669
670	if (P_QV .ge. PARAM_FIRST_SCALAR) &
671	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
672	config_flags, &
673	ids,ide, jds, jde, kds, kde, &
674	ims, ime, jms, jme, kms, kme, &
675	its, ite, jts, jte, kts, kte )
676
677	IF(.not. adv_moist_cond)THEN
678
679	if (P_QT .ge. PARAM_FIRST_SCALAR) &
680	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
681	config_flags, &
682	ids,ide, jds, jde, kds, kde, &
683	ims, ime, jms, jme, kms, kme, &
684	its, ite, jts, jte, kts, kte )
685
686	ELSE
687
688	if (P_QC .ge. PARAM_FIRST_SCALAR) &
689	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
690	config_flags, &
691	ids,ide, jds, jde, kds, kde, &
692	ims, ime, jms, jme, kms, kme, &
693	its, ite, jts, jte, kts, kte )
694	ENDIF
695
696	CASE (CAMUWPBLSCHEME)
697	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
698	ids,ide, jds, jde, kds, kde, &
699	ims, ime, jms, jme, kms, kme, &
700	its, ite, jts, jte, kts, kte )
701
702	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
703	ids,ide, jds, jde, kds, kde, &
704	ims, ime, jms, jme, kms, kme, &
705	its, ite, jts, jte, kts, kte )
706
707	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
708	ids,ide, jds, jde, kds, kde, &
709	ims, ime, jms, jme, kms, kme, &
710	its, ite, jts, jte, kts, kte )
711
712	if (P_QV .ge. PARAM_FIRST_SCALAR) &
713	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
714	config_flags, &
715	ids,ide, jds, jde, kds, kde, &
716	ims, ime, jms, jme, kms, kme, &
717	its, ite, jts, jte, kts, kte )
718
719	IF(.not. adv_moist_cond)THEN
720
721	if (P_QT .ge. PARAM_FIRST_SCALAR) &
722	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
723	config_flags, &
724	ids,ide, jds, jde, kds, kde, &
725	ims, ime, jms, jme, kms, kme, &
726	its, ite, jts, jte, kts, kte )
727
728	ELSE
729
730	if (P_QC .ge. PARAM_FIRST_SCALAR) &
731	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
732	config_flags, &
733	ids,ide, jds, jde, kds, kde, &
734	ims, ime, jms, jme, kms, kme, &
735	its, ite, jts, jte, kts, kte )
736	ENDIF
737
738
739	CASE (TEMFPBLSCHEME)
740	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
741	ids,ide, jds, jde, kds, kde, &
742	ims, ime, jms, jme, kms, kme, &
743	its, ite, jts, jte, kts, kte )
744
745	CALL add_a2c_u(ru_tendf,RUBLTEN,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	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
751	ids,ide, jds, jde, kds, kde, &
752	ims, ime, jms, jme, kms, kme, &
753	its, ite, jts, jte, kts, kte )
754
755	if (P_QV .ge. PARAM_FIRST_SCALAR) &
756	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
757	config_flags, &
758	ids,ide, jds, jde, kds, kde, &
759	ims, ime, jms, jme, kms, kme, &
760	its, ite, jts, jte, kts, kte )
761
762	if (P_QC .ge. PARAM_FIRST_SCALAR) &
763	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
764	config_flags, &
765	ids,ide, jds, jde, kds, kde, &
766	ims, ime, jms, jme, kms, kme, &
767	its, ite, jts, jte, kts, kte )
768
769	if (P_QI .ge. PARAM_FIRST_SCALAR) &
770	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
771	config_flags, &
772	ids,ide, jds, jde, kds, kde, &
773	ims, ime, jms, jme, kms, kme, &
774	its, ite, jts, jte, kts, kte )
775
776	CASE DEFAULT
777
778	print*,'phy_bl_ten: The pbl scheme does not exist'
779
780	END SELECT
781
782	END SUBROUTINE phy_bl_ten
783
784	!=================================================================
785	SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, &
786	rt_tendf,ru_tendf,rv_tendf, &
787	RUCUTEN,RVCUTEN,RTHCUTEN, &
788	RQVCUTEN,RQCCUTEN,RQRCUTEN, &
789	RQICUTEN,RQSCUTEN,moist_tendf, &
790	scalar_tendf,adv_moist_cond, &
791	ids, ide, jds, jde, kds, kde, &
792	ims, ime, jms, jme, kms, kme, &
793	its, ite, jts, jte, kts, kte )
794	!-----------------------------------------------------------------
795	IMPLICIT NONE
796	!-----------------------------------------------------------------
797	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
798
799	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
800	ims, ime, jms, jme, kms, kme, &
801	its, ite, jts, jte, kts, kte, &
802	n_moist, n_scalar, rk_step
803
804	LOGICAL , INTENT(IN) :: adv_moist_cond
805
806	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
807	INTENT(INOUT) :: moist_tendf
808
809	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
810	INTENT(INOUT) :: scalar_tendf
811
812	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
813	RUCUTEN, &
814	RVCUTEN, &
815	RTHCUTEN, &
816	RQVCUTEN, &
817	RQCCUTEN, &
818	RQRCUTEN, &
819	RQICUTEN, &
820	RQSCUTEN
821
822	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
823	rt_tendf, &
824	ru_tendf, &
825	rv_tendf
826
827
828	! LOCAL VARS
829
830	INTEGER :: i,j,k
831
832	SELECT CASE (config_flags%cu_physics)
833
834	CASE (KFSCHEME)
835	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
836	ids,ide, jds, jde, kds, kde, &
837	ims, ime, jms, jme, kms, kme, &
838	its, ite, jts, jte, kts, kte )
839
840	if (P_QV .ge. PARAM_FIRST_SCALAR) &
841	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
842	config_flags, &
843	ids,ide, jds, jde, kds, kde, &
844	ims, ime, jms, jme, kms, kme, &
845	its, ite, jts, jte, kts, kte )
846
847	if (P_QC .ge. PARAM_FIRST_SCALAR) &
848	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
849	config_flags, &
850	ids,ide, jds, jde, kds, kde, &
851	ims, ime, jms, jme, kms, kme, &
852	its, ite, jts, jte, kts, kte )
853
854	if (P_QR .ge. PARAM_FIRST_SCALAR) &
855	CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
856	config_flags, &
857	ids,ide, jds, jde, kds, kde, &
858	ims, ime, jms, jme, kms, kme, &
859	its, ite, jts, jte, kts, kte )
860
861	if (P_QI .ge. PARAM_FIRST_SCALAR) &
862	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
863	config_flags, &
864	ids,ide, jds, jde, kds, kde, &
865	ims, ime, jms, jme, kms, kme, &
866	its, ite, jts, jte, kts, kte )
867
868	if (P_QS .ge. PARAM_FIRST_SCALAR) &
869	CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
870	config_flags, &
871	ids,ide, jds, jde, kds, kde, &
872	ims, ime, jms, jme, kms, kme, &
873	its, ite, jts, jte, kts, kte )
874
875	IF(.not. adv_moist_cond)THEN
876
877	if (P_QT .ge. PARAM_FIRST_SCALAR) &
878	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
879	config_flags, &
880	ids,ide, jds, jde, kds, kde, &
881	ims, ime, jms, jme, kms, kme, &
882	its, ite, jts, jte, kts, kte )
883
884	if (P_QT .ge. PARAM_FIRST_SCALAR) &
885	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
886	config_flags, &
887	ids,ide, jds, jde, kds, kde, &
888	ims, ime, jms, jme, kms, kme, &
889	its, ite, jts, jte, kts, kte )
890
891	if (P_QT .ge. PARAM_FIRST_SCALAR) &
892	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
893	config_flags, &
894	ids,ide, jds, jde, kds, kde, &
895	ims, ime, jms, jme, kms, kme, &
896	its, ite, jts, jte, kts, kte )
897
898	if (P_QT .ge. PARAM_FIRST_SCALAR) &
899	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
900	config_flags, &
901	ids,ide, jds, jde, kds, kde, &
902	ims, ime, jms, jme, kms, kme, &
903	its, ite, jts, jte, kts, kte )
904
905	ENDIF
906
907	CASE (BMJSCHEME)
908	CALL add_a2a(rt_tendf,RTHCUTEN, &
909	config_flags, &
910	ids,ide, jds, jde, kds, kde, &
911	ims, ime, jms, jme, kms, kme, &
912	its, ite, jts, jte, kts, kte )
913
914	if (P_QV .ge. PARAM_FIRST_SCALAR) &
915	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
916	config_flags, &
917	ids,ide, jds, jde, kds, kde, &
918	ims, ime, jms, jme, kms, kme, &
919	its, ite, jts, jte, kts, kte )
920
921	CASE (KFETASCHEME)
922	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
923	ids,ide, jds, jde, kds, kde, &
924	ims, ime, jms, jme, kms, kme, &
925	its, ite, jts, jte, kts, kte )
926
927	if (P_QV .ge. PARAM_FIRST_SCALAR) &
928	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
929	config_flags, &
930	ids,ide, jds, jde, kds, kde, &
931	ims, ime, jms, jme, kms, kme, &
932	its, ite, jts, jte, kts, kte )
933
934	if (P_QC .ge. PARAM_FIRST_SCALAR) &
935	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
936	config_flags, &
937	ids,ide, jds, jde, kds, kde, &
938	ims, ime, jms, jme, kms, kme, &
939	its, ite, jts, jte, kts, kte )
940
941	if (P_QR .ge. PARAM_FIRST_SCALAR) &
942	CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
943	config_flags, &
944	ids,ide, jds, jde, kds, kde, &
945	ims, ime, jms, jme, kms, kme, &
946	its, ite, jts, jte, kts, kte )
947
948	if (P_QI .ge. PARAM_FIRST_SCALAR) &
949	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
950	config_flags, &
951	ids,ide, jds, jde, kds, kde, &
952	ims, ime, jms, jme, kms, kme, &
953	its, ite, jts, jte, kts, kte )
954
955	if (P_QS .ge. PARAM_FIRST_SCALAR) &
956	CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
957	config_flags, &
958	ids,ide, jds, jde, kds, kde, &
959	ims, ime, jms, jme, kms, kme, &
960	its, ite, jts, jte, kts, kte )
961
962	IF(.not. adv_moist_cond)THEN
963
964	if (P_QT .ge. PARAM_FIRST_SCALAR) &
965	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
966	config_flags, &
967	ids,ide, jds, jde, kds, kde, &
968	ims, ime, jms, jme, kms, kme, &
969	its, ite, jts, jte, kts, kte )
970
971	if (P_QT .ge. PARAM_FIRST_SCALAR) &
972	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
973	config_flags, &
974	ids,ide, jds, jde, kds, kde, &
975	ims, ime, jms, jme, kms, kme, &
976	its, ite, jts, jte, kts, kte )
977
978	if (P_QT .ge. PARAM_FIRST_SCALAR) &
979	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
980	config_flags, &
981	ids,ide, jds, jde, kds, kde, &
982	ims, ime, jms, jme, kms, kme, &
983	its, ite, jts, jte, kts, kte )
984
985	if (P_QT .ge. PARAM_FIRST_SCALAR) &
986	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
987	config_flags, &
988	ids,ide, jds, jde, kds, kde, &
989	ims, ime, jms, jme, kms, kme, &
990	its, ite, jts, jte, kts, kte )
991
992	ENDIF
993	CASE (GDSCHEME, G3SCHEME)
994	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
995	ids,ide, jds, jde, kds, kde, &
996	ims, ime, jms, jme, kms, kme, &
997	its, ite, jts, jte, kts, kte )
998
999	if (P_QV .ge. PARAM_FIRST_SCALAR) &
1000	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1001	config_flags, &
1002	ids,ide, jds, jde, kds, kde, &
1003	ims, ime, jms, jme, kms, kme, &
1004	its, ite, jts, jte, kts, kte )
1005
1006	if (P_QC .ge. PARAM_FIRST_SCALAR) &
1007	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1008	config_flags, &
1009	ids,ide, jds, jde, kds, kde, &
1010	ims, ime, jms, jme, kms, kme, &
1011	its, ite, jts, jte, kts, kte )
1012
1013	if (P_QI .ge. PARAM_FIRST_SCALAR) &
1014	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1015	config_flags, &
1016	ids,ide, jds, jde, kds, kde, &
1017	ims, ime, jms, jme, kms, kme, &
1018	its, ite, jts, jte, kts, kte )
1019
1020	IF(.not. adv_moist_cond)THEN
1021
1022	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1023	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1024	config_flags, &
1025	ids,ide, jds, jde, kds, kde, &
1026	ims, ime, jms, jme, kms, kme, &
1027	its, ite, jts, jte, kts, kte )
1028
1029	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1030	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1031	config_flags, &
1032	ids,ide, jds, jde, kds, kde, &
1033	ims, ime, jms, jme, kms, kme, &
1034	its, ite, jts, jte, kts, kte )
1035
1036	ENDIF
1037
1038	CASE (NSASSCHEME)
1039	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1040	ids,ide, jds, jde, kds, kde, &
1041	ims, ime, jms, jme, kms, kme, &
1042	its, ite, jts, jte, kts, kte )
1043
1044	CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
1045	ids,ide, jds, jde, kds, kde, &
1046	ims, ime, jms, jme, kms, kme, &
1047	its, ite, jts, jte, kts, kte )
1048
1049	CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
1050	ids,ide, jds, jde, kds, kde, &
1051	ims, ime, jms, jme, kms, kme, &
1052	its, ite, jts, jte, kts, kte )
1053
1054	if (P_QV .ge. PARAM_FIRST_SCALAR) &
1055	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1056	config_flags, &
1057	ids,ide, jds, jde, kds, kde, &
1058	ims, ime, jms, jme, kms, kme, &
1059	its, ite, jts, jte, kts, kte )
1060
1061	if (P_QC .ge. PARAM_FIRST_SCALAR) &
1062	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1063	config_flags, &
1064	ids,ide, jds, jde, kds, kde, &
1065	ims, ime, jms, jme, kms, kme, &
1066	its, ite, jts, jte, kts, kte )
1067
1068	if (P_QI .ge. PARAM_FIRST_SCALAR) &
1069	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1070	config_flags, &
1071	ids,ide, jds, jde, kds, kde, &
1072	ims, ime, jms, jme, kms, kme, &
1073	its, ite, jts, jte, kts, kte )
1074
1075	IF(.not. adv_moist_cond)THEN
1076
1077	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1078	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1079	config_flags, &
1080	ids,ide, jds, jde, kds, kde, &
1081	ims, ime, jms, jme, kms, kme, &
1082	its, ite, jts, jte, kts, kte )
1083
1084	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1085	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1086	config_flags, &
1087	ids,ide, jds, jde, kds, kde, &
1088	ims, ime, jms, jme, kms, kme, &
1089	its, ite, jts, jte, kts, kte )
1090
1091	ENDIF
1092
1093	CASE (SASSCHEME)
1094	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1095	ids,ide, jds, jde, kds, kde, &
1096	ims, ime, jms, jme, kms, kme, &
1097	its, ite, jts, jte, kts, kte )
1098
1099	if (P_QV .ge. PARAM_FIRST_SCALAR) &
1100	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1101	config_flags, &
1102	ids,ide, jds, jde, kds, kde, &
1103	ims, ime, jms, jme, kms, kme, &
1104	its, ite, jts, jte, kts, kte )
1105
1106	if (P_QC .ge. PARAM_FIRST_SCALAR) &
1107	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1108	config_flags, &
1109	ids,ide, jds, jde, kds, kde, &
1110	ims, ime, jms, jme, kms, kme, &
1111	its, ite, jts, jte, kts, kte )
1112
1113	if (P_QI .ge. PARAM_FIRST_SCALAR) &
1114	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1115	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	IF(.not. adv_moist_cond)THEN
1121
1122	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1123	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1124	config_flags, &
1125	ids,ide, jds, jde, kds, kde, &
1126	ims, ime, jms, jme, kms, kme, &
1127	its, ite, jts, jte, kts, kte )
1128
1129	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1130	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1131	config_flags, &
1132	ids,ide, jds, jde, kds, kde, &
1133	ims, ime, jms, jme, kms, kme, &
1134	its, ite, jts, jte, kts, kte )
1135
1136	ENDIF
1137
1138	CASE (CAMZMSCHEME)
1139	CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
1140	ids,ide, jds, jde, kds, kde, &
1141	ims, ime, jms, jme, kms, kme, &
1142	its, ite, jts, jte, kts, kte )
1143
1144	CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
1145	ids,ide, jds, jde, kds, kde, &
1146	ims, ime, jms, jme, kms, kme, &
1147	its, ite, jts, jte, kts, kte )
1148
1149	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1150	ids,ide, jds, jde, kds, kde, &
1151	ims, ime, jms, jme, kms, kme, &
1152	its, ite, jts, jte, kts, kte )
1153
1154	if (P_QV .ge. PARAM_FIRST_SCALAR) &
1155	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1156	config_flags, &
1157	ids,ide, jds, jde, kds, kde, &
1158	ims, ime, jms, jme, kms, kme, &
1159	its, ite, jts, jte, kts, kte )
1160
1161	if (P_QC .ge. PARAM_FIRST_SCALAR) &
1162	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1163	config_flags, &
1164	ids,ide, jds, jde, kds, kde, &
1165	ims, ime, jms, jme, kms, kme, &
1166	its, ite, jts, jte, kts, kte )
1167
1168	if (P_QI .ge. PARAM_FIRST_SCALAR) &
1169	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1170	config_flags, &
1171	ids,ide, jds, jde, kds, kde, &
1172	ims, ime, jms, jme, kms, kme, &
1173	its, ite, jts, jte, kts, kte )
1174	IF(.not. adv_moist_cond)THEN
1175
1176	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1177	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1178	config_flags, &
1179	ids,ide, jds, jde, kds, kde, &
1180	ims, ime, jms, jme, kms, kme, &
1181	its, ite, jts, jte, kts, kte )
1182
1183	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1184	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1185	config_flags, &
1186	ids,ide, jds, jde, kds, kde, &
1187	ims, ime, jms, jme, kms, kme, &
1188	its, ite, jts, jte, kts, kte )
1189
1190	ENDIF
1191
1192	CASE (TIEDTKESCHEME)
1193	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1194	ids,ide, jds, jde, kds, kde, &
1195	ims, ime, jms, jme, kms, kme, &
1196	its, ite, jts, jte, kts, kte )
1197
1198	CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
1199	ids,ide, jds, jde, kds, kde, &
1200	ims, ime, jms, jme, kms, kme, &
1201	its, ite, jts, jte, kts, kte )
1202
1203	CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
1204	ids,ide, jds, jde, kds, kde, &
1205	ims, ime, jms, jme, kms, kme, &
1206	its, ite, jts, jte, kts, kte )
1207
1208	if (P_QV .ge. PARAM_FIRST_SCALAR) &
1209	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1210	config_flags, &
1211	ids,ide, jds, jde, kds, kde, &
1212	ims, ime, jms, jme, kms, kme, &
1213	its, ite, jts, jte, kts, kte )
1214
1215	if (P_QC .ge. PARAM_FIRST_SCALAR) &
1216	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1217	config_flags, &
1218	ids,ide, jds, jde, kds, kde, &
1219	ims, ime, jms, jme, kms, kme, &
1220	its, ite, jts, jte, kts, kte )
1221
1222	if (P_QI .ge. PARAM_FIRST_SCALAR) &
1223	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1224	config_flags, &
1225	ids,ide, jds, jde, kds, kde, &
1226	ims, ime, jms, jme, kms, kme, &
1227	its, ite, jts, jte, kts, kte )
1228
1229	IF(.not. adv_moist_cond)THEN
1230
1231	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1232	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1233	config_flags, &
1234	ids,ide, jds, jde, kds, kde, &
1235	ims, ime, jms, jme, kms, kme, &
1236	its, ite, jts, jte, kts, kte )
1237
1238	if (P_QT .ge. PARAM_FIRST_SCALAR) &
1239	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1240	config_flags, &
1241	ids,ide, jds, jde, kds, kde, &
1242	ims, ime, jms, jme, kms, kme, &
1243	its, ite, jts, jte, kts, kte )
1244
1245	ENDIF
1246
1247	CASE DEFAULT
1248
1249	END SELECT
1250
1251	END SUBROUTINE phy_cu_ten
1252
1253	!=================================================================
1254	SUBROUTINE phy_shcu_ten(config_flags,rk_step,n_moist, &
1255	rt_tendf,ru_tendf,rv_tendf, &
1256	RUSHTEN,RVSHTEN,RTHSHTEN, &
1257	RQVSHTEN,RQCSHTEN,RQRSHTEN, &
1258	RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf, &
1259	ids, ide, jds, jde, kds, kde, &
1260	ims, ime, jms, jme, kms, kme, &
1261	its, ite, jts, jte, kts, kte )
1262	!-----------------------------------------------------------------
1263	IMPLICIT NONE
1264	!-----------------------------------------------------------------
1265	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
1266
1267	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1268	ims, ime, jms, jme, kms, kme, &
1269	its, ite, jts, jte, kts, kte, &
1270	n_moist, rk_step
1271
1272	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
1273	INTENT(INOUT) :: moist_tendf
1274
1275	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
1276	RUSHTEN, &
1277	RVSHTEN, &
1278	RTHSHTEN, &
1279	RQVSHTEN, &
1280	RQCSHTEN, &
1281	RQRSHTEN, &
1282	RQISHTEN, &
1283	RQSSHTEN, &
1284	RQGSHTEN
1285
1286	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
1287	rt_tendf, &
1288	ru_tendf, &
1289	rv_tendf
1290
1291	! LOCAL VARS
1292
1293	INTEGER :: i,j,k
1294
1295	SELECT CASE (config_flags%shcu_physics)
1296
1297	CASE (CAMUWSHCUSCHEME)
1298	CALL add_a2c_u(ru_tendf,RUSHTEN,config_flags, &
1299	ids,ide, jds, jde, kds, kde, &
1300	ims, ime, jms, jme, kms, kme, &
1301	its, ite, jts, jte, kts, kte )
1302
1303	CALL add_a2c_v(rv_tendf,RVSHTEN,config_flags, &
1304	ids,ide, jds, jde, kds, kde, &
1305	ims, ime, jms, jme, kms, kme, &
1306	its, ite, jts, jte, kts, kte )
1307
1308	CALL add_a2a(rt_tendf,RTHSHTEN,config_flags, &
1309	ids,ide, jds, jde, kds, kde, &
1310	ims, ime, jms, jme, kms, kme, &
1311	its, ite, jts, jte, kts, kte )
1312
1313	if (P_QV .ge. PARAM_FIRST_SCALAR) &
1314	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVSHTEN, &
1315	config_flags, &
1316	ids,ide, jds, jde, kds, kde, &
1317	ims, ime, jms, jme, kms, kme, &
1318	its, ite, jts, jte, kts, kte )
1319
1320	if (P_QC .ge. PARAM_FIRST_SCALAR) &
1321	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCSHTEN, &
1322	config_flags, &
1323	ids,ide, jds, jde, kds, kde, &
1324	ims, ime, jms, jme, kms, kme, &
1325	its, ite, jts, jte, kts, kte )
1326
1327	if (P_QR .ge. PARAM_FIRST_SCALAR) &
1328	CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRSHTEN, &
1329	config_flags, &
1330	ids,ide, jds, jde, kds, kde, &
1331	ims, ime, jms, jme, kms, kme, &
1332	its, ite, jts, jte, kts, kte )
1333
1334	if (P_QI .ge. PARAM_FIRST_SCALAR) &
1335	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQISHTEN, &
1336	config_flags, &
1337	ids,ide, jds, jde, kds, kde, &
1338	ims, ime, jms, jme, kms, kme, &
1339	its, ite, jts, jte, kts, kte )
1340
1341	if (P_QS .ge. PARAM_FIRST_SCALAR) &
1342	CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSSHTEN, &
1343	config_flags, &
1344	ids,ide, jds, jde, kds, kde, &
1345	ims, ime, jms, jme, kms, kme, &
1346	its, ite, jts, jte, kts, kte )
1347
1348	if (P_QG .ge. PARAM_FIRST_SCALAR) &
1349	CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGSHTEN, &
1350	config_flags, &
1351	ids,ide, jds, jde, kds, kde, &
1352	ims, ime, jms, jme, kms, kme, &
1353	its, ite, jts, jte, kts, kte )
1354
1355	CASE DEFAULT
1356
1357	END SELECT
1358
1359
1360	END SUBROUTINE phy_shcu_ten
1361
1362	!=================================================================
1363	SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, &
1364	rph_tendf,rt_tendf,ru_tendf,rv_tendf, &
1365	mu_tendf, moist_tendf, &
1366	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
1367	RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
1368	ids, ide, jds, jde, kds, kde, &
1369	ims, ime, jms, jme, kms, kme, &
1370	its, ite, jts, jte, kts, kte )
1371	!-----------------------------------------------------------------
1372	IMPLICIT NONE
1373	!-----------------------------------------------------------------
1374	TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
1375
1376	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1377	ims, ime, jms, jme, kms, kme, &
1378	its, ite, jts, jte, kts, kte, &
1379	n_moist, rk_step
1380
1381	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
1382	INTENT(INOUT) :: moist_tendf
1383
1384	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
1385	RTHNDGDTEN, &
1386	RPHNDGDTEN, &
1387	RUNDGDTEN, &
1388	RVNDGDTEN, &
1389	RQVNDGDTEN
1390
1391	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
1392
1393	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
1394	rph_tendf,&
1395	rt_tendf, &
1396	ru_tendf, &
1397	rv_tendf
1398
1399	REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
1400
1401	! LOCAL VARS
1402
1403	INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1404
1405	!-----------------------------------------------------------------
1406
1407	SELECT CASE(config_flags%grid_fdda)
1408
1409	CASE (PSUFDDAGD)
1410
1411	CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
1412	ids,ide, jds, jde, kds, kde, &
1413	ims, ime, jms, jme, kms, kme, &
1414	its, ite, jts, jte, kts, kte )
1415
1416	! note fdda u and v tendencies are staggered
1417	CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
1418	ids,ide, jds, jde, kds, kde, &
1419	ims, ime, jms, jme, kms, kme, &
1420	its, ite, jts, jte, kts, kte )
1421
1422	CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
1423	ids,ide, jds, jde, kds, kde, &
1424	ims, ime, jms, jme, kms, kme, &
1425	its, ite, jts, jte, kts, kte )
1426
1427	CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, &
1428	ids,ide, jds, jde, kds, kds, &
1429	ims, ime, jms, jme, kms, kms, &
1430	its, ite, jts, jte, kts, kts )
1431
1432	if (P_QV .ge. PARAM_FIRST_SCALAR) &
1433	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, &
1434	config_flags, &
1435	ids,ide, jds, jde, kds, kde, &
1436	ims, ime, jms, jme, kms, kme, &
1437	its, ite, jts, jte, kts, kte )
1438
1439	CASE (SPNUDGING)
1440
1441	! note fdda u and v tendencies are staggered
1442	CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
1443	ids,ide, jds, jde, kds, kde, &
1444	ims, ime, jms, jme, kms, kme, &
1445	its, ite, jts, jte, kts, kte )
1446
1447	CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
1448	ids,ide, jds, jde, kds, kde, &
1449	ims, ime, jms, jme, kms, kme, &
1450	its, ite, jts, jte, kts, kte )
1451
1452	CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
1453	ids,ide, jds, jde, kds, kde, &
1454	ims, ime, jms, jme, kms, kme, &
1455	its, ite, jts, jte, kts, kte )
1456
1457	CALL add_a2a_ph(rph_tendf,RPHNDGDTEN,config_flags, &
1458	ids,ide, jds, jde, kds, kde, &
1459	ims, ime, jms, jme, kms, kme, &
1460	its, ite, jts, jte, kts, kte )
1461
1462	CASE DEFAULT
1463
1464	END SELECT
1465
1466	END SUBROUTINE phy_fg_ten
1467
1468	!=================================================================
1469	SUBROUTINE phy_fr_ten(config_flags,rk_step,n_moist, &
1470	rt_tendf,ru_tendf,rv_tendf, &
1471	mu_tendf, moist_tendf, &
1472	rthfrten,rqvfrten, &
1473	ids, ide, jds, jde, kds, kde, &
1474	ims, ime, jms, jme, kms, kme, &
1475	its, ite, jts, jte, kts, kte )
1476	!-----------------------------------------------------------------
1477	USE module_state_description, ONLY : &
1478	FIRE_SFIRE
1479	!-----------------------------------------------------------------
1480	IMPLICIT NONE
1481	!-----------------------------------------------------------------
1482	TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
1483
1484	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1485	ims, ime, jms, jme, kms, kme, &
1486	its, ite, jts, jte, kts, kte, &
1487	n_moist, rk_step
1488
1489	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
1490	INTENT(INOUT) :: moist_tendf
1491
1492	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
1493	rthfrten, &
1494	rqvfrten
1495
1496	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
1497	rt_tendf, &
1498	ru_tendf, &
1499	rv_tendf
1500
1501	REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
1502
1503	! LOCAL VARS
1504
1505	INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1506
1507	!-----------------------------------------------------------------
1508
1509	SELECT CASE(config_flags%ifire)
1510
1511	CASE (FIRE_SFIRE)
1512
1513	CALL add_a2a(rt_tendf,rthfrten, &
1514	config_flags, &
1515	ids,ide, jds, jde, kds, kde, &
1516	ims, ime, jms, jme, kms, kme, &
1517	its, ite, jts, jte, kts, kte )
1518
1519	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),rqvfrten, &
1520	config_flags, &
1521	ids,ide, jds, jde, kds, kde, &
1522	ims, ime, jms, jme, kms, kme, &
1523	its, ite, jts, jte, kts, kte )
1524
1525	CASE DEFAULT
1526
1527	END SELECT
1528
1529	END SUBROUTINE phy_fr_ten
1530
1531	!----------------------------------------------------------------------
1532	SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
1533	RQICUTEN,RQSCUTEN, &
1534	RAINC,RAINCV,RAINSH,PRATEC,PRATESH, &
1535	NCA, HTOP,HBOT,CUTOP,CUBOT, &
1536	CUPPT, DT, config_flags, &
1537	ids,ide, jds,jde, kds,kde, &
1538	ims,ime, jms,jme, kms,kme, &
1539	its,ite, jts,jte, kts,kte )
1540	!----------------------------------------------------------------------
1541	USE module_state_description
1542	USE module_cu_kf
1543	USE module_cu_kfeta
1544	!----------------------------------------------------------------------
1545	IMPLICIT NONE
1546	!----------------------------------------------------------------------
1547	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1548
1549	INTEGER, INTENT(IN ) :: &
1550	ids,ide, jds,jde, kds,kde, &
1551	ims,ime, jms,jme, kms,kme, &
1552	its,ite, jts,jte, kts,kte
1553
1554
1555	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
1556	INTENT(INOUT) :: RTHCUTEN, &
1557	RQVCUTEN, &
1558	RQCCUTEN, &
1559	RQRCUTEN, &
1560	RQICUTEN, &
1561	RQSCUTEN
1562
1563	REAL, DIMENSION( ims:ime , jms:jme ), &
1564	INTENT(INOUT) :: RAINC, &
1565	RAINSH, &
1566	RAINCV, &
1567	PRATEC, &
1568	PRATESH, &
1569	NCA, &
1570	HTOP, &
1571	HBOT, &
1572	CUTOP, &
1573	CUBOT, &
1574	CUPPT
1575	REAL, INTENT(IN) :: DT
1576
1577	! LOCAL VAR
1578
1579	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
1580	INTEGER :: NCUTOP, NCUBOT
1581
1582	!-----------------------------------------------------------------
1583
1584	IF (config_flags%cu_physics .eq. 0) return
1585
1586	! SET START AND END POINTS FOR TILES
1587
1588	i_start = its
1589	i_end = min( ite,ide-1 )
1590	j_start = jts
1591	j_end = min( jte,jde-1 )
1592	!
1593	! IF( config_flags%nested .or. config_flags%specified ) THEN
1594	! i_start = max( its,ids+1 )
1595	! i_end = min( ite,ide-2 )
1596	! j_start = max( jts,jds+1 )
1597	! j_end = min( jte,jde-2 )
1598	! ENDIF
1599	!
1600	k_start = kts
1601	k_end = min( kte, kde-1 )
1602
1603	! Update total cumulus scheme precipitation
1604
1605	! in mm
1606
1607	DO J = j_start,j_end
1608	DO i = i_start,i_end
1609	RAINC(I,J) = RAINC(I,J) + PRATEC(I,J)*DT
1610	RAINSH(I,J) = RAINSH(I,J) + PRATESH(I,J)*DT
1611	CUPPT(I,J) = CUPPT(I,J) + (PRATEC(I,J)+PRATESH(I,J))*DT/1000.
1612	ENDDO
1613	ENDDO
1614
1615	SELECT CASE (config_flags%cu_physics)
1616
1617	CASE (KFSCHEME)
1618
1619	DO J = j_start,j_end
1620	DO i = i_start,i_end
1621
1622	IF ( NCA(I,J) .GT. 0 ) THEN
1623
1624	IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
1625
1626	! set tendency to zero
1627	! PRATEC(I,J)=0.
1628	! RAINCV(I,J)=0.
1629	DO k = k_start,k_end
1630	RTHCUTEN(i,k,j)=0.
1631	RQVCUTEN(i,k,j)=0.
1632	RQCCUTEN(i,k,j)=0.
1633	RQRCUTEN(i,k,j)=0.
1634	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
1635	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
1636	ENDDO
1637	ENDIF
1638
1639	NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
1640
1641	ENDIF
1642	!
1643	ENDDO
1644	ENDDO
1645
1646	CASE (BMJSCHEME, CAMZMSCHEME)
1647
1648	DO J = j_start,j_end
1649	DO i = i_start,i_end
1650
1651	! HTOP, HBOT FOR GFDL RADIATION
1652	NCUTOP=NINT(CUTOP(I,J))
1653	NCUBOT=NINT(CUBOT(I,J))
1654	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
1655	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
1656	ENDIF
1657	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
1658	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
1659	ENDIF
1660
1661	ENDDO
1662	ENDDO
1663
1664	CASE (KFETASCHEME)
1665
1666	DO J = j_start,j_end
1667	DO i = i_start,i_end
1668
1669	! HTOP, HBOT FOR GFDL RADIATION
1670	NCUTOP=NINT(CUTOP(I,J))
1671	NCUBOT=NINT(CUBOT(I,J))
1672	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
1673	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
1674	ENDIF
1675	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
1676	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
1677	ENDIF
1678
1679	IF ( NCA(I,J) .GT. 0 ) THEN
1680
1681
1682	IF ( NINT(NCA(I,J) / DT) .LE. 1 ) THEN
1683
1684	! set tendency to zero
1685	! PRATEC(I,J)=0.
1686	! RAINCV(I,J)=0.
1687	DO k = k_start,k_end
1688	RTHCUTEN(i,k,j)=0.
1689	RQVCUTEN(i,k,j)=0.
1690	RQCCUTEN(i,k,j)=0.
1691	RQRCUTEN(i,k,j)=0.
1692	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
1693	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
1694	ENDDO
1695	ENDIF
1696
1697	NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
1698	! NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
1699
1700	ENDIF
1701	!
1702	ENDDO
1703	ENDDO
1704
1705	CASE DEFAULT
1706
1707	END SELECT
1708
1709	END SUBROUTINE advance_ppt
1710
1711	SUBROUTINE add_a2a(lvar,rvar,config_flags, &
1712	ids,ide, jds, jde, kds, kde, &
1713	ims, ime, jms, jme, kms, kme, &
1714	its, ite, jts, jte, kts, kte )
1715	!------------------------------------------------------------
1716	IMPLICIT NONE
1717	!------------------------------------------------------------
1718	TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
1719
1720	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1721	ims, ime, jms, jme, kms, kme, &
1722	its, ite, jts, jte, kts, kte
1723
1724	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1725	rvar
1726	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1727	lvar
1728
1729	! LOCAL VARS
1730	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1731
1732	i_start = its
1733	i_end = MIN(ite,ide-1)
1734	j_start = jts
1735	j_end = MIN(jte,jde-1)
1736	ktf = min(kte,kde-1)
1737
1738	IF ( config_flags%specified .or. &
1739	config_flags%nested) i_start = MAX(ids+1,its)
1740	IF ( config_flags%specified .or. &
1741	config_flags%nested) i_end = MIN(ide-2,ite)
1742	IF ( config_flags%specified .or. &
1743	config_flags%nested) j_start = MAX(jds+1,jts)
1744	IF ( config_flags%specified .or. &
1745	config_flags%nested) j_end = MIN(jde-2,jte)
1746	IF ( config_flags%periodic_x ) i_start = its
1747	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1748
1749	DO j = j_start,j_end
1750	DO k = kts,ktf
1751	DO i = i_start,i_end
1752	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1753	ENDDO
1754	ENDDO
1755	ENDDO
1756
1757	END SUBROUTINE add_a2a
1758
1759	SUBROUTINE add_a2a_ph(lvar,rvar,config_flags, &
1760	ids,ide, jds, jde, kds, kde, &
1761	ims, ime, jms, jme, kms, kme, &
1762	its, ite, jts, jte, kts, kte )
1763	!------------------------------------------------------------
1764	IMPLICIT NONE
1765	!------------------------------------------------------------
1766	TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
1767
1768	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1769	ims, ime, jms, jme, kms, kme, &
1770	its, ite, jts, jte, kts, kte
1771
1772	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1773	rvar
1774	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1775	lvar
1776
1777	! LOCAL VARS
1778	INTEGER :: i,j,k,i_start,i_end,j_start,j_end
1779
1780	i_start = its
1781	i_end = MIN(ite,ide-1)
1782	j_start = jts
1783	j_end = MIN(jte,jde-1)
1784
1785	IF ( config_flags%specified .or. &
1786	config_flags%nested) i_start = MAX(ids+1,its)
1787	IF ( config_flags%specified .or. &
1788	config_flags%nested) i_end = MIN(ide-2,ite)
1789	IF ( config_flags%specified .or. &
1790	config_flags%nested) j_start = MAX(jds+1,jts)
1791	IF ( config_flags%specified .or. &
1792	config_flags%nested) j_end = MIN(jde-2,jte)
1793	IF ( config_flags%periodic_x ) i_start = its
1794	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1795
1796	DO j = j_start,j_end
1797	DO k = kts,kte
1798	DO i = i_start,i_end
1799	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1800	ENDDO
1801	ENDDO
1802	ENDDO
1803
1804	END SUBROUTINE add_a2a_ph
1805
1806	!------------------------------------------------------------
1807	SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
1808	ids,ide, jds, jde, kds, kde, &
1809	ims, ime, jms, jme, kms, kme, &
1810	its, ite, jts, jte, kts, kte )
1811	!------------------------------------------------------------
1812	!------------------------------------------------------------
1813	IMPLICIT NONE
1814	!------------------------------------------------------------
1815
1816	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1817
1818	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1819	ims, ime, jms, jme, kms, kme, &
1820	its, ite, jts, jte, kts, kte
1821
1822	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1823	rvar
1824	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1825	lvar
1826
1827	! LOCAL VARS
1828
1829	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1830
1831	ktf=min(kte,kde-1)
1832
1833	i_start = its
1834	i_end = ite
1835	j_start = jts
1836	j_end = MIN(jte,jde-1)
1837
1838	IF ( config_flags%specified .or. &
1839	config_flags%nested) i_start = MAX(ids+1,its)
1840	IF ( config_flags%specified .or. &
1841	config_flags%nested) i_end = MIN(ide-1,ite)
1842	IF ( config_flags%specified .or. &
1843	config_flags%nested) j_start = MAX(jds+1,jts)
1844	IF ( config_flags%specified .or. &
1845	config_flags%nested) j_end = MIN(jde-2,jte)
1846	IF ( config_flags%periodic_x ) i_start = its
1847	IF ( config_flags%periodic_x ) i_end = ite
1848
1849	DO j = j_start,j_end
1850	DO k = kts,ktf
1851	DO i = i_start,i_end
1852	lvar(i,k,j) = lvar(i,k,j) + &
1853	0.5*(rvar(i,k,j)+rvar(i-1,k,j))
1854	ENDDO
1855	ENDDO
1856	ENDDO
1857
1858	END SUBROUTINE add_a2c_u
1859
1860	!------------------------------------------------------------
1861	SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
1862	ids,ide, jds, jde, kds, kde, &
1863	ims, ime, jms, jme, kms, kme, &
1864	its, ite, jts, jte, kts, kte )
1865	!------------------------------------------------------------
1866	!------------------------------------------------------------
1867	IMPLICIT NONE
1868	!------------------------------------------------------------
1869
1870	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1871
1872	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1873	ims, ime, jms, jme, kms, kme, &
1874	its, ite, jts, jte, kts, kte
1875
1876	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1877	rvar
1878	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1879	lvar
1880
1881	! LOCAL VARS
1882
1883	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1884
1885	ktf=min(kte,kde-1)
1886
1887	i_start = its
1888	i_end = MIN(ite,ide-1)
1889	j_start = jts
1890	j_end = jte
1891
1892	IF ( config_flags%specified .or. &
1893	config_flags%nested) i_start = MAX(ids+1,its)
1894	IF ( config_flags%specified .or. &
1895	config_flags%nested) i_end = MIN(ide-2,ite)
1896	IF ( config_flags%specified .or. &
1897	config_flags%nested) j_start = MAX(jds+1,jts)
1898	IF ( config_flags%specified .or. &
1899	config_flags%nested) j_end = MIN(jde-1,jte)
1900	IF ( config_flags%periodic_x ) i_start = its
1901	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1902
1903	DO j = j_start,j_end
1904	DO k = kts,kte
1905	DO i = i_start,i_end
1906	lvar(i,k,j) = lvar(i,k,j) + &
1907	0.5*(rvar(i,k,j)+rvar(i,k,j-1))
1908	ENDDO
1909	ENDDO
1910	ENDDO
1911
1912	END SUBROUTINE add_a2c_v
1913
1914	!------------------------------------------------------------
1915	SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
1916	ids,ide, jds, jde, kds, kde, &
1917	ims, ime, jms, jme, kms, kme, &
1918	its, ite, jts, jte, kts, kte )
1919	!------------------------------------------------------------
1920	!------------------------------------------------------------
1921	IMPLICIT NONE
1922	!------------------------------------------------------------
1923
1924	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1925
1926	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1927	ims, ime, jms, jme, kms, kme, &
1928	its, ite, jts, jte, kts, kte
1929
1930	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1931	rvar
1932	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1933	lvar
1934
1935	! LOCAL VARS
1936
1937	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1938
1939	ktf=min(kte,kde-1)
1940
1941	i_start = its
1942	i_end = ite
1943	j_start = jts
1944	j_end = MIN(jte,jde-1)
1945
1946
1947	IF ( config_flags%specified .or. &
1948	config_flags%nested) i_start = MAX(ids+1,its)
1949	IF ( config_flags%specified .or. &
1950	config_flags%nested) i_end = MIN(ide-1,ite)
1951	IF ( config_flags%specified .or. &
1952	config_flags%nested) j_start = MAX(jds+1,jts)
1953	IF ( config_flags%specified .or. &
1954	config_flags%nested) j_end = MIN(jde-2,jte)
1955
1956	! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1957
1958	DO j = j_start,j_end
1959	DO k = kts,ktf
1960	DO i = i_start,i_end
1961	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1962	ENDDO
1963	ENDDO
1964	ENDDO
1965
1966	END SUBROUTINE add_c2c_u
1967
1968	SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
1969	ids,ide, jds, jde, kds, kde, &
1970	ims, ime, jms, jme, kms, kme, &
1971	its, ite, jts, jte, kts, kte )
1972	!------------------------------------------------------------
1973	!------------------------------------------------------------
1974	IMPLICIT NONE
1975	!------------------------------------------------------------
1976
1977	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1978
1979	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1980	ims, ime, jms, jme, kms, kme, &
1981	its, ite, jts, jte, kts, kte
1982
1983	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1984	rvar
1985	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1986	lvar
1987
1988	! LOCAL VARS
1989
1990	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1991
1992	ktf=min(kte,kde-1)
1993
1994	i_start = its
1995	i_end = MIN(ite,ide-1)
1996	j_start = jts
1997	j_end = jte
1998
1999	IF ( config_flags%specified .or. &
2000	config_flags%nested) i_start = MAX(ids+1,its)
2001	IF ( config_flags%specified .or. &
2002	config_flags%nested) i_end = MIN(ide-2,ite)
2003	IF ( config_flags%specified .or. &
2004	config_flags%nested) j_start = MAX(jds+1,jts)
2005	IF ( config_flags%specified .or. &
2006	config_flags%nested) j_end = MIN(jde-1,jte)
2007
2008	! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
2009
2010	DO j = j_start,j_end
2011	DO k = kts,kte
2012	DO i = i_start,i_end
2013	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
2014	ENDDO
2015	ENDDO
2016	ENDDO
2017
2018	END SUBROUTINE add_c2c_v
2019
2020	#endif
2021
2022	END MODULE module_physics_addtendc

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

Download in other formats:

Original Format