Context Navigation

module_physics_addtendc.F @ 63

Last change on this file since 63 was 17, checked in by aslmd, 14 years ago
spiga:mineur
File size: 53.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(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	USE module_cu_kf
791	USE module_cu_kfeta
792	!----------------------------------------------------------------------
793	IMPLICIT NONE
794	!----------------------------------------------------------------------
795	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
796
797	INTEGER, INTENT(IN ) :: &
798	ids,ide, jds,jde, kds,kde, &
799	ims,ime, jms,jme, kms,kme, &
800	its,ite, jts,jte, kts,kte
801
802
803	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
804	INTENT(INOUT) :: RTHCUTEN, &
805	RQVCUTEN, &
806	RQCCUTEN, &
807	RQRCUTEN, &
808	RQICUTEN, &
809	RQSCUTEN
810
811	REAL, DIMENSION( ims:ime , jms:jme ), &
812	INTENT(INOUT) :: RAINC, &
813	RAINCV, &
814	PRATEC, &
815	NCA, &
816	HTOP, &
817	HBOT, &
818	CUTOP, &
819	CUBOT, &
820	CUPPT
821	REAL, INTENT(IN) :: DT
822
823	! LOCAL VAR
824
825	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
826	INTEGER :: NCUTOP, NCUBOT
827
828	!-----------------------------------------------------------------
829
830	IF (config_flags%cu_physics .eq. 0) return
831
832	! SET START AND END POINTS FOR TILES
833
834	i_start = its
835	i_end = min( ite,ide-1 )
836	j_start = jts
837	j_end = min( jte,jde-1 )
838	!
839	! IF( config_flags%nested .or. config_flags%specified ) THEN
840	! i_start = max( its,ids+1 )
841	! i_end = min( ite,ide-2 )
842	! j_start = max( jts,jds+1 )
843	! j_end = min( jte,jde-2 )
844	! ENDIF
845	!
846	k_start = kts
847	k_end = min( kte, kde-1 )
848
849	! Update total cumulus scheme precipitation
850
851	! in mm
852
853	DO J = j_start,j_end
854	DO i = i_start,i_end
855	RAINC(I,J)=RAINC(I,J)+PRATEC(I,J)*DT
856	CUPPT(I,J)=CUPPT(I,J)+PRATEC(I,J)*DT/1000.
857	ENDDO
858	ENDDO
859
860	SELECT CASE (config_flags%cu_physics)
861
862	CASE (KFSCHEME)
863
864	DO J = j_start,j_end
865	DO i = i_start,i_end
866
867	IF ( NCA(I,J) .GT. 0 ) THEN
868
869	IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
870
871	! set tendency to zero
872	PRATEC(I,J)=0.
873	RAINCV(I,J)=0.
874	DO k = k_start,k_end
875	RTHCUTEN(i,k,j)=0.
876	RQVCUTEN(i,k,j)=0.
877	RQCCUTEN(i,k,j)=0.
878	RQRCUTEN(i,k,j)=0.
879	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
880	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
881	ENDDO
882	ENDIF
883
884	NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
885
886	ENDIF
887	!
888	ENDDO
889	ENDDO
890
891	CASE (BMJSCHEME)
892
893	DO J = j_start,j_end
894	DO i = i_start,i_end
895
896	! HTOP, HBOT FOR GFDL RADIATION
897	NCUTOP=NINT(CUTOP(I,J))
898	NCUBOT=NINT(CUBOT(I,J))
899	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
900	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
901	ENDIF
902	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
903	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
904	ENDIF
905
906	ENDDO
907	ENDDO
908
909	CASE (KFETASCHEME)
910
911	DO J = j_start,j_end
912	DO i = i_start,i_end
913
914	! HTOP, HBOT FOR GFDL RADIATION
915	NCUTOP=NINT(CUTOP(I,J))
916	NCUBOT=NINT(CUBOT(I,J))
917	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
918	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
919	ENDIF
920	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
921	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
922	ENDIF
923
924	IF ( NCA(I,J) .GT. 0 ) THEN
925
926
927	IF ( NINT(NCA(I,J) / DT) .LE. 1 ) THEN
928
929	! set tendency to zero
930	PRATEC(I,J)=0.
931	RAINCV(I,J)=0.
932	DO k = k_start,k_end
933	RTHCUTEN(i,k,j)=0.
934	RQVCUTEN(i,k,j)=0.
935	RQCCUTEN(i,k,j)=0.
936	RQRCUTEN(i,k,j)=0.
937	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
938	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
939	ENDDO
940	ENDIF
941
942	NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
943	! NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
944
945	ENDIF
946	!
947	ENDDO
948	ENDDO
949
950	CASE DEFAULT
951
952	END SELECT
953
954	END SUBROUTINE advance_ppt
955
956	SUBROUTINE add_a2a(lvar,rvar,config_flags, &
957	ids,ide, jds, jde, kds, kde, &
958	ims, ime, jms, jme, kms, kme, &
959	its, ite, jts, jte, kts, kte )
960	!------------------------------------------------------------
961	IMPLICIT NONE
962	!------------------------------------------------------------
963	TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
964
965	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
966	ims, ime, jms, jme, kms, kme, &
967	its, ite, jts, jte, kts, kte
968
969	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
970	rvar
971	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
972	lvar
973
974	! LOCAL VARS
975	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
976
977	i_start = its
978	i_end = MIN(ite,ide-1)
979	j_start = jts
980	j_end = MIN(jte,jde-1)
981	ktf = min(kte,kde-1)
982
983	IF ( config_flags%specified .or. &
984	config_flags%nested) i_start = MAX(ids+1,its)
985	IF ( config_flags%specified .or. &
986	config_flags%nested) i_end = MIN(ide-2,ite)
987	IF ( config_flags%specified .or. &
988	config_flags%nested) j_start = MAX(jds+1,jts)
989	IF ( config_flags%specified .or. &
990	config_flags%nested) j_end = MIN(jde-2,jte)
991	IF ( config_flags%periodic_x ) i_start = its
992	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
993
994	DO j = j_start,j_end
995	DO k = kts,ktf
996	DO i = i_start,i_end
997	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
998	ENDDO
999	ENDDO
1000	ENDDO
1001
1002	END SUBROUTINE add_a2a
1003
1004	!------------------------------------------------------------
1005	SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
1006	ids,ide, jds, jde, kds, kde, &
1007	ims, ime, jms, jme, kms, kme, &
1008	its, ite, jts, jte, kts, kte )
1009	!------------------------------------------------------------
1010	!------------------------------------------------------------
1011	IMPLICIT NONE
1012	!------------------------------------------------------------
1013
1014	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1015
1016	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1017	ims, ime, jms, jme, kms, kme, &
1018	its, ite, jts, jte, kts, kte
1019
1020	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1021	rvar
1022	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1023	lvar
1024
1025	! LOCAL VARS
1026
1027	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1028
1029	ktf=min(kte,kde-1)
1030
1031	i_start = its
1032	i_end = ite
1033	j_start = jts
1034	j_end = MIN(jte,jde-1)
1035
1036	IF ( config_flags%specified .or. &
1037	config_flags%nested) i_start = MAX(ids+1,its)
1038	IF ( config_flags%specified .or. &
1039	config_flags%nested) i_end = MIN(ide-1,ite)
1040	IF ( config_flags%specified .or. &
1041	config_flags%nested) j_start = MAX(jds+1,jts)
1042	IF ( config_flags%specified .or. &
1043	config_flags%nested) j_end = MIN(jde-2,jte)
1044	IF ( config_flags%periodic_x ) i_start = its
1045	IF ( config_flags%periodic_x ) i_end = ite
1046
1047	DO j = j_start,j_end
1048	DO k = kts,ktf
1049	DO i = i_start,i_end
1050	lvar(i,k,j) = lvar(i,k,j) + &
1051	0.5*(rvar(i,k,j)+rvar(i-1,k,j))
1052	ENDDO
1053	ENDDO
1054	ENDDO
1055
1056	END SUBROUTINE add_a2c_u
1057
1058	!------------------------------------------------------------
1059	SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
1060	ids,ide, jds, jde, kds, kde, &
1061	ims, ime, jms, jme, kms, kme, &
1062	its, ite, jts, jte, kts, kte )
1063	!------------------------------------------------------------
1064	!------------------------------------------------------------
1065	IMPLICIT NONE
1066	!------------------------------------------------------------
1067
1068	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1069
1070	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1071	ims, ime, jms, jme, kms, kme, &
1072	its, ite, jts, jte, kts, kte
1073
1074	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1075	rvar
1076	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1077	lvar
1078
1079	! LOCAL VARS
1080
1081	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1082
1083	ktf=min(kte,kde-1)
1084
1085	i_start = its
1086	i_end = MIN(ite,ide-1)
1087	j_start = jts
1088	j_end = jte
1089
1090	IF ( config_flags%specified .or. &
1091	config_flags%nested) i_start = MAX(ids+1,its)
1092	IF ( config_flags%specified .or. &
1093	config_flags%nested) i_end = MIN(ide-2,ite)
1094	IF ( config_flags%specified .or. &
1095	config_flags%nested) j_start = MAX(jds+1,jts)
1096	IF ( config_flags%specified .or. &
1097	config_flags%nested) j_end = MIN(jde-1,jte)
1098	IF ( config_flags%periodic_x ) i_start = its
1099	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1100
1101	DO j = j_start,j_end
1102	DO k = kts,kte
1103	DO i = i_start,i_end
1104	lvar(i,k,j) = lvar(i,k,j) + &
1105	0.5*(rvar(i,k,j)+rvar(i,k,j-1))
1106	ENDDO
1107	ENDDO
1108	ENDDO
1109
1110	END SUBROUTINE add_a2c_v
1111
1112	!------------------------------------------------------------
1113	SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
1114	ids,ide, jds, jde, kds, kde, &
1115	ims, ime, jms, jme, kms, kme, &
1116	its, ite, jts, jte, kts, kte )
1117	!------------------------------------------------------------
1118	!------------------------------------------------------------
1119	IMPLICIT NONE
1120	!------------------------------------------------------------
1121
1122	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1123
1124	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1125	ims, ime, jms, jme, kms, kme, &
1126	its, ite, jts, jte, kts, kte
1127
1128	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1129	rvar
1130	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1131	lvar
1132
1133	! LOCAL VARS
1134
1135	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1136
1137	ktf=min(kte,kde-1)
1138
1139	i_start = its
1140	i_end = ite
1141	j_start = jts
1142	j_end = MIN(jte,jde-1)
1143
1144
1145	IF ( config_flags%specified .or. &
1146	config_flags%nested) i_start = MAX(ids+1,its)
1147	IF ( config_flags%specified .or. &
1148	config_flags%nested) i_end = MIN(ide-1,ite)
1149	IF ( config_flags%specified .or. &
1150	config_flags%nested) j_start = MAX(jds+1,jts)
1151	IF ( config_flags%specified .or. &
1152	config_flags%nested) j_end = MIN(jde-2,jte)
1153
1154	! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1155
1156	DO j = j_start,j_end
1157	DO k = kts,ktf
1158	DO i = i_start,i_end
1159	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1160	ENDDO
1161	ENDDO
1162	ENDDO
1163
1164	END SUBROUTINE add_c2c_u
1165
1166	SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
1167	ids,ide, jds, jde, kds, kde, &
1168	ims, ime, jms, jme, kms, kme, &
1169	its, ite, jts, jte, kts, kte )
1170	!------------------------------------------------------------
1171	!------------------------------------------------------------
1172	IMPLICIT NONE
1173	!------------------------------------------------------------
1174
1175	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1176
1177	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1178	ims, ime, jms, jme, kms, kme, &
1179	its, ite, jts, jte, kts, kte
1180
1181	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1182	rvar
1183	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1184	lvar
1185
1186	! LOCAL VARS
1187
1188	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1189
1190	ktf=min(kte,kde-1)
1191
1192	i_start = its
1193	i_end = MIN(ite,ide-1)
1194	j_start = jts
1195	j_end = jte
1196
1197	IF ( config_flags%specified .or. &
1198	config_flags%nested) i_start = MAX(ids+1,its)
1199	IF ( config_flags%specified .or. &
1200	config_flags%nested) i_end = MIN(ide-2,ite)
1201	IF ( config_flags%specified .or. &
1202	config_flags%nested) j_start = MAX(jds+1,jts)
1203	IF ( config_flags%specified .or. &
1204	config_flags%nested) j_end = MIN(jde-1,jte)
1205
1206	! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1207
1208	DO j = j_start,j_end
1209	DO k = kts,kte
1210	DO i = i_start,i_end
1211	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1212	ENDDO
1213	ENDDO
1214	ENDDO
1215
1216	END SUBROUTINE add_c2c_v
1217
1218	#endif
1219
1220	END MODULE module_physics_addtendc

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

Download in other formats:

Original Format