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