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 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 CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
98 rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
99 scalar_tendf,adv_moist_cond, &
100 RTHBLTEN,RUBLTEN,RVBLTEN, &
101 RQVBLTEN,RQCBLTEN,RQIBLTEN, &
102 ids, ide, jds, jde, kds, kde, &
103 ims, ime, jms, jme, kms, kme, &
104 its, ite, jts, jte, kts, kte )
105
106 if (config_flags%cu_physics .gt. 0) &
107 CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, &
108 RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
109 RQICUTEN,RQSCUTEN,moist_tendf, &
110 ids, ide, jds, jde, kds, kde, &
111 ims, ime, jms, jme, kms, kme, &
112 its, ite, jts, jte, kts, kte )
113
114 if (config_flags%grid_fdda .gt. 0) &
115 CALL phy_fg_ten(config_flags,rk_step,n_moist, &
116 rt_tendf,ru_tendf,rv_tendf, &
117 mu_tendf, moist_tendf, &
118 RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
119 RQVNDGDTEN,RMUNDGDTEN, &
120 ids, ide, jds, jde, kds, kde, &
121 ims, ime, jms, jme, kms, kme, &
122 its, ite, jts, jte, kts, kte )
123
124 END SUBROUTINE update_phy_ten
125
126 !=================================================================
127 SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
128 ids, ide, jds, jde, kds, kde, &
129 ims, ime, jms, jme, kms, kme, &
130 its, ite, jts, jte, kts, kte )
131 !-----------------------------------------------------------------
132 IMPLICIT NONE
133 !-----------------------------------------------------------------
134 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
135
136 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
137 ims, ime, jms, jme, kms, kme, &
138 its, ite, jts, jte, kts, kte
139
140 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
141 RTHRATEN
142
143 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
144 rt_tendf
145
146 ! LOCAL VARS
147
148 INTEGER :: i,j,k
149
150 CALL add_a2a(rt_tendf,RTHRATEN,config_flags, &
151 ids,ide, jds, jde, kds, kde, &
152 ims, ime, jms, jme, kms, kme, &
153 its, ite, jts, jte, kts, kte )
154
155 END SUBROUTINE phy_ra_ten
156
157 !=================================================================
158 SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
159 rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
160 scalar_tendf,adv_moist_cond, &
161 RTHBLTEN,RUBLTEN,RVBLTEN, &
162 RQVBLTEN,RQCBLTEN,RQIBLTEN, &
163 ids, ide, jds, jde, kds, kde, &
164 ims, ime, jms, jme, kms, kme, &
165 its, ite, jts, jte, kts, kte )
166 !-----------------------------------------------------------------
167 IMPLICIT NONE
168 !-----------------------------------------------------------------
169 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
170
171 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
172 ims, ime, jms, jme, kms, kme, &
173 its, ite, jts, jte, kts, kte, &
174 n_moist, n_scalar, rk_step
175
176 LOGICAL , INTENT(IN) :: adv_moist_cond
177
178 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
179 INTENT(INOUT) :: moist_tendf
180
181 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
182 INTENT(INOUT) :: scalar_tendf
183
184 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
185 RTHBLTEN, &
186 RUBLTEN, &
187 RVBLTEN, &
188 RQVBLTEN, &
189 RQCBLTEN, &
190 RQIBLTEN
191
192 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
193 rt_tendf, &
194 ru_tendf, &
195 rv_tendf
196 ! LOCAL VARS
197
198 INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
199
200 !-----------------------------------------------------------------
201
202 SELECT CASE(config_flags%bl_pbl_physics)
203
204 CASE (YSUSCHEME)
205
206 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
207 ids,ide, jds, jde, kds, kde, &
208 ims, ime, jms, jme, kms, kme, &
209 its, ite, jts, jte, kts, kte )
210
211 CALL add_a2c_u(ru_tendf,RUBLTEN,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 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
217 ids,ide, jds, jde, kds, kde, &
218 ims, ime, jms, jme, kms, kme, &
219 its, ite, jts, jte, kts, kte )
220
221 if (P_QV .ge. PARAM_FIRST_SCALAR) &
222 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
223 config_flags, &
224 ids,ide, jds, jde, kds, kde, &
225 ims, ime, jms, jme, kms, kme, &
226 its, ite, jts, jte, kts, kte )
227
228 if (P_QC .ge. PARAM_FIRST_SCALAR) &
229 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
230 config_flags, &
231 ids,ide, jds, jde, kds, kde, &
232 ims, ime, jms, jme, kms, kme, &
233 its, ite, jts, jte, kts, kte )
234
235 if (P_QI .ge. PARAM_FIRST_SCALAR) &
236 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
237 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 IF(.not. adv_moist_cond)THEN
243
244 if (P_QT .ge. PARAM_FIRST_SCALAR) &
245 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
246 config_flags, &
247 ids,ide, jds, jde, kds, kde, &
248 ims, ime, jms, jme, kms, kme, &
249 its, ite, jts, jte, kts, kte )
250
251 if (P_QT .ge. PARAM_FIRST_SCALAR) &
252 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
253 config_flags, &
254 ids,ide, jds, jde, kds, kde, &
255 ims, ime, jms, jme, kms, kme, &
256 its, ite, jts, jte, kts, kte )
257 ENDIF
258
259 CASE (MRFSCHEME)
260
261 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
262 ids,ide, jds, jde, kds, kde, &
263 ims, ime, jms, jme, kms, kme, &
264 its, ite, jts, jte, kts, kte )
265
266 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
267 ids,ide, jds, jde, kds, kde, &
268 ims, ime, jms, jme, kms, kme, &
269 its, ite, jts, jte, kts, kte )
270
271 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
272 ids,ide, jds, jde, kds, kde, &
273 ims, ime, jms, jme, kms, kme, &
274 its, ite, jts, jte, kts, kte )
275
276 if (P_QV .ge. PARAM_FIRST_SCALAR) &
277 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
278 config_flags, &
279 ids,ide, jds, jde, kds, kde, &
280 ims, ime, jms, jme, kms, kme, &
281 its, ite, jts, jte, kts, kte )
282
283 if (P_QC .ge. PARAM_FIRST_SCALAR) &
284 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
285 config_flags, &
286 ids,ide, jds, jde, kds, kde, &
287 ims, ime, jms, jme, kms, kme, &
288 its, ite, jts, jte, kts, kte )
289
290 if (P_QI .ge. PARAM_FIRST_SCALAR) &
291 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
292 config_flags, &
293 ids,ide, jds, jde, kds, kde, &
294 ims, ime, jms, jme, kms, kme, &
295 its, ite, jts, jte, kts, kte )
296
297 IF(.not. adv_moist_cond)THEN
298
299 if (P_QT .ge. PARAM_FIRST_SCALAR) &
300 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
301 config_flags, &
302 ids,ide, jds, jde, kds, kde, &
303 ims, ime, jms, jme, kms, kme, &
304 its, ite, jts, jte, kts, kte )
305
306 if (P_QT .ge. PARAM_FIRST_SCALAR) &
307 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
308 config_flags, &
309 ids,ide, jds, jde, kds, kde, &
310 ims, ime, jms, jme, kms, kme, &
311 its, ite, jts, jte, kts, kte )
312 ENDIF
313
314 CASE (MYJPBLSCHEME)
315
316 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
317 ids,ide, jds, jde, kds, kde, &
318 ims, ime, jms, jme, kms, kme, &
319 its, ite, jts, jte, kts, kte )
320
321 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
322 ids,ide, jds, jde, kds, kde, &
323 ims, ime, jms, jme, kms, kme, &
324 its, ite, jts, jte, kts, kte )
325
326 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
327 ids,ide, jds, jde, kds, kde, &
328 ims, ime, jms, jme, kms, kme, &
329 its, ite, jts, jte, kts, kte )
330
331 if (P_QV .ge. PARAM_FIRST_SCALAR) &
332 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
333 config_flags, &
334 ids,ide, jds, jde, kds, kde, &
335 ims, ime, jms, jme, kms, kme, &
336 its, ite, jts, jte, kts, kte )
337
338 IF(.not. adv_moist_cond)THEN
339
340 if (P_QT .ge. PARAM_FIRST_SCALAR) &
341 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
342 config_flags, &
343 ids,ide, jds, jde, kds, kde, &
344 ims, ime, jms, jme, kms, kme, &
345 its, ite, jts, jte, kts, kte )
346
347 ENDIF
348
349 CASE (GFSSCHEME)
350
351 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
352 ids,ide, jds, jde, kds, kde, &
353 ims, ime, jms, jme, kms, kme, &
354 its, ite, jts, jte, kts, kte )
355
356 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
357 ids,ide, jds, jde, kds, kde, &
358 ims, ime, jms, jme, kms, kme, &
359 its, ite, jts, jte, kts, kte )
360
361 CALL add_a2c_v(rv_tendf,RVBLTEN,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_QV .ge. PARAM_FIRST_SCALAR) &
367 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
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_QC .ge. PARAM_FIRST_SCALAR) &
374 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
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_QI .ge. PARAM_FIRST_SCALAR) &
381 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
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(.not. adv_moist_cond)THEN
388
389 if (P_QT .ge. PARAM_FIRST_SCALAR) &
390 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
391 config_flags, &
392 ids,ide, jds, jde, kds, kde, &
393 ims, ime, jms, jme, kms, kme, &
394 its, ite, jts, jte, kts, kte )
395
396 if (P_QT .ge. PARAM_FIRST_SCALAR) &
397 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
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 ENDIF
403
404 CASE DEFAULT
405
406 print*,'phy_bl_ten: The pbl scheme does not exist'
407
408 END SELECT
409
410 END SUBROUTINE phy_bl_ten
411
412 !=================================================================
413 SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, &
414 RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
415 RQICUTEN,RQSCUTEN,moist_tendf, &
416 ids, ide, jds, jde, kds, kde, &
417 ims, ime, jms, jme, kms, kme, &
418 its, ite, jts, jte, kts, kte )
419 !-----------------------------------------------------------------
420 IMPLICIT NONE
421 !-----------------------------------------------------------------
422 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
423
424 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
425 ims, ime, jms, jme, kms, kme, &
426 its, ite, jts, jte, kts, kte, &
427 n_moist, rk_step
428
429 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
430 INTENT(INOUT) :: moist_tendf
431
432 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
433 RTHCUTEN, &
434 RQVCUTEN, &
435 RQCCUTEN, &
436 RQRCUTEN, &
437 RQICUTEN, &
438 RQSCUTEN
439
440 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
441 rt_tendf
442
443 ! LOCAL VARS
444
445 INTEGER :: i,j,k
446
447 SELECT CASE (config_flags%cu_physics)
448
449 CASE (KFSCHEME)
450 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
451 ids,ide, jds, jde, kds, kde, &
452 ims, ime, jms, jme, kms, kme, &
453 its, ite, jts, jte, kts, kte )
454
455 if (P_QV .ge. PARAM_FIRST_SCALAR) &
456 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
457 config_flags, &
458 ids,ide, jds, jde, kds, kde, &
459 ims, ime, jms, jme, kms, kme, &
460 its, ite, jts, jte, kts, kte )
461
462 if (P_QC .ge. PARAM_FIRST_SCALAR) &
463 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
464 config_flags, &
465 ids,ide, jds, jde, kds, kde, &
466 ims, ime, jms, jme, kms, kme, &
467 its, ite, jts, jte, kts, kte )
468
469 if (P_QR .ge. PARAM_FIRST_SCALAR) &
470 CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
471 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_QI .ge. PARAM_FIRST_SCALAR) &
477 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
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_QS .ge. PARAM_FIRST_SCALAR) &
484 CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
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 CASE (BMJSCHEME)
491 CALL add_a2a(rt_tendf,RTHCUTEN, &
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 if (P_QV .ge. PARAM_FIRST_SCALAR) &
498 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
499 config_flags, &
500 ids,ide, jds, jde, kds, kde, &
501 ims, ime, jms, jme, kms, kme, &
502 its, ite, jts, jte, kts, kte )
503
504 CASE (KFETASCHEME)
505 CALL add_a2a(rt_tendf,RTHCUTEN,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_QV .ge. PARAM_FIRST_SCALAR) &
511 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
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_QC .ge. PARAM_FIRST_SCALAR) &
518 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
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 if (P_QR .ge. PARAM_FIRST_SCALAR) &
525 CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
526 config_flags, &
527 ids,ide, jds, jde, kds, kde, &
528 ims, ime, jms, jme, kms, kme, &
529 its, ite, jts, jte, kts, kte )
530
531 if (P_QI .ge. PARAM_FIRST_SCALAR) &
532 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
533 config_flags, &
534 ids,ide, jds, jde, kds, kde, &
535 ims, ime, jms, jme, kms, kme, &
536 its, ite, jts, jte, kts, kte )
537
538 if (P_QS .ge. PARAM_FIRST_SCALAR) &
539 CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
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 CASE (GDSCHEME)
546 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
547 ids,ide, jds, jde, kds, kde, &
548 ims, ime, jms, jme, kms, kme, &
549 its, ite, jts, jte, kts, kte )
550
551 if (P_QV .ge. PARAM_FIRST_SCALAR) &
552 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
553 config_flags, &
554 ids,ide, jds, jde, kds, kde, &
555 ims, ime, jms, jme, kms, kme, &
556 its, ite, jts, jte, kts, kte )
557
558 if (P_QC .ge. PARAM_FIRST_SCALAR) &
559 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
560 config_flags, &
561 ids,ide, jds, jde, kds, kde, &
562 ims, ime, jms, jme, kms, kme, &
563 its, ite, jts, jte, kts, kte )
564
565 if (P_QI .ge. PARAM_FIRST_SCALAR) &
566 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
567 config_flags, &
568 ids,ide, jds, jde, kds, kde, &
569 ims, ime, jms, jme, kms, kme, &
570 its, ite, jts, jte, kts, kte )
571
572 CASE (SASSCHEME)
573 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
574 ids,ide, jds, jde, kds, kde, &
575 ims, ime, jms, jme, kms, kme, &
576 its, ite, jts, jte, kts, kte )
577
578 if (P_QV .ge. PARAM_FIRST_SCALAR) &
579 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
580 config_flags, &
581 ids,ide, jds, jde, kds, kde, &
582 ims, ime, jms, jme, kms, kme, &
583 its, ite, jts, jte, kts, kte )
584
585 if (P_QC .ge. PARAM_FIRST_SCALAR) &
586 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
587 config_flags, &
588 ids,ide, jds, jde, kds, kde, &
589 ims, ime, jms, jme, kms, kme, &
590 its, ite, jts, jte, kts, kte )
591
592 if (P_QI .ge. PARAM_FIRST_SCALAR) &
593 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
594 config_flags, &
595 ids,ide, jds, jde, kds, kde, &
596 ims, ime, jms, jme, kms, kme, &
597 its, ite, jts, jte, kts, kte )
598
599 CASE DEFAULT
600
601 END SELECT
602
603 END SUBROUTINE phy_cu_ten
604
605 !=================================================================
606 SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, &
607 rt_tendf,ru_tendf,rv_tendf, &
608 mu_tendf, moist_tendf, &
609 RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
610 RQVNDGDTEN,RMUNDGDTEN, &
611 ids, ide, jds, jde, kds, kde, &
612 ims, ime, jms, jme, kms, kme, &
613 its, ite, jts, jte, kts, kte )
614 !-----------------------------------------------------------------
615 IMPLICIT NONE
616 !-----------------------------------------------------------------
617 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
618
619 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
620 ims, ime, jms, jme, kms, kme, &
621 its, ite, jts, jte, kts, kte, &
622 n_moist, rk_step
623
624 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
625 INTENT(INOUT) :: moist_tendf
626
627 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
628 RTHNDGDTEN, &
629 RUNDGDTEN, &
630 RVNDGDTEN, &
631 RQVNDGDTEN
632
633 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
634
635 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
636 rt_tendf, &
637 ru_tendf, &
638 rv_tendf
639
640 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
641
642 ! LOCAL VARS
643
644 INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
645
646 !-----------------------------------------------------------------
647
648 SELECT CASE(config_flags%grid_fdda)
649
650 CASE (PSUFDDAGD)
651
652 CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
653 ids,ide, jds, jde, kds, kde, &
654 ims, ime, jms, jme, kms, kme, &
655 its, ite, jts, jte, kts, kte )
656
657 ! note fdda u and v tendencies are staggered
658 CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
659 ids,ide, jds, jde, kds, kde, &
660 ims, ime, jms, jme, kms, kme, &
661 its, ite, jts, jte, kts, kte )
662
663 CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
664 ids,ide, jds, jde, kds, kde, &
665 ims, ime, jms, jme, kms, kme, &
666 its, ite, jts, jte, kts, kte )
667
668 CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, &
669 ids,ide, jds, jde, kds, kds, &
670 ims, ime, jms, jme, kms, kms, &
671 its, ite, jts, jte, kts, kts )
672
673 if (P_QV .ge. PARAM_FIRST_SCALAR) &
674 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, &
675 config_flags, &
676 ids,ide, jds, jde, kds, kde, &
677 ims, ime, jms, jme, kms, kme, &
678 its, ite, jts, jte, kts, kte )
679
680
681 CASE DEFAULT
682
683 END SELECT
684
685 END SUBROUTINE phy_fg_ten
686
687 !----------------------------------------------------------------------
688 SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
689 RQICUTEN,RQSCUTEN,RAINC,RAINCV,NCA, &
690 HTOP,HBOT,CUTOP,CUBOT, &
691 CUPPT, config_flags, &
692 ids,ide, jds,jde, kds,kde, &
693 ims,ime, jms,jme, kms,kme, &
694 its,ite, jts,jte, kts,kte )
695 !----------------------------------------------------------------------
696 USE module_state_description
697 USE module_cu_kf
698 USE module_cu_kfeta
699 !----------------------------------------------------------------------
700 IMPLICIT NONE
701 !----------------------------------------------------------------------
702 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
703
704 INTEGER, INTENT(IN ) :: &
705 ids,ide, jds,jde, kds,kde, &
706 ims,ime, jms,jme, kms,kme, &
707 its,ite, jts,jte, kts,kte
708
709
710 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
711 INTENT(INOUT) :: RTHCUTEN, &
712 RQVCUTEN, &
713 RQCCUTEN, &
714 RQRCUTEN, &
715 RQICUTEN, &
716 RQSCUTEN
717
718 REAL, DIMENSION( ims:ime , jms:jme ), &
719 INTENT(INOUT) :: RAINC, &
720 RAINCV, &
721 NCA, &
722 HTOP, &
723 HBOT, &
724 CUTOP, &
725 CUBOT, &
726 CUPPT
727
728 ! LOCAL VAR
729
730 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
731 INTEGER :: NCUTOP, NCUBOT
732
733 !-----------------------------------------------------------------
734
735 IF (config_flags%cu_physics .eq. 0) return
736
737 ! SET START AND END POINTS FOR TILES
738
739 i_start = its
740 i_end = min( ite,ide-1 )
741 j_start = jts
742 j_end = min( jte,jde-1 )
743 !
744 ! IF( config_flags%nested .or. config_flags%specified ) THEN
745 ! i_start = max( its,ids+1 )
746 ! i_end = min( ite,ide-2 )
747 ! j_start = max( jts,jds+1 )
748 ! j_end = min( jte,jde-2 )
749 ! ENDIF
750 !
751 k_start = kts
752 k_end = min( kte, kde-1 )
753
754 ! Update total cumulus scheme precipitation
755
756 ! in mm
757
758 DO J = j_start,j_end
759 DO i = i_start,i_end
760 RAINC(I,J)=RAINC(I,J)+RAINCV(I,J)
761 CUPPT(I,J)=CUPPT(I,J)+RAINCV(I,J)/1000.
762 ENDDO
763 ENDDO
764
765 SELECT CASE (config_flags%cu_physics)
766
767 CASE (KFSCHEME)
768
769 DO J = j_start,j_end
770 DO i = i_start,i_end
771
772 IF ( NINT(NCA(I,J)).GT. 0 ) THEN
773
774 IF ( NINT(NCA(I,J)) .eq. 1 ) THEN
775
776 ! set tendency to zero
777 RAINCV(I,J)=0.
778 DO k = k_start,k_end
779 RTHCUTEN(i,k,j)=0.
780 RQVCUTEN(i,k,j)=0.
781 RQCCUTEN(i,k,j)=0.
782 RQRCUTEN(i,k,j)=0.
783 if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
784 if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
785 ENDDO
786 ENDIF
787
788 NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
789
790 ENDIF
791 !
792 ENDDO
793 ENDDO
794
795 CASE (BMJSCHEME)
796
797 DO J = j_start,j_end
798 DO i = i_start,i_end
799
800 ! HTOP, HBOT FOR GFDL RADIATION
801 NCUTOP=NINT(CUTOP(I,J))
802 NCUBOT=NINT(CUBOT(I,J))
803 IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
804 HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
805 ENDIF
806 IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
807 HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
808 ENDIF
809
810 ENDDO
811 ENDDO
812
813 CASE (KFETASCHEME)
814
815 DO J = j_start,j_end
816 DO i = i_start,i_end
817
818 ! HTOP, HBOT FOR GFDL RADIATION
819 NCUTOP=NINT(CUTOP(I,J))
820 NCUBOT=NINT(CUBOT(I,J))
821 IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
822 HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
823 ENDIF
824 IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
825 HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
826 ENDIF
827
828 IF ( NINT(NCA(I,J)).GT. 0 ) THEN
829
830 IF ( NINT(NCA(I,J)) .eq. 1 ) THEN
831
832 ! set tendency to zero
833 RAINCV(I,J)=0.
834 DO k = k_start,k_end
835 RTHCUTEN(i,k,j)=0.
836 RQVCUTEN(i,k,j)=0.
837 RQCCUTEN(i,k,j)=0.
838 RQRCUTEN(i,k,j)=0.
839 if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
840 if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
841 ENDDO
842 ENDIF
843
844 NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
845
846 ENDIF
847 !
848 ENDDO
849 ENDDO
850
851 CASE DEFAULT
852
853 END SELECT
854
855 END SUBROUTINE advance_ppt
856
857 SUBROUTINE add_a2a(lvar,rvar,config_flags, &
858 ids,ide, jds, jde, kds, kde, &
859 ims, ime, jms, jme, kms, kme, &
860 its, ite, jts, jte, kts, kte )
861 !------------------------------------------------------------
862 IMPLICIT NONE
863 !------------------------------------------------------------
864 TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
865
866 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
867 ims, ime, jms, jme, kms, kme, &
868 its, ite, jts, jte, kts, kte
869
870 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
871 rvar
872 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
873 lvar
874
875 ! LOCAL VARS
876 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
877
878 i_start = its
879 i_end = MIN(ite,ide-1)
880 j_start = jts
881 j_end = MIN(jte,jde-1)
882 ktf = min(kte,kde-1)
883
884 IF ( config_flags%specified .or. &
885 config_flags%nested) i_start = MAX(ids+1,its)
886 IF ( config_flags%specified .or. &
887 config_flags%nested) i_end = MIN(ide-2,ite)
888 IF ( config_flags%specified .or. &
889 config_flags%nested) j_start = MAX(jds+1,jts)
890 IF ( config_flags%specified .or. &
891 config_flags%nested) j_end = MIN(jde-2,jte)
892 IF ( config_flags%periodic_x ) i_start = its
893 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
894
895 DO j = j_start,j_end
896 DO k = kts,ktf
897 DO i = i_start,i_end
898 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
899 ENDDO
900 ENDDO
901 ENDDO
902
903 END SUBROUTINE add_a2a
904
905 !------------------------------------------------------------
906 SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
907 ids,ide, jds, jde, kds, kde, &
908 ims, ime, jms, jme, kms, kme, &
909 its, ite, jts, jte, kts, kte )
910 !------------------------------------------------------------
911 !------------------------------------------------------------
912 IMPLICIT NONE
913 !------------------------------------------------------------
914
915 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
916
917 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
918 ims, ime, jms, jme, kms, kme, &
919 its, ite, jts, jte, kts, kte
920
921 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
922 rvar
923 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
924 lvar
925
926 ! LOCAL VARS
927
928 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
929
930 ktf=min(kte,kde-1)
931
932 i_start = its
933 i_end = ite
934 j_start = jts
935 j_end = MIN(jte,jde-1)
936
937 IF ( config_flags%specified .or. &
938 config_flags%nested) i_start = MAX(ids+1,its)
939 IF ( config_flags%specified .or. &
940 config_flags%nested) i_end = MIN(ide-1,ite)
941 IF ( config_flags%specified .or. &
942 config_flags%nested) j_start = MAX(jds+1,jts)
943 IF ( config_flags%specified .or. &
944 config_flags%nested) j_end = MIN(jde-2,jte)
945 IF ( config_flags%periodic_x ) i_start = its
946 IF ( config_flags%periodic_x ) i_end = ite
947
948 DO j = j_start,j_end
949 DO k = kts,ktf
950 DO i = i_start,i_end
951 lvar(i,k,j) = lvar(i,k,j) + &
952 0.5*(rvar(i,k,j)+rvar(i-1,k,j))
953 ENDDO
954 ENDDO
955 ENDDO
956
957 END SUBROUTINE add_a2c_u
958
959 !------------------------------------------------------------
960 SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
961 ids,ide, jds, jde, kds, kde, &
962 ims, ime, jms, jme, kms, kme, &
963 its, ite, jts, jte, kts, kte )
964 !------------------------------------------------------------
965 !------------------------------------------------------------
966 IMPLICIT NONE
967 !------------------------------------------------------------
968
969 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
970
971 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
972 ims, ime, jms, jme, kms, kme, &
973 its, ite, jts, jte, kts, kte
974
975 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
976 rvar
977 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
978 lvar
979
980 ! LOCAL VARS
981
982 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
983
984 ktf=min(kte,kde-1)
985
986 i_start = its
987 i_end = MIN(ite,ide-1)
988 j_start = jts
989 j_end = jte
990
991 IF ( config_flags%specified .or. &
992 config_flags%nested) i_start = MAX(ids+1,its)
993 IF ( config_flags%specified .or. &
994 config_flags%nested) i_end = MIN(ide-2,ite)
995 IF ( config_flags%specified .or. &
996 config_flags%nested) j_start = MAX(jds+1,jts)
997 IF ( config_flags%specified .or. &
998 config_flags%nested) j_end = MIN(jde-1,jte)
999 IF ( config_flags%periodic_x ) i_start = its
1000 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1001
1002 DO j = j_start,j_end
1003 DO k = kts,kte
1004 DO i = i_start,i_end
1005 lvar(i,k,j) = lvar(i,k,j) + &
1006 0.5*(rvar(i,k,j)+rvar(i,k,j-1))
1007 ENDDO
1008 ENDDO
1009 ENDDO
1010
1011 END SUBROUTINE add_a2c_v
1012
1013 !------------------------------------------------------------
1014 SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
1015 ids,ide, jds, jde, kds, kde, &
1016 ims, ime, jms, jme, kms, kme, &
1017 its, ite, jts, jte, kts, kte )
1018 !------------------------------------------------------------
1019 !------------------------------------------------------------
1020 IMPLICIT NONE
1021 !------------------------------------------------------------
1022
1023 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1024
1025 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1026 ims, ime, jms, jme, kms, kme, &
1027 its, ite, jts, jte, kts, kte
1028
1029 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1030 rvar
1031 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1032 lvar
1033
1034 ! LOCAL VARS
1035
1036 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1037
1038 ktf=min(kte,kde-1)
1039
1040 i_start = its
1041 i_end = ite
1042 j_start = jts
1043 j_end = MIN(jte,jde-1)
1044
1045
1046 IF ( config_flags%specified .or. &
1047 config_flags%nested) i_start = MAX(ids+1,its)
1048 IF ( config_flags%specified .or. &
1049 config_flags%nested) i_end = MIN(ide-1,ite)
1050 IF ( config_flags%specified .or. &
1051 config_flags%nested) j_start = MAX(jds+1,jts)
1052 IF ( config_flags%specified .or. &
1053 config_flags%nested) j_end = MIN(jde-2,jte)
1054
1055 ! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1056
1057 DO j = j_start,j_end
1058 DO k = kts,ktf
1059 DO i = i_start,i_end
1060 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1061 ENDDO
1062 ENDDO
1063 ENDDO
1064
1065 END SUBROUTINE add_c2c_u
1066
1067 SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
1068 ids,ide, jds, jde, kds, kde, &
1069 ims, ime, jms, jme, kms, kme, &
1070 its, ite, jts, jte, kts, kte )
1071 !------------------------------------------------------------
1072 !------------------------------------------------------------
1073 IMPLICIT NONE
1074 !------------------------------------------------------------
1075
1076 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1077
1078 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1079 ims, ime, jms, jme, kms, kme, &
1080 its, ite, jts, jte, kts, kte
1081
1082 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1083 rvar
1084 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1085 lvar
1086
1087 ! LOCAL VARS
1088
1089 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1090
1091 ktf=min(kte,kde-1)
1092
1093 i_start = its
1094 i_end = MIN(ite,ide-1)
1095 j_start = jts
1096 j_end = jte
1097
1098 IF ( config_flags%specified .or. &
1099 config_flags%nested) i_start = MAX(ids+1,its)
1100 IF ( config_flags%specified .or. &
1101 config_flags%nested) i_end = MIN(ide-2,ite)
1102 IF ( config_flags%specified .or. &
1103 config_flags%nested) j_start = MAX(jds+1,jts)
1104 IF ( config_flags%specified .or. &
1105 config_flags%nested) j_end = MIN(jde-1,jte)
1106
1107 ! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1108
1109 DO j = j_start,j_end
1110 DO k = kts,kte
1111 DO i = i_start,i_end
1112 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1113 ENDDO
1114 ENDDO
1115 ENDDO
1116
1117 END SUBROUTINE add_c2c_v
1118
1119 #endif
1120
1121 END MODULE module_physics_addtendc