1 !WRF:MODEL_LAYER: PHYSICS
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
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
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
19 MODULE module_physics_addtendc
23 USE module_state_description
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, &
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 !-------------------------------------------------------------------
41 !-------------------------------------------------------------------
43 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
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
50 LOGICAL , INTENT(IN) :: adv_moist_cond
52 REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: &
57 REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf
59 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
60 INTENT(INOUT) :: moist_tendf
62 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
63 INTENT(INOUT) :: scalar_tendf
65 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
84 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
85 !------------------------------------------------------------------
87 ! set up loop bounds for this grid's boundary conditions
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 )
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 )
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 )
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 )
124 END SUBROUTINE update_phy_ten
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 !-----------------------------------------------------------------
133 !-----------------------------------------------------------------
134 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
136 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
137 ims, ime, jms, jme, kms, kme, &
138 its, ite, jts, jte, kts, kte
140 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
143 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
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 )
155 END SUBROUTINE phy_ra_ten
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 !-----------------------------------------------------------------
168 !-----------------------------------------------------------------
169 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
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
176 LOGICAL , INTENT(IN) :: adv_moist_cond
178 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
179 INTENT(INOUT) :: moist_tendf
181 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
182 INTENT(INOUT) :: scalar_tendf
184 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
192 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
198 INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
200 !-----------------------------------------------------------------
202 SELECT CASE(config_flags%bl_pbl_physics)
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 )
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 )
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 )
221 if (P_QV .ge. PARAM_FIRST_SCALAR) &
222 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
224 ids,ide, jds, jde, kds, kde, &
225 ims, ime, jms, jme, kms, kme, &
226 its, ite, jts, jte, kts, kte )
228 if (P_QC .ge. PARAM_FIRST_SCALAR) &
229 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
231 ids,ide, jds, jde, kds, kde, &
232 ims, ime, jms, jme, kms, kme, &
233 its, ite, jts, jte, kts, kte )
235 if (P_QI .ge. PARAM_FIRST_SCALAR) &
236 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
238 ids,ide, jds, jde, kds, kde, &
239 ims, ime, jms, jme, kms, kme, &
240 its, ite, jts, jte, kts, kte )
242 IF(.not. adv_moist_cond)THEN
244 if (P_QT .ge. PARAM_FIRST_SCALAR) &
245 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
247 ids,ide, jds, jde, kds, kde, &
248 ims, ime, jms, jme, kms, kme, &
249 its, ite, jts, jte, kts, kte )
251 if (P_QT .ge. PARAM_FIRST_SCALAR) &
252 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
254 ids,ide, jds, jde, kds, kde, &
255 ims, ime, jms, jme, kms, kme, &
256 its, ite, jts, jte, kts, kte )
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 )
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 )
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 )
276 if (P_QV .ge. PARAM_FIRST_SCALAR) &
277 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
279 ids,ide, jds, jde, kds, kde, &
280 ims, ime, jms, jme, kms, kme, &
281 its, ite, jts, jte, kts, kte )
283 if (P_QC .ge. PARAM_FIRST_SCALAR) &
284 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
286 ids,ide, jds, jde, kds, kde, &
287 ims, ime, jms, jme, kms, kme, &
288 its, ite, jts, jte, kts, kte )
290 if (P_QI .ge. PARAM_FIRST_SCALAR) &
291 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
293 ids,ide, jds, jde, kds, kde, &
294 ims, ime, jms, jme, kms, kme, &
295 its, ite, jts, jte, kts, kte )
297 IF(.not. adv_moist_cond)THEN
299 if (P_QT .ge. PARAM_FIRST_SCALAR) &
300 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
302 ids,ide, jds, jde, kds, kde, &
303 ims, ime, jms, jme, kms, kme, &
304 its, ite, jts, jte, kts, kte )
306 if (P_QT .ge. PARAM_FIRST_SCALAR) &
307 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
309 ids,ide, jds, jde, kds, kde, &
310 ims, ime, jms, jme, kms, kme, &
311 its, ite, jts, jte, kts, kte )
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 )
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 )
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 )
331 if (P_QV .ge. PARAM_FIRST_SCALAR) &
332 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
334 ids,ide, jds, jde, kds, kde, &
335 ims, ime, jms, jme, kms, kme, &
336 its, ite, jts, jte, kts, kte )
338 if (P_QC .ge. PARAM_FIRST_SCALAR) &
339 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
341 ids,ide, jds, jde, kds, kde, &
342 ims, ime, jms, jme, kms, kme, &
343 its, ite, jts, jte, kts, kte )
345 if (P_QI .ge. PARAM_FIRST_SCALAR) &
346 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
348 ids,ide, jds, jde, kds, kde, &
349 ims, ime, jms, jme, kms, kme, &
350 its, ite, jts, jte, kts, kte )
352 IF(.not. adv_moist_cond)THEN
354 if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
355 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
357 ids,ide, jds, jde, kds, kde, &
358 ims, ime, jms, jme, kms, kme, &
359 its, ite, jts, jte, kts, kte )
361 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
363 ids,ide, jds, jde, kds, kde, &
364 ims, ime, jms, jme, kms, kme, &
365 its, ite, jts, jte, kts, kte )
372 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
373 ids,ide, jds, jde, kds, kde, &
374 ims, ime, jms, jme, kms, kme, &
375 its, ite, jts, jte, kts, kte )
377 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
378 ids,ide, jds, jde, kds, kde, &
379 ims, ime, jms, jme, kms, kme, &
380 its, ite, jts, jte, kts, kte )
382 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
383 ids,ide, jds, jde, kds, kde, &
384 ims, ime, jms, jme, kms, kme, &
385 its, ite, jts, jte, kts, kte )
387 if (P_QV .ge. PARAM_FIRST_SCALAR) &
388 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
390 ids,ide, jds, jde, kds, kde, &
391 ims, ime, jms, jme, kms, kme, &
392 its, ite, jts, jte, kts, kte )
394 IF(.not. adv_moist_cond)THEN
396 if (P_QT .ge. PARAM_FIRST_SCALAR) &
397 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
399 ids,ide, jds, jde, kds, kde, &
400 ims, ime, jms, jme, kms, kme, &
401 its, ite, jts, jte, kts, kte )
405 if (P_QC .ge. PARAM_FIRST_SCALAR) &
406 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
408 ids,ide, jds, jde, kds, kde, &
409 ims, ime, jms, jme, kms, kme, &
410 its, ite, jts, jte, kts, kte )
416 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
417 ids,ide, jds, jde, kds, kde, &
418 ims, ime, jms, jme, kms, kme, &
419 its, ite, jts, jte, kts, kte )
421 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
422 ids,ide, jds, jde, kds, kde, &
423 ims, ime, jms, jme, kms, kme, &
424 its, ite, jts, jte, kts, kte )
426 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
427 ids,ide, jds, jde, kds, kde, &
428 ims, ime, jms, jme, kms, kme, &
429 its, ite, jts, jte, kts, kte )
431 if (P_QV .ge. PARAM_FIRST_SCALAR) &
432 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
434 ids,ide, jds, jde, kds, kde, &
435 ims, ime, jms, jme, kms, kme, &
436 its, ite, jts, jte, kts, kte )
438 if (P_QC .ge. PARAM_FIRST_SCALAR) &
439 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
441 ids,ide, jds, jde, kds, kde, &
442 ims, ime, jms, jme, kms, kme, &
443 its, ite, jts, jte, kts, kte )
445 if (P_QI .ge. PARAM_FIRST_SCALAR) &
446 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
448 ids,ide, jds, jde, kds, kde, &
449 ims, ime, jms, jme, kms, kme, &
450 its, ite, jts, jte, kts, kte )
452 IF(.not. adv_moist_cond)THEN
454 if (P_QT .ge. PARAM_FIRST_SCALAR) &
455 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
457 ids,ide, jds, jde, kds, kde, &
458 ims, ime, jms, jme, kms, kme, &
459 its, ite, jts, jte, kts, kte )
461 if (P_QT .ge. PARAM_FIRST_SCALAR) &
462 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
464 ids,ide, jds, jde, kds, kde, &
465 ims, ime, jms, jme, kms, kme, &
466 its, ite, jts, jte, kts, kte )
471 print*,'phy_bl_ten: The pbl scheme does not exist'
475 END SUBROUTINE phy_bl_ten
477 !=================================================================
478 SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, &
479 RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
480 RQICUTEN,RQSCUTEN,moist_tendf, &
481 ids, ide, jds, jde, kds, kde, &
482 ims, ime, jms, jme, kms, kme, &
483 its, ite, jts, jte, kts, kte )
484 !-----------------------------------------------------------------
486 !-----------------------------------------------------------------
487 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
489 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
490 ims, ime, jms, jme, kms, kme, &
491 its, ite, jts, jte, kts, kte, &
494 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
495 INTENT(INOUT) :: moist_tendf
497 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
505 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
512 SELECT CASE (config_flags%cu_physics)
515 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
516 ids,ide, jds, jde, kds, kde, &
517 ims, ime, jms, jme, kms, kme, &
518 its, ite, jts, jte, kts, kte )
520 if (P_QV .ge. PARAM_FIRST_SCALAR) &
521 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
523 ids,ide, jds, jde, kds, kde, &
524 ims, ime, jms, jme, kms, kme, &
525 its, ite, jts, jte, kts, kte )
527 if (P_QC .ge. PARAM_FIRST_SCALAR) &
528 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
530 ids,ide, jds, jde, kds, kde, &
531 ims, ime, jms, jme, kms, kme, &
532 its, ite, jts, jte, kts, kte )
534 if (P_QR .ge. PARAM_FIRST_SCALAR) &
535 CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
537 ids,ide, jds, jde, kds, kde, &
538 ims, ime, jms, jme, kms, kme, &
539 its, ite, jts, jte, kts, kte )
541 if (P_QI .ge. PARAM_FIRST_SCALAR) &
542 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
544 ids,ide, jds, jde, kds, kde, &
545 ims, ime, jms, jme, kms, kme, &
546 its, ite, jts, jte, kts, kte )
548 if (P_QS .ge. PARAM_FIRST_SCALAR) &
549 CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
551 ids,ide, jds, jde, kds, kde, &
552 ims, ime, jms, jme, kms, kme, &
553 its, ite, jts, jte, kts, kte )
556 CALL add_a2a(rt_tendf,RTHCUTEN, &
558 ids,ide, jds, jde, kds, kde, &
559 ims, ime, jms, jme, kms, kme, &
560 its, ite, jts, jte, kts, kte )
562 if (P_QV .ge. PARAM_FIRST_SCALAR) &
563 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
565 ids,ide, jds, jde, kds, kde, &
566 ims, ime, jms, jme, kms, kme, &
567 its, ite, jts, jte, kts, kte )
570 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
571 ids,ide, jds, jde, kds, kde, &
572 ims, ime, jms, jme, kms, kme, &
573 its, ite, jts, jte, kts, kte )
575 if (P_QV .ge. PARAM_FIRST_SCALAR) &
576 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
578 ids,ide, jds, jde, kds, kde, &
579 ims, ime, jms, jme, kms, kme, &
580 its, ite, jts, jte, kts, kte )
582 if (P_QC .ge. PARAM_FIRST_SCALAR) &
583 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
585 ids,ide, jds, jde, kds, kde, &
586 ims, ime, jms, jme, kms, kme, &
587 its, ite, jts, jte, kts, kte )
589 if (P_QR .ge. PARAM_FIRST_SCALAR) &
590 CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
592 ids,ide, jds, jde, kds, kde, &
593 ims, ime, jms, jme, kms, kme, &
594 its, ite, jts, jte, kts, kte )
596 if (P_QI .ge. PARAM_FIRST_SCALAR) &
597 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
599 ids,ide, jds, jde, kds, kde, &
600 ims, ime, jms, jme, kms, kme, &
601 its, ite, jts, jte, kts, kte )
603 if (P_QS .ge. PARAM_FIRST_SCALAR) &
604 CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
606 ids,ide, jds, jde, kds, kde, &
607 ims, ime, jms, jme, kms, kme, &
608 its, ite, jts, jte, kts, kte )
610 CASE (GDSCHEME, G3SCHEME)
611 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
612 ids,ide, jds, jde, kds, kde, &
613 ims, ime, jms, jme, kms, kme, &
614 its, ite, jts, jte, kts, kte )
616 if (P_QV .ge. PARAM_FIRST_SCALAR) &
617 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
619 ids,ide, jds, jde, kds, kde, &
620 ims, ime, jms, jme, kms, kme, &
621 its, ite, jts, jte, kts, kte )
623 if (P_QC .ge. PARAM_FIRST_SCALAR) &
624 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
626 ids,ide, jds, jde, kds, kde, &
627 ims, ime, jms, jme, kms, kme, &
628 its, ite, jts, jte, kts, kte )
630 if (P_QI .ge. PARAM_FIRST_SCALAR) &
631 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
633 ids,ide, jds, jde, kds, kde, &
634 ims, ime, jms, jme, kms, kme, &
635 its, ite, jts, jte, kts, kte )
638 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
639 ids,ide, jds, jde, kds, kde, &
640 ims, ime, jms, jme, kms, kme, &
641 its, ite, jts, jte, kts, kte )
643 if (P_QV .ge. PARAM_FIRST_SCALAR) &
644 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
646 ids,ide, jds, jde, kds, kde, &
647 ims, ime, jms, jme, kms, kme, &
648 its, ite, jts, jte, kts, kte )
650 if (P_QC .ge. PARAM_FIRST_SCALAR) &
651 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
653 ids,ide, jds, jde, kds, kde, &
654 ims, ime, jms, jme, kms, kme, &
655 its, ite, jts, jte, kts, kte )
657 if (P_QI .ge. PARAM_FIRST_SCALAR) &
658 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
660 ids,ide, jds, jde, kds, kde, &
661 ims, ime, jms, jme, kms, kme, &
662 its, ite, jts, jte, kts, kte )
668 END SUBROUTINE phy_cu_ten
670 !=================================================================
671 SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, &
672 rt_tendf,ru_tendf,rv_tendf, &
673 mu_tendf, moist_tendf, &
674 RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
675 RQVNDGDTEN,RMUNDGDTEN, &
676 ids, ide, jds, jde, kds, kde, &
677 ims, ime, jms, jme, kms, kme, &
678 its, ite, jts, jte, kts, kte )
679 !-----------------------------------------------------------------
681 !-----------------------------------------------------------------
682 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
684 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
685 ims, ime, jms, jme, kms, kme, &
686 its, ite, jts, jte, kts, kte, &
689 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
690 INTENT(INOUT) :: moist_tendf
692 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
698 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
700 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
705 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
709 INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
711 !-----------------------------------------------------------------
713 SELECT CASE(config_flags%grid_fdda)
717 CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
718 ids,ide, jds, jde, kds, kde, &
719 ims, ime, jms, jme, kms, kme, &
720 its, ite, jts, jte, kts, kte )
722 ! note fdda u and v tendencies are staggered
723 CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
724 ids,ide, jds, jde, kds, kde, &
725 ims, ime, jms, jme, kms, kme, &
726 its, ite, jts, jte, kts, kte )
728 CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
729 ids,ide, jds, jde, kds, kde, &
730 ims, ime, jms, jme, kms, kme, &
731 its, ite, jts, jte, kts, kte )
733 CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, &
734 ids,ide, jds, jde, kds, kds, &
735 ims, ime, jms, jme, kms, kms, &
736 its, ite, jts, jte, kts, kts )
738 if (P_QV .ge. PARAM_FIRST_SCALAR) &
739 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, &
741 ids,ide, jds, jde, kds, kde, &
742 ims, ime, jms, jme, kms, kme, &
743 its, ite, jts, jte, kts, kte )
750 END SUBROUTINE phy_fg_ten
752 !----------------------------------------------------------------------
753 SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
754 RQICUTEN,RQSCUTEN,RAINC,RAINCV,PRATEC,NCA, &
755 HTOP,HBOT,CUTOP,CUBOT, &
756 CUPPT, DT, 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 USE module_state_description
764 !----------------------------------------------------------------------
766 !----------------------------------------------------------------------
767 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
769 INTEGER, INTENT(IN ) :: &
770 ids,ide, jds,jde, kds,kde, &
771 ims,ime, jms,jme, kms,kme, &
772 its,ite, jts,jte, kts,kte
775 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
776 INTENT(INOUT) :: RTHCUTEN, &
783 REAL, DIMENSION( ims:ime , jms:jme ), &
784 INTENT(INOUT) :: RAINC, &
793 REAL, INTENT(IN) :: DT
797 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
798 INTEGER :: NCUTOP, NCUBOT
800 !-----------------------------------------------------------------
802 IF (config_flags%cu_physics .eq. 0) return
804 ! SET START AND END POINTS FOR TILES
807 i_end = min( ite,ide-1 )
809 j_end = min( jte,jde-1 )
811 ! IF( config_flags%nested .or. config_flags%specified ) THEN
812 ! i_start = max( its,ids+1 )
813 ! i_end = min( ite,ide-2 )
814 ! j_start = max( jts,jds+1 )
815 ! j_end = min( jte,jde-2 )
819 k_end = min( kte, kde-1 )
821 ! Update total cumulus scheme precipitation
827 RAINC(I,J)=RAINC(I,J)+PRATEC(I,J)*DT
828 CUPPT(I,J)=CUPPT(I,J)+PRATEC(I,J)*DT/1000.
832 SELECT CASE (config_flags%cu_physics)
839 IF ( NCA(I,J) .GT. 0 ) THEN
841 IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
843 ! set tendency to zero
851 if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
852 if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
856 NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
868 ! HTOP, HBOT FOR GFDL RADIATION
869 NCUTOP=NINT(CUTOP(I,J))
870 NCUBOT=NINT(CUBOT(I,J))
871 IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
872 HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
874 IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
875 HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
886 ! HTOP, HBOT FOR GFDL RADIATION
887 NCUTOP=NINT(CUTOP(I,J))
888 NCUBOT=NINT(CUBOT(I,J))
889 IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
890 HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
892 IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
893 HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
896 IF ( NCA(I,J) .GT. 0 ) THEN
899 IF ( NINT(NCA(I,J) / DT) .LE. 1 ) THEN
901 ! set tendency to zero
909 if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
910 if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
914 NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
915 ! NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
926 END SUBROUTINE advance_ppt
928 SUBROUTINE add_a2a(lvar,rvar,config_flags, &
929 ids,ide, jds, jde, kds, kde, &
930 ims, ime, jms, jme, kms, kme, &
931 its, ite, jts, jte, kts, kte )
932 !------------------------------------------------------------
934 !------------------------------------------------------------
935 TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
937 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
938 ims, ime, jms, jme, kms, kme, &
939 its, ite, jts, jte, kts, kte
941 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
943 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
947 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
950 i_end = MIN(ite,ide-1)
952 j_end = MIN(jte,jde-1)
955 IF ( config_flags%specified .or. &
956 config_flags%nested) i_start = MAX(ids+1,its)
957 IF ( config_flags%specified .or. &
958 config_flags%nested) i_end = MIN(ide-2,ite)
959 IF ( config_flags%specified .or. &
960 config_flags%nested) j_start = MAX(jds+1,jts)
961 IF ( config_flags%specified .or. &
962 config_flags%nested) j_end = MIN(jde-2,jte)
963 IF ( config_flags%periodic_x ) i_start = its
964 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
969 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
974 END SUBROUTINE add_a2a
976 !------------------------------------------------------------
977 SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
978 ids,ide, jds, jde, kds, kde, &
979 ims, ime, jms, jme, kms, kme, &
980 its, ite, jts, jte, kts, kte )
981 !------------------------------------------------------------
982 !------------------------------------------------------------
984 !------------------------------------------------------------
986 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
988 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
989 ims, ime, jms, jme, kms, kme, &
990 its, ite, jts, jte, kts, kte
992 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
994 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
999 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1006 j_end = MIN(jte,jde-1)
1008 IF ( config_flags%specified .or. &
1009 config_flags%nested) i_start = MAX(ids+1,its)
1010 IF ( config_flags%specified .or. &
1011 config_flags%nested) i_end = MIN(ide-1,ite)
1012 IF ( config_flags%specified .or. &
1013 config_flags%nested) j_start = MAX(jds+1,jts)
1014 IF ( config_flags%specified .or. &
1015 config_flags%nested) j_end = MIN(jde-2,jte)
1016 IF ( config_flags%periodic_x ) i_start = its
1017 IF ( config_flags%periodic_x ) i_end = ite
1019 DO j = j_start,j_end
1021 DO i = i_start,i_end
1022 lvar(i,k,j) = lvar(i,k,j) + &
1023 0.5*(rvar(i,k,j)+rvar(i-1,k,j))
1028 END SUBROUTINE add_a2c_u
1030 !------------------------------------------------------------
1031 SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
1032 ids,ide, jds, jde, kds, kde, &
1033 ims, ime, jms, jme, kms, kme, &
1034 its, ite, jts, jte, kts, kte )
1035 !------------------------------------------------------------
1036 !------------------------------------------------------------
1038 !------------------------------------------------------------
1040 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1042 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1043 ims, ime, jms, jme, kms, kme, &
1044 its, ite, jts, jte, kts, kte
1046 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1048 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1053 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1058 i_end = MIN(ite,ide-1)
1062 IF ( config_flags%specified .or. &
1063 config_flags%nested) i_start = MAX(ids+1,its)
1064 IF ( config_flags%specified .or. &
1065 config_flags%nested) i_end = MIN(ide-2,ite)
1066 IF ( config_flags%specified .or. &
1067 config_flags%nested) j_start = MAX(jds+1,jts)
1068 IF ( config_flags%specified .or. &
1069 config_flags%nested) j_end = MIN(jde-1,jte)
1070 IF ( config_flags%periodic_x ) i_start = its
1071 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1073 DO j = j_start,j_end
1075 DO i = i_start,i_end
1076 lvar(i,k,j) = lvar(i,k,j) + &
1077 0.5*(rvar(i,k,j)+rvar(i,k,j-1))
1082 END SUBROUTINE add_a2c_v
1084 !------------------------------------------------------------
1085 SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
1086 ids,ide, jds, jde, kds, kde, &
1087 ims, ime, jms, jme, kms, kme, &
1088 its, ite, jts, jte, kts, kte )
1089 !------------------------------------------------------------
1090 !------------------------------------------------------------
1092 !------------------------------------------------------------
1094 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1096 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1097 ims, ime, jms, jme, kms, kme, &
1098 its, ite, jts, jte, kts, kte
1100 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1102 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1107 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1114 j_end = MIN(jte,jde-1)
1117 IF ( config_flags%specified .or. &
1118 config_flags%nested) i_start = MAX(ids+1,its)
1119 IF ( config_flags%specified .or. &
1120 config_flags%nested) i_end = MIN(ide-1,ite)
1121 IF ( config_flags%specified .or. &
1122 config_flags%nested) j_start = MAX(jds+1,jts)
1123 IF ( config_flags%specified .or. &
1124 config_flags%nested) j_end = MIN(jde-2,jte)
1126 ! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1128 DO j = j_start,j_end
1130 DO i = i_start,i_end
1131 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1136 END SUBROUTINE add_c2c_u
1138 SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
1139 ids,ide, jds, jde, kds, kde, &
1140 ims, ime, jms, jme, kms, kme, &
1141 its, ite, jts, jte, kts, kte )
1142 !------------------------------------------------------------
1143 !------------------------------------------------------------
1145 !------------------------------------------------------------
1147 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1149 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1150 ims, ime, jms, jme, kms, kme, &
1151 its, ite, jts, jte, kts, kte
1153 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1155 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1160 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1165 i_end = MIN(ite,ide-1)
1169 IF ( config_flags%specified .or. &
1170 config_flags%nested) i_start = MAX(ids+1,its)
1171 IF ( config_flags%specified .or. &
1172 config_flags%nested) i_end = MIN(ide-2,ite)
1173 IF ( config_flags%specified .or. &
1174 config_flags%nested) j_start = MAX(jds+1,jts)
1175 IF ( config_flags%specified .or. &
1176 config_flags%nested) j_end = MIN(jde-1,jte)
1178 ! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1180 DO j = j_start,j_end
1182 DO i = i_start,i_end
1183 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1188 END SUBROUTINE add_c2c_v
1192 END MODULE module_physics_addtendc