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 g_module_physics_addtendc
23 USE module_state_description
28 SUBROUTINE g_update_phy_ten(rph_tendf,rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf, &
29 rv_tendf,g_rv_tendf,moist_tendf,g_moist_tendf, &
30 scalar_tendf,mu_tendf, &
31 RTHRATEN,RTHBLTEN,g_RTHBLTEN,RTHCUTEN,g_RTHCUTEN,RTHSHTEN, &
32 RUBLTEN,g_RUBLTEN,RUCUTEN,RUSHTEN, &
33 RVBLTEN,g_RVBLTEN,RVCUTEN,RVSHTEN, &
34 RQVBLTEN,g_RQVBLTEN,RQCBLTEN,RQIBLTEN, &
35 RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN, &
36 RQVSHTEN,RQCSHTEN,RQRSHTEN,RQISHTEN,RQSSHTEN,RQGSHTEN,&
37 RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN, &
38 RQVNDGDTEN,RMUNDGDTEN, &
39 rthfrten,rqvfrten, & !fire
40 n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
41 ids, ide, jds, jde, kds, kde, &
42 ims, ime, jms, jme, kms, kme, &
43 its, ite, jts, jte, kts, kte )
44 !-------------------------------------------------------------------
46 !-------------------------------------------------------------------
48 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
50 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
51 ims, ime, jms, jme, kms, kme, &
52 its, ite, jts, jte, kts, kte, &
53 n_moist,n_scalar,rk_step
55 LOGICAL , INTENT(IN) :: adv_moist_cond
57 REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: &
66 REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf
68 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
69 INTENT(INOUT) :: moist_tendf, &
72 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
73 INTENT(INOUT) :: scalar_tendf
75 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
112 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
114 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & ! fire
117 !------------------------------------------------------------------
118 ! set up loop bounds for this grid's boundary conditions
120 if (config_flags%ra_lw_physics .gt. 0 .or. &
121 config_flags%ra_sw_physics .gt. 0) &
122 CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
123 ids, ide, jds, jde, kds, kde, &
124 ims, ime, jms, jme, kms, kme, &
125 its, ite, jts, jte, kts, kte )
127 if (config_flags%bl_pbl_physics .gt. 0) &
128 CALL g_phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
129 rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf, &
130 rv_tendf,g_rv_tendf, &
131 moist_tendf, g_moist_tendf, &
132 scalar_tendf,adv_moist_cond, &
133 RTHBLTEN,g_RTHBLTEN, &
136 RQVBLTEN,g_RQVBLTEN, &
138 ids, ide, jds, jde, kds, kde, &
139 ims, ime, jms, jme, kms, kme, &
140 its, ite, jts, jte, kts, kte )
142 if (config_flags%cu_physics .gt. 0) &
143 CALL g_phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, &
144 rt_tendf,g_rt_tendf,ru_tendf,rv_tendf, &
145 RUCUTEN,RVCUTEN,RTHCUTEN,g_RTHCUTEN, &
146 RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN, &
147 RQICUTEN,RQSCUTEN,moist_tendf,g_moist_tendf,&
148 scalar_tendf,adv_moist_cond, &
149 ids, ide, jds, jde, kds, kde, &
150 ims, ime, jms, jme, kms, kme, &
151 its, ite, jts, jte, kts, kte )
153 if (config_flags%shcu_physics .gt. 0) &
154 CALL phy_shcu_ten(config_flags,rk_step,n_moist, &
155 rt_tendf,ru_tendf,rv_tendf, &
156 RUSHTEN,RVSHTEN,RTHSHTEN, &
157 RQVSHTEN,RQCSHTEN,RQRSHTEN, &
158 RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf, &
159 ids, ide, jds, jde, kds, kde, &
160 ims, ime, jms, jme, kms, kme, &
161 its, ite, jts, jte, kts, kte )
163 if (config_flags%grid_fdda .gt. 0) &
164 CALL phy_fg_ten(config_flags,rk_step,n_moist, &
165 rph_tendf,rt_tendf,ru_tendf,rv_tendf, &
166 mu_tendf, moist_tendf, &
167 RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
168 RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
169 ids, ide, jds, jde, kds, kde, &
170 ims, ime, jms, jme, kms, kme, &
171 its, ite, jts, jte, kts, kte )
173 if (config_flags%ifire .gt. 0) & ! fire
174 CALL phy_fr_ten(config_flags,rk_step,n_moist, &
175 rt_tendf,ru_tendf,rv_tendf, &
176 mu_tendf, moist_tendf, &
178 ids, ide, jds, jde, kds, kde, &
179 ims, ime, jms, jme, kms, kme, &
180 its, ite, jts, jte, kts, kte )
182 END SUBROUTINE g_update_phy_ten
184 !=================================================================
185 SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
186 ids, ide, jds, jde, kds, kde, &
187 ims, ime, jms, jme, kms, kme, &
188 its, ite, jts, jte, kts, kte )
189 !-----------------------------------------------------------------
191 !-----------------------------------------------------------------
192 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
194 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
195 ims, ime, jms, jme, kms, kme, &
196 its, ite, jts, jte, kts, kte
198 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
201 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
208 CALL add_a2a(rt_tendf,RTHRATEN,config_flags, &
209 ids,ide, jds, jde, kds, kde, &
210 ims, ime, jms, jme, kms, kme, &
211 its, ite, jts, jte, kts, kte )
213 END SUBROUTINE phy_ra_ten
215 !=================================================================
216 SUBROUTINE g_phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
217 rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf, &
218 rv_tendf,g_rv_tendf,moist_tendf,g_moist_tendf, &
219 scalar_tendf,adv_moist_cond, &
220 RTHBLTEN,g_RTHBLTEN, &
223 RQVBLTEN,g_RQVBLTEN, &
225 ids, ide, jds, jde, kds, kde, &
226 ims, ime, jms, jme, kms, kme, &
227 its, ite, jts, jte, kts, kte )
228 !-----------------------------------------------------------------
230 !-----------------------------------------------------------------
231 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
233 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
234 ims, ime, jms, jme, kms, kme, &
235 its, ite, jts, jte, kts, kte, &
236 n_moist, n_scalar, rk_step
238 LOGICAL , INTENT(IN) :: adv_moist_cond
240 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
241 INTENT(INOUT) :: moist_tendf, &
244 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
245 INTENT(INOUT) :: scalar_tendf
247 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
259 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
268 INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
270 !-----------------------------------------------------------------
272 SELECT CASE(config_flags%bl_pbl_physics)
276 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
277 ids,ide, jds, jde, kds, kde, &
278 ims, ime, jms, jme, kms, kme, &
279 its, ite, jts, jte, kts, kte )
281 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
282 ids,ide, jds, jde, kds, kde, &
283 ims, ime, jms, jme, kms, kme, &
284 its, ite, jts, jte, kts, kte )
286 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
287 ids,ide, jds, jde, kds, kde, &
288 ims, ime, jms, jme, kms, kme, &
289 its, ite, jts, jte, kts, kte )
291 if (P_QV .ge. PARAM_FIRST_SCALAR) &
292 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
294 ids,ide, jds, jde, kds, kde, &
295 ims, ime, jms, jme, kms, kme, &
296 its, ite, jts, jte, kts, kte )
298 if (P_QC .ge. PARAM_FIRST_SCALAR) &
299 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
301 ids,ide, jds, jde, kds, kde, &
302 ims, ime, jms, jme, kms, kme, &
303 its, ite, jts, jte, kts, kte )
305 if (P_QI .ge. PARAM_FIRST_SCALAR) &
306 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
308 ids,ide, jds, jde, kds, kde, &
309 ims, ime, jms, jme, kms, kme, &
310 its, ite, jts, jte, kts, kte )
312 IF(.not. adv_moist_cond)THEN
314 if (P_QT .ge. PARAM_FIRST_SCALAR) &
315 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
317 ids,ide, jds, jde, kds, kde, &
318 ims, ime, jms, jme, kms, kme, &
319 its, ite, jts, jte, kts, kte )
321 if (P_QT .ge. PARAM_FIRST_SCALAR) &
322 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
324 ids,ide, jds, jde, kds, kde, &
325 ims, ime, jms, jme, kms, kme, &
326 its, ite, jts, jte, kts, kte )
331 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
332 ids,ide, jds, jde, kds, kde, &
333 ims, ime, jms, jme, kms, kme, &
334 its, ite, jts, jte, kts, kte )
336 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
337 ids,ide, jds, jde, kds, kde, &
338 ims, ime, jms, jme, kms, kme, &
339 its, ite, jts, jte, kts, kte )
341 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
342 ids,ide, jds, jde, kds, kde, &
343 ims, ime, jms, jme, kms, kme, &
344 its, ite, jts, jte, kts, kte )
346 if (P_QV .ge. PARAM_FIRST_SCALAR) &
347 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
349 ids,ide, jds, jde, kds, kde, &
350 ims, ime, jms, jme, kms, kme, &
351 its, ite, jts, jte, kts, kte )
353 if (P_QC .ge. PARAM_FIRST_SCALAR) &
354 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
356 ids,ide, jds, jde, kds, kde, &
357 ims, ime, jms, jme, kms, kme, &
358 its, ite, jts, jte, kts, kte )
360 if (P_QI .ge. PARAM_FIRST_SCALAR) &
361 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
363 ids,ide, jds, jde, kds, kde, &
364 ims, ime, jms, jme, kms, kme, &
365 its, ite, jts, jte, kts, kte )
367 IF(.not. adv_moist_cond)THEN
369 if (P_QT .ge. PARAM_FIRST_SCALAR) &
370 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
372 ids,ide, jds, jde, kds, kde, &
373 ims, ime, jms, jme, kms, kme, &
374 its, ite, jts, jte, kts, kte )
376 if (P_QT .ge. PARAM_FIRST_SCALAR) &
377 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
379 ids,ide, jds, jde, kds, kde, &
380 ims, ime, jms, jme, kms, kme, &
381 its, ite, jts, jte, kts, kte )
386 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
387 ids,ide, jds, jde, kds, kde, &
388 ims, ime, jms, jme, kms, kme, &
389 its, ite, jts, jte, kts, kte )
391 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
392 ids,ide, jds, jde, kds, kde, &
393 ims, ime, jms, jme, kms, kme, &
394 its, ite, jts, jte, kts, kte )
396 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
397 ids,ide, jds, jde, kds, kde, &
398 ims, ime, jms, jme, kms, kme, &
399 its, ite, jts, jte, kts, kte )
401 if (P_QV .ge. PARAM_FIRST_SCALAR) &
402 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
404 ids,ide, jds, jde, kds, kde, &
405 ims, ime, jms, jme, kms, kme, &
406 its, ite, jts, jte, kts, kte )
408 if (P_QC .ge. PARAM_FIRST_SCALAR) &
409 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
411 ids,ide, jds, jde, kds, kde, &
412 ims, ime, jms, jme, kms, kme, &
413 its, ite, jts, jte, kts, kte )
415 if (P_QI .ge. PARAM_FIRST_SCALAR) &
416 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
418 ids,ide, jds, jde, kds, kde, &
419 ims, ime, jms, jme, kms, kme, &
420 its, ite, jts, jte, kts, kte )
422 IF(.not. adv_moist_cond)THEN
424 if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
425 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
427 ids,ide, jds, jde, kds, kde, &
428 ims, ime, jms, jme, kms, kme, &
429 its, ite, jts, jte, kts, kte )
431 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
433 ids,ide, jds, jde, kds, kde, &
434 ims, ime, jms, jme, kms, kme, &
435 its, ite, jts, jte, kts, kte )
442 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
443 ids,ide, jds, jde, kds, kde, &
444 ims, ime, jms, jme, kms, kme, &
445 its, ite, jts, jte, kts, kte )
447 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
448 ids,ide, jds, jde, kds, kde, &
449 ims, ime, jms, jme, kms, kme, &
450 its, ite, jts, jte, kts, kte )
452 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
453 ids,ide, jds, jde, kds, kde, &
454 ims, ime, jms, jme, kms, kme, &
455 its, ite, jts, jte, kts, kte )
457 if (P_QV .ge. PARAM_FIRST_SCALAR) &
458 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
460 ids,ide, jds, jde, kds, kde, &
461 ims, ime, jms, jme, kms, kme, &
462 its, ite, jts, jte, kts, kte )
464 IF(.not. adv_moist_cond)THEN
466 if (P_QT .ge. PARAM_FIRST_SCALAR) &
467 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
469 ids,ide, jds, jde, kds, kde, &
470 ims, ime, jms, jme, kms, kme, &
471 its, ite, jts, jte, kts, kte )
473 if (P_QT .ge. PARAM_FIRST_SCALAR) &
474 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
476 ids,ide, jds, jde, kds, kde, &
477 ims, ime, jms, jme, kms, kme, &
478 its, ite, jts, jte, kts, kte )
480 ! if (P_QT .ge. PARAM_FIRST_SCALAR) &
481 ! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSBLTEN, &
483 ! ids,ide, jds, jde, kds, kde, &
484 ! ims, ime, jms, jme, kms, kme, &
485 ! its, ite, jts, jte, kts, kte )
487 ! if (P_QT .ge. PARAM_FIRST_SCALAR) &
488 ! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRBLTEN, &
490 ! ids,ide, jds, jde, kds, kde, &
491 ! ims, ime, jms, jme, kms, kme, &
492 ! its, ite, jts, jte, kts, kte )
494 ! if (P_QT .ge. PARAM_FIRST_SCALAR) &
495 ! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQGBLTEN, &
497 ! ids,ide, jds, jde, kds, kde, &
498 ! ims, ime, jms, jme, kms, kme, &
499 ! its, ite, jts, jte, kts, kte )
503 if (P_QC .ge. PARAM_FIRST_SCALAR) &
504 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
506 ids,ide, jds, jde, kds, kde, &
507 ims, ime, jms, jme, kms, kme, &
508 its, ite, jts, jte, kts, kte )
510 if (P_QI .ge. PARAM_FIRST_SCALAR) &
511 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
513 ids,ide, jds, jde, kds, kde, &
514 ims, ime, jms, jme, kms, kme, &
515 its, ite, jts, jte, kts, kte )
517 ! if (P_QS .ge. PARAM_FIRST_SCALAR) &
518 ! CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSBLTEN, &
520 ! ids,ide, jds, jde, kds, kde, &
521 ! ims, ime, jms, jme, kms, kme, &
522 ! its, ite, jts, jte, kts, kte )
524 ! if (P_QR .ge. PARAM_FIRST_SCALAR) &
525 ! CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRBLTEN, &
527 ! ids,ide, jds, jde, kds, kde, &
528 ! ims, ime, jms, jme, kms, kme, &
529 ! its, ite, jts, jte, kts, kte )
531 ! if (P_QG .ge. PARAM_FIRST_SCALAR) &
532 ! CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGBLTEN, &
534 ! ids,ide, jds, jde, kds, kde, &
535 ! ims, ime, jms, jme, kms, kme, &
536 ! its, ite, jts, jte, kts, kte )
542 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
543 ids,ide, jds, jde, kds, kde, &
544 ims, ime, jms, jme, kms, kme, &
545 its, ite, jts, jte, kts, kte )
547 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
548 ids,ide, jds, jde, kds, kde, &
549 ims, ime, jms, jme, kms, kme, &
550 its, ite, jts, jte, kts, kte )
552 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
553 ids,ide, jds, jde, kds, kde, &
554 ims, ime, jms, jme, kms, kme, &
555 its, ite, jts, jte, kts, kte )
557 if (P_QV .ge. PARAM_FIRST_SCALAR) &
558 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
560 ids,ide, jds, jde, kds, kde, &
561 ims, ime, jms, jme, kms, kme, &
562 its, ite, jts, jte, kts, kte )
564 IF(.not. adv_moist_cond)THEN
566 if (P_QT .ge. PARAM_FIRST_SCALAR) &
567 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
569 ids,ide, jds, jde, kds, kde, &
570 ims, ime, jms, jme, kms, kme, &
571 its, ite, jts, jte, kts, kte )
575 if (P_QC .ge. PARAM_FIRST_SCALAR) &
576 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
578 ids,ide, jds, jde, kds, kde, &
579 ims, ime, jms, jme, kms, kme, &
580 its, ite, jts, jte, kts, kte )
586 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
587 ids,ide, jds, jde, kds, kde, &
588 ims, ime, jms, jme, kms, kme, &
589 its, ite, jts, jte, kts, kte )
591 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
592 ids,ide, jds, jde, kds, kde, &
593 ims, ime, jms, jme, kms, kme, &
594 its, ite, jts, jte, kts, kte )
596 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
597 ids,ide, jds, jde, kds, kde, &
598 ims, ime, jms, jme, kms, kme, &
599 its, ite, jts, jte, kts, kte )
601 if (P_QV .ge. PARAM_FIRST_SCALAR) &
602 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
604 ids,ide, jds, jde, kds, kde, &
605 ims, ime, jms, jme, kms, kme, &
606 its, ite, jts, jte, kts, kte )
608 if (P_QC .ge. PARAM_FIRST_SCALAR) &
609 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
611 ids,ide, jds, jde, kds, kde, &
612 ims, ime, jms, jme, kms, kme, &
613 its, ite, jts, jte, kts, kte )
615 if (P_QI .ge. PARAM_FIRST_SCALAR) &
616 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
618 ids,ide, jds, jde, kds, kde, &
619 ims, ime, jms, jme, kms, kme, &
620 its, ite, jts, jte, kts, kte )
622 IF(.not. adv_moist_cond)THEN
624 if (P_QT .ge. PARAM_FIRST_SCALAR) &
625 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
627 ids,ide, jds, jde, kds, kde, &
628 ims, ime, jms, jme, kms, kme, &
629 its, ite, jts, jte, kts, kte )
631 if (P_QT .ge. PARAM_FIRST_SCALAR) &
632 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
634 ids,ide, jds, jde, kds, kde, &
635 ims, ime, jms, jme, kms, kme, &
636 its, ite, jts, jte, kts, kte )
641 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
642 ids,ide, jds, jde, kds, kde, &
643 ims, ime, jms, jme, kms, kme, &
644 its, ite, jts, jte, kts, kte )
646 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
647 ids,ide, jds, jde, kds, kde, &
648 ims, ime, jms, jme, kms, kme, &
649 its, ite, jts, jte, kts, kte )
651 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
652 ids,ide, jds, jde, kds, kde, &
653 ims, ime, jms, jme, kms, kme, &
654 its, ite, jts, jte, kts, kte )
656 if (P_QV .ge. PARAM_FIRST_SCALAR) &
657 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
659 ids,ide, jds, jde, kds, kde, &
660 ims, ime, jms, jme, kms, kme, &
661 its, ite, jts, jte, kts, kte )
663 if (P_QC .ge. PARAM_FIRST_SCALAR) &
664 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
666 ids,ide, jds, jde, kds, kde, &
667 ims, ime, jms, jme, kms, kme, &
668 its, ite, jts, jte, kts, kte )
670 IF(.not. adv_moist_cond)THEN
672 if (P_QT .ge. PARAM_FIRST_SCALAR) &
673 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
675 ids,ide, jds, jde, kds, kde, &
676 ims, ime, jms, jme, kms, kme, &
677 its, ite, jts, jte, kts, kte )
683 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
684 ids,ide, jds, jde, kds, kde, &
685 ims, ime, jms, jme, kms, kme, &
686 its, ite, jts, jte, kts, kte )
688 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
689 ids,ide, jds, jde, kds, kde, &
690 ims, ime, jms, jme, kms, kme, &
691 its, ite, jts, jte, kts, kte )
693 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
694 ids,ide, jds, jde, kds, kde, &
695 ims, ime, jms, jme, kms, kme, &
696 its, ite, jts, jte, kts, kte )
698 if (P_QV .ge. PARAM_FIRST_SCALAR) &
699 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
701 ids,ide, jds, jde, kds, kde, &
702 ims, ime, jms, jme, kms, kme, &
703 its, ite, jts, jte, kts, kte )
705 IF(.not. adv_moist_cond)THEN
707 if (P_QT .ge. PARAM_FIRST_SCALAR) &
708 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
710 ids,ide, jds, jde, kds, kde, &
711 ims, ime, jms, jme, kms, kme, &
712 its, ite, jts, jte, kts, kte )
716 if (P_QC .ge. PARAM_FIRST_SCALAR) &
717 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
719 ids,ide, jds, jde, kds, kde, &
720 ims, ime, jms, jme, kms, kme, &
721 its, ite, jts, jte, kts, kte )
724 CASE (SURFDRAGSCHEME)
726 CALL g_add_a2a(rt_tendf,g_rt_tendf, &
727 RTHBLTEN,g_RTHBLTEN,config_flags, &
728 ids,ide, jds, jde, kds, kde, &
729 ims, ime, jms, jme, kms, kme, &
730 its, ite, jts, jte, kts, kte )
732 CALL g_add_a2c_u(ru_tendf,g_ru_tendf, &
733 RUBLTEN,g_RUBLTEN,config_flags, &
734 ids,ide, jds, jde, kds, kde, &
735 ims, ime, jms, jme, kms, kme, &
736 its, ite, jts, jte, kts, kte )
738 CALL g_add_a2c_v(rv_tendf,g_rv_tendf, &
739 RVBLTEN,g_RVBLTEN,config_flags, &
740 ids,ide, jds, jde, kds, kde, &
741 ims, ime, jms, jme, kms, kme, &
742 its, ite, jts, jte, kts, kte )
744 if (P_QV .ge. PARAM_FIRST_SCALAR) &
745 CALL g_add_a2a(moist_tendf(ims,kms,jms,P_QV), &
746 g_moist_tendf(ims,kms,jms,P_QV), &
747 RQVBLTEN, g_RQVBLTEN, &
749 ids,ide, jds, jde, kds, kde, &
750 ims, ime, jms, jme, kms, kme, &
751 its, ite, jts, jte, kts, kte )
753 CASE (CAMUWPBLSCHEME)
754 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
755 ids,ide, jds, jde, kds, kde, &
756 ims, ime, jms, jme, kms, kme, &
757 its, ite, jts, jte, kts, kte )
759 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
760 ids,ide, jds, jde, kds, kde, &
761 ims, ime, jms, jme, kms, kme, &
762 its, ite, jts, jte, kts, kte )
764 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
765 ids,ide, jds, jde, kds, kde, &
766 ims, ime, jms, jme, kms, kme, &
767 its, ite, jts, jte, kts, kte )
769 if (P_QV .ge. PARAM_FIRST_SCALAR) &
770 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
772 ids,ide, jds, jde, kds, kde, &
773 ims, ime, jms, jme, kms, kme, &
774 its, ite, jts, jte, kts, kte )
776 IF(.not. adv_moist_cond)THEN
778 if (P_QT .ge. PARAM_FIRST_SCALAR) &
779 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
781 ids,ide, jds, jde, kds, kde, &
782 ims, ime, jms, jme, kms, kme, &
783 its, ite, jts, jte, kts, kte )
787 if (P_QC .ge. PARAM_FIRST_SCALAR) &
788 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
790 ids,ide, jds, jde, kds, kde, &
791 ims, ime, jms, jme, kms, kme, &
792 its, ite, jts, jte, kts, kte )
797 CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
798 ids,ide, jds, jde, kds, kde, &
799 ims, ime, jms, jme, kms, kme, &
800 its, ite, jts, jte, kts, kte )
802 CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
803 ids,ide, jds, jde, kds, kde, &
804 ims, ime, jms, jme, kms, kme, &
805 its, ite, jts, jte, kts, kte )
807 CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
808 ids,ide, jds, jde, kds, kde, &
809 ims, ime, jms, jme, kms, kme, &
810 its, ite, jts, jte, kts, kte )
812 if (P_QV .ge. PARAM_FIRST_SCALAR) &
813 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
815 ids,ide, jds, jde, kds, kde, &
816 ims, ime, jms, jme, kms, kme, &
817 its, ite, jts, jte, kts, kte )
819 if (P_QC .ge. PARAM_FIRST_SCALAR) &
820 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
822 ids,ide, jds, jde, kds, kde, &
823 ims, ime, jms, jme, kms, kme, &
824 its, ite, jts, jte, kts, kte )
826 if (P_QI .ge. PARAM_FIRST_SCALAR) &
827 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
829 ids,ide, jds, jde, kds, kde, &
830 ims, ime, jms, jme, kms, kme, &
831 its, ite, jts, jte, kts, kte )
835 print*,'g_phy_bl_ten: The pbl scheme does not exist'
839 END SUBROUTINE g_phy_bl_ten
841 !=================================================================
842 SUBROUTINE g_phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, &
843 rt_tendf,g_rt_tendf,ru_tendf,rv_tendf, &
844 RUCUTEN,RVCUTEN,RTHCUTEN,g_RTHCUTEN, &
845 RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN, &
846 RQICUTEN,RQSCUTEN,moist_tendf,g_moist_tendf,&
847 scalar_tendf,adv_moist_cond, &
848 ids, ide, jds, jde, kds, kde, &
849 ims, ime, jms, jme, kms, kme, &
850 its, ite, jts, jte, kts, kte )
851 !-----------------------------------------------------------------
853 !-----------------------------------------------------------------
854 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
856 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
857 ims, ime, jms, jme, kms, kme, &
858 its, ite, jts, jte, kts, kte, &
859 n_moist, n_scalar, rk_step
861 LOGICAL , INTENT(IN) :: adv_moist_cond
863 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
864 INTENT(INOUT) :: moist_tendf, g_moist_tendf
866 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
867 INTENT(INOUT) :: scalar_tendf
869 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
881 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
892 SELECT CASE (config_flags%cu_physics)
895 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
896 ids,ide, jds, jde, kds, kde, &
897 ims, ime, jms, jme, kms, kme, &
898 its, ite, jts, jte, kts, kte )
900 if (P_QV .ge. PARAM_FIRST_SCALAR) &
901 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
903 ids,ide, jds, jde, kds, kde, &
904 ims, ime, jms, jme, kms, kme, &
905 its, ite, jts, jte, kts, kte )
907 if (P_QC .ge. PARAM_FIRST_SCALAR) &
908 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
910 ids,ide, jds, jde, kds, kde, &
911 ims, ime, jms, jme, kms, kme, &
912 its, ite, jts, jte, kts, kte )
914 if (P_QR .ge. PARAM_FIRST_SCALAR) &
915 CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
917 ids,ide, jds, jde, kds, kde, &
918 ims, ime, jms, jme, kms, kme, &
919 its, ite, jts, jte, kts, kte )
921 if (P_QI .ge. PARAM_FIRST_SCALAR) &
922 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
924 ids,ide, jds, jde, kds, kde, &
925 ims, ime, jms, jme, kms, kme, &
926 its, ite, jts, jte, kts, kte )
928 if (P_QS .ge. PARAM_FIRST_SCALAR) &
929 CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
931 ids,ide, jds, jde, kds, kde, &
932 ims, ime, jms, jme, kms, kme, &
933 its, ite, jts, jte, kts, kte )
935 IF(.not. adv_moist_cond)THEN
937 if (P_QT .ge. PARAM_FIRST_SCALAR) &
938 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
940 ids,ide, jds, jde, kds, kde, &
941 ims, ime, jms, jme, kms, kme, &
942 its, ite, jts, jte, kts, kte )
944 if (P_QT .ge. PARAM_FIRST_SCALAR) &
945 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
947 ids,ide, jds, jde, kds, kde, &
948 ims, ime, jms, jme, kms, kme, &
949 its, ite, jts, jte, kts, kte )
951 if (P_QT .ge. PARAM_FIRST_SCALAR) &
952 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
954 ids,ide, jds, jde, kds, kde, &
955 ims, ime, jms, jme, kms, kme, &
956 its, ite, jts, jte, kts, kte )
958 if (P_QT .ge. PARAM_FIRST_SCALAR) &
959 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
961 ids,ide, jds, jde, kds, kde, &
962 ims, ime, jms, jme, kms, kme, &
963 its, ite, jts, jte, kts, kte )
968 CALL add_a2a(rt_tendf,RTHCUTEN, &
970 ids,ide, jds, jde, kds, kde, &
971 ims, ime, jms, jme, kms, kme, &
972 its, ite, jts, jte, kts, kte )
974 if (P_QV .ge. PARAM_FIRST_SCALAR) &
975 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
977 ids,ide, jds, jde, kds, kde, &
978 ims, ime, jms, jme, kms, kme, &
979 its, ite, jts, jte, kts, kte )
981 CASE (KFETASCHEME, MSKFSCHEME)
982 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
983 ids,ide, jds, jde, kds, kde, &
984 ims, ime, jms, jme, kms, kme, &
985 its, ite, jts, jte, kts, kte )
987 if (P_QV .ge. PARAM_FIRST_SCALAR) &
988 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
990 ids,ide, jds, jde, kds, kde, &
991 ims, ime, jms, jme, kms, kme, &
992 its, ite, jts, jte, kts, kte )
994 if (P_QC .ge. PARAM_FIRST_SCALAR) &
995 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
997 ids,ide, jds, jde, kds, kde, &
998 ims, ime, jms, jme, kms, kme, &
999 its, ite, jts, jte, kts, kte )
1001 if (P_QR .ge. PARAM_FIRST_SCALAR) &
1002 CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
1004 ids,ide, jds, jde, kds, kde, &
1005 ims, ime, jms, jme, kms, kme, &
1006 its, ite, jts, jte, kts, kte )
1008 if (P_QI .ge. PARAM_FIRST_SCALAR) &
1009 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1011 ids,ide, jds, jde, kds, kde, &
1012 ims, ime, jms, jme, kms, kme, &
1013 its, ite, jts, jte, kts, kte )
1015 if (P_QS .ge. PARAM_FIRST_SCALAR) &
1016 CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
1018 ids,ide, jds, jde, kds, kde, &
1019 ims, ime, jms, jme, kms, kme, &
1020 its, ite, jts, jte, kts, kte )
1022 IF(.not. adv_moist_cond)THEN
1024 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1025 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1027 ids,ide, jds, jde, kds, kde, &
1028 ims, ime, jms, jme, kms, kme, &
1029 its, ite, jts, jte, kts, kte )
1031 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1032 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
1034 ids,ide, jds, jde, kds, kde, &
1035 ims, ime, jms, jme, kms, kme, &
1036 its, ite, jts, jte, kts, kte )
1038 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1039 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1041 ids,ide, jds, jde, kds, kde, &
1042 ims, ime, jms, jme, kms, kme, &
1043 its, ite, jts, jte, kts, kte )
1045 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1046 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
1048 ids,ide, jds, jde, kds, kde, &
1049 ims, ime, jms, jme, kms, kme, &
1050 its, ite, jts, jte, kts, kte )
1053 CASE (GDSCHEME, G3SCHEME)
1054 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1055 ids,ide, jds, jde, kds, kde, &
1056 ims, ime, jms, jme, kms, kme, &
1057 its, ite, jts, jte, kts, kte )
1059 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1060 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1062 ids,ide, jds, jde, kds, kde, &
1063 ims, ime, jms, jme, kms, kme, &
1064 its, ite, jts, jte, kts, kte )
1066 if (P_QC .ge. PARAM_FIRST_SCALAR) &
1067 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1069 ids,ide, jds, jde, kds, kde, &
1070 ims, ime, jms, jme, kms, kme, &
1071 its, ite, jts, jte, kts, kte )
1073 if (P_QI .ge. PARAM_FIRST_SCALAR) &
1074 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1076 ids,ide, jds, jde, kds, kde, &
1077 ims, ime, jms, jme, kms, kme, &
1078 its, ite, jts, jte, kts, kte )
1080 IF(.not. adv_moist_cond)THEN
1082 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1083 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1085 ids,ide, jds, jde, kds, kde, &
1086 ims, ime, jms, jme, kms, kme, &
1087 its, ite, jts, jte, kts, kte )
1089 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1090 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1092 ids,ide, jds, jde, kds, kde, &
1093 ims, ime, jms, jme, kms, kme, &
1094 its, ite, jts, jte, kts, kte )
1099 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1100 ids,ide, jds, jde, kds, kde, &
1101 ims, ime, jms, jme, kms, kme, &
1102 its, ite, jts, jte, kts, kte )
1104 CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
1105 ids,ide, jds, jde, kds, kde, &
1106 ims, ime, jms, jme, kms, kme, &
1107 its, ite, jts, jte, kts, kte )
1109 CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
1110 ids,ide, jds, jde, kds, kde, &
1111 ims, ime, jms, jme, kms, kme, &
1112 its, ite, jts, jte, kts, kte )
1114 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1115 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1117 ids,ide, jds, jde, kds, kde, &
1118 ims, ime, jms, jme, kms, kme, &
1119 its, ite, jts, jte, kts, kte )
1121 if (P_QC .ge. PARAM_FIRST_SCALAR) &
1122 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1124 ids,ide, jds, jde, kds, kde, &
1125 ims, ime, jms, jme, kms, kme, &
1126 its, ite, jts, jte, kts, kte )
1128 if (P_QI .ge. PARAM_FIRST_SCALAR) &
1129 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1131 ids,ide, jds, jde, kds, kde, &
1132 ims, ime, jms, jme, kms, kme, &
1133 its, ite, jts, jte, kts, kte )
1135 IF(.not. adv_moist_cond)THEN
1137 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1138 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1140 ids,ide, jds, jde, kds, kde, &
1141 ims, ime, jms, jme, kms, kme, &
1142 its, ite, jts, jte, kts, kte )
1144 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1145 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1147 ids,ide, jds, jde, kds, kde, &
1148 ims, ime, jms, jme, kms, kme, &
1149 its, ite, jts, jte, kts, kte )
1153 CASE (SASSCHEME,OSASSCHEME)
1154 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1155 ids,ide, jds, jde, kds, kde, &
1156 ims, ime, jms, jme, kms, kme, &
1157 its, ite, jts, jte, kts, kte )
1159 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1160 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1162 ids,ide, jds, jde, kds, kde, &
1163 ims, ime, jms, jme, kms, kme, &
1164 its, ite, jts, jte, kts, kte )
1166 if (P_QC .ge. PARAM_FIRST_SCALAR) &
1167 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1169 ids,ide, jds, jde, kds, kde, &
1170 ims, ime, jms, jme, kms, kme, &
1171 its, ite, jts, jte, kts, kte )
1173 if (P_QI .ge. PARAM_FIRST_SCALAR) &
1174 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1176 ids,ide, jds, jde, kds, kde, &
1177 ims, ime, jms, jme, kms, kme, &
1178 its, ite, jts, jte, kts, kte )
1181 CALL g_add_a2a(rt_tendf, g_rt_tendf, &
1182 RTHCUTEN, g_RTHCUTEN, config_flags, &
1183 ids,ide, jds, jde, kds, kde, &
1184 ims, ime, jms, jme, kms, kme, &
1185 its, ite, jts, jte, kts, kte )
1187 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1188 CALL g_add_a2a(moist_tendf(ims,kms,jms,P_QV), &
1189 g_moist_tendf(ims,kms,jms,P_QV), RQVCUTEN, &
1192 ids,ide, jds, jde, kds, kde, &
1193 ims, ime, jms, jme, kms, kme, &
1194 its, ite, jts, jte, kts, kte )
1197 CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
1198 ids,ide, jds, jde, kds, kde, &
1199 ims, ime, jms, jme, kms, kme, &
1200 its, ite, jts, jte, kts, kte )
1202 CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
1203 ids,ide, jds, jde, kds, kde, &
1204 ims, ime, jms, jme, kms, kme, &
1205 its, ite, jts, jte, kts, kte )
1207 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1208 ids,ide, jds, jde, kds, kde, &
1209 ims, ime, jms, jme, kms, kme, &
1210 its, ite, jts, jte, kts, kte )
1212 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1213 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1215 ids,ide, jds, jde, kds, kde, &
1216 ims, ime, jms, jme, kms, kme, &
1217 its, ite, jts, jte, kts, kte )
1219 if (P_QC .ge. PARAM_FIRST_SCALAR) &
1220 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1222 ids,ide, jds, jde, kds, kde, &
1223 ims, ime, jms, jme, kms, kme, &
1224 its, ite, jts, jte, kts, kte )
1226 if (P_QI .ge. PARAM_FIRST_SCALAR) &
1227 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1229 ids,ide, jds, jde, kds, kde, &
1230 ims, ime, jms, jme, kms, kme, &
1231 its, ite, jts, jte, kts, kte )
1232 IF(.not. adv_moist_cond)THEN
1234 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1235 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1237 ids,ide, jds, jde, kds, kde, &
1238 ims, ime, jms, jme, kms, kme, &
1239 its, ite, jts, jte, kts, kte )
1241 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1242 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1244 ids,ide, jds, jde, kds, kde, &
1245 ims, ime, jms, jme, kms, kme, &
1246 its, ite, jts, jte, kts, kte )
1250 CASE (TIEDTKESCHEME, NTIEDTKESCHEME)
1251 CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
1252 ids,ide, jds, jde, kds, kde, &
1253 ims, ime, jms, jme, kms, kme, &
1254 its, ite, jts, jte, kts, kte )
1256 CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
1257 ids,ide, jds, jde, kds, kde, &
1258 ims, ime, jms, jme, kms, kme, &
1259 its, ite, jts, jte, kts, kte )
1261 CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
1262 ids,ide, jds, jde, kds, kde, &
1263 ims, ime, jms, jme, kms, kme, &
1264 its, ite, jts, jte, kts, kte )
1266 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1267 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
1269 ids,ide, jds, jde, kds, kde, &
1270 ims, ime, jms, jme, kms, kme, &
1271 its, ite, jts, jte, kts, kte )
1273 if (P_QC .ge. PARAM_FIRST_SCALAR) &
1274 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
1276 ids,ide, jds, jde, kds, kde, &
1277 ims, ime, jms, jme, kms, kme, &
1278 its, ite, jts, jte, kts, kte )
1280 if (P_QI .ge. PARAM_FIRST_SCALAR) &
1281 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
1283 ids,ide, jds, jde, kds, kde, &
1284 ims, ime, jms, jme, kms, kme, &
1285 its, ite, jts, jte, kts, kte )
1287 IF(.not. adv_moist_cond)THEN
1289 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1290 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1292 ids,ide, jds, jde, kds, kde, &
1293 ims, ime, jms, jme, kms, kme, &
1294 its, ite, jts, jte, kts, kte )
1296 if (P_QT .ge. PARAM_FIRST_SCALAR) &
1297 CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1299 ids,ide, jds, jde, kds, kde, &
1300 ims, ime, jms, jme, kms, kme, &
1301 its, ite, jts, jte, kts, kte )
1309 END SUBROUTINE g_phy_cu_ten
1311 !=================================================================
1312 SUBROUTINE phy_shcu_ten(config_flags,rk_step,n_moist, &
1313 rt_tendf,ru_tendf,rv_tendf, &
1314 RUSHTEN,RVSHTEN,RTHSHTEN, &
1315 RQVSHTEN,RQCSHTEN,RQRSHTEN, &
1316 RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf, &
1317 ids, ide, jds, jde, kds, kde, &
1318 ims, ime, jms, jme, kms, kme, &
1319 its, ite, jts, jte, kts, kte )
1320 !-----------------------------------------------------------------
1322 !-----------------------------------------------------------------
1323 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
1325 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1326 ims, ime, jms, jme, kms, kme, &
1327 its, ite, jts, jte, kts, kte, &
1330 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
1331 INTENT(INOUT) :: moist_tendf
1333 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
1344 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
1353 SELECT CASE (config_flags%shcu_physics)
1355 CASE (CAMUWSHCUSCHEME)
1356 CALL add_a2c_u(ru_tendf,RUSHTEN,config_flags, &
1357 ids,ide, jds, jde, kds, kde, &
1358 ims, ime, jms, jme, kms, kme, &
1359 its, ite, jts, jte, kts, kte )
1361 CALL add_a2c_v(rv_tendf,RVSHTEN,config_flags, &
1362 ids,ide, jds, jde, kds, kde, &
1363 ims, ime, jms, jme, kms, kme, &
1364 its, ite, jts, jte, kts, kte )
1366 CALL add_a2a(rt_tendf,RTHSHTEN,config_flags, &
1367 ids,ide, jds, jde, kds, kde, &
1368 ims, ime, jms, jme, kms, kme, &
1369 its, ite, jts, jte, kts, kte )
1371 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1372 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVSHTEN, &
1374 ids,ide, jds, jde, kds, kde, &
1375 ims, ime, jms, jme, kms, kme, &
1376 its, ite, jts, jte, kts, kte )
1378 if (P_QC .ge. PARAM_FIRST_SCALAR) &
1379 CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCSHTEN, &
1381 ids,ide, jds, jde, kds, kde, &
1382 ims, ime, jms, jme, kms, kme, &
1383 its, ite, jts, jte, kts, kte )
1385 if (P_QR .ge. PARAM_FIRST_SCALAR) &
1386 CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRSHTEN, &
1388 ids,ide, jds, jde, kds, kde, &
1389 ims, ime, jms, jme, kms, kme, &
1390 its, ite, jts, jte, kts, kte )
1392 if (P_QI .ge. PARAM_FIRST_SCALAR) &
1393 CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQISHTEN, &
1395 ids,ide, jds, jde, kds, kde, &
1396 ims, ime, jms, jme, kms, kme, &
1397 its, ite, jts, jte, kts, kte )
1399 if (P_QS .ge. PARAM_FIRST_SCALAR) &
1400 CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSSHTEN, &
1402 ids,ide, jds, jde, kds, kde, &
1403 ims, ime, jms, jme, kms, kme, &
1404 its, ite, jts, jte, kts, kte )
1406 if (P_QG .ge. PARAM_FIRST_SCALAR) &
1407 CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGSHTEN, &
1409 ids,ide, jds, jde, kds, kde, &
1410 ims, ime, jms, jme, kms, kme, &
1411 its, ite, jts, jte, kts, kte )
1418 END SUBROUTINE phy_shcu_ten
1420 !=================================================================
1421 SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, &
1422 rph_tendf,rt_tendf,ru_tendf,rv_tendf, &
1423 mu_tendf, moist_tendf, &
1424 RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
1425 RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
1426 ids, ide, jds, jde, kds, kde, &
1427 ims, ime, jms, jme, kms, kme, &
1428 its, ite, jts, jte, kts, kte )
1429 !-----------------------------------------------------------------
1431 !-----------------------------------------------------------------
1432 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
1434 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1435 ims, ime, jms, jme, kms, kme, &
1436 its, ite, jts, jte, kts, kte, &
1439 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
1440 INTENT(INOUT) :: moist_tendf
1442 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
1449 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
1451 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
1457 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
1461 INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1463 !-----------------------------------------------------------------
1465 SELECT CASE(config_flags%grid_fdda)
1469 CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
1470 ids,ide, jds, jde, kds, kde, &
1471 ims, ime, jms, jme, kms, kme, &
1472 its, ite, jts, jte, kts, kte )
1474 ! note fdda u and v tendencies are staggered
1475 CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
1476 ids,ide, jds, jde, kds, kde, &
1477 ims, ime, jms, jme, kms, kme, &
1478 its, ite, jts, jte, kts, kte )
1480 CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
1481 ids,ide, jds, jde, kds, kde, &
1482 ims, ime, jms, jme, kms, kme, &
1483 its, ite, jts, jte, kts, kte )
1485 CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, &
1486 ids,ide, jds, jde, kds, kds, &
1487 ims, ime, jms, jme, kms, kms, &
1488 its, ite, jts, jte, kts, kts )
1490 if (P_QV .ge. PARAM_FIRST_SCALAR) &
1491 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, &
1493 ids,ide, jds, jde, kds, kde, &
1494 ims, ime, jms, jme, kms, kme, &
1495 its, ite, jts, jte, kts, kte )
1499 ! note fdda u and v tendencies are staggered
1500 CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
1501 ids,ide, jds, jde, kds, kde, &
1502 ims, ime, jms, jme, kms, kme, &
1503 its, ite, jts, jte, kts, kte )
1505 CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
1506 ids,ide, jds, jde, kds, kde, &
1507 ims, ime, jms, jme, kms, kme, &
1508 its, ite, jts, jte, kts, kte )
1510 CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
1511 ids,ide, jds, jde, kds, kde, &
1512 ims, ime, jms, jme, kms, kme, &
1513 its, ite, jts, jte, kts, kte )
1515 CALL add_a2a_ph(rph_tendf,RPHNDGDTEN,config_flags, &
1516 ids,ide, jds, jde, kds, kde, &
1517 ims, ime, jms, jme, kms, kme, &
1518 its, ite, jts, jte, kts, kte )
1524 END SUBROUTINE phy_fg_ten
1526 !=================================================================
1527 SUBROUTINE phy_fr_ten(config_flags,rk_step,n_moist, &
1528 rt_tendf,ru_tendf,rv_tendf, &
1529 mu_tendf, moist_tendf, &
1530 rthfrten,rqvfrten, &
1531 ids, ide, jds, jde, kds, kde, &
1532 ims, ime, jms, jme, kms, kme, &
1533 its, ite, jts, jte, kts, kte )
1534 !-----------------------------------------------------------------
1535 USE module_state_description, ONLY : &
1537 !-----------------------------------------------------------------
1539 !-----------------------------------------------------------------
1540 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
1542 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1543 ims, ime, jms, jme, kms, kme, &
1544 its, ite, jts, jte, kts, kte, &
1547 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
1548 INTENT(INOUT) :: moist_tendf
1550 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
1554 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
1559 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
1563 INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1565 !-----------------------------------------------------------------
1567 SELECT CASE(config_flags%ifire)
1571 CALL add_a2a(rt_tendf,rthfrten, &
1573 ids,ide, jds, jde, kds, kde, &
1574 ims, ime, jms, jme, kms, kme, &
1575 its, ite, jts, jte, kts, kte )
1577 CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),rqvfrten, &
1579 ids,ide, jds, jde, kds, kde, &
1580 ims, ime, jms, jme, kms, kme, &
1581 its, ite, jts, jte, kts, kte )
1587 END SUBROUTINE phy_fr_ten
1589 !--------------------------------------------------- -------------------
1591 ! Generated by TAPENADE (INRIA, Tropics team)
1592 ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
1594 ! Differentiation of advance_ppt in forward (tangent) mode:
1595 ! variations of useful results: rqccuten rthcuten rqicuten
1596 ! rqscuten rainc cuppt nca rqrcuten rqvcuten rainsh
1598 ! with respect to varying inputs: pratesh rqccuten rthcuten rqicuten
1599 ! rqscuten rainc pratec cuppt cutop cubot nca rqrcuten
1600 ! rqvcuten rainsh htop hbot
1601 ! RW status of diff variables: pratesh:in rqccuten:in-out rthcuten:in-out
1602 ! rqicuten:in-out rqscuten:in-out rainc:in-out pratec:in
1603 ! cuppt:in-out cutop:in cubot:in nca:in-out rqrcuten:in-out
1604 ! rqvcuten:in-out rainsh:in-out htop:in-out hbot:in-out
1605 SUBROUTINE G_ADVANCE_PPT(rthcuten, rthcutend, rqvcuten, rqvcutend, &
1606 & rqccuten, rqccutend, rqrcuten, rqrcutend, rqicuten, rqicutend, &
1607 & rqscuten, rqscutend, rainc, raincd, raincv, rainsh, rainshd, pratec, &
1608 & pratecd, pratesh, prateshd, nca, ncad, htop, htopd, hbot, hbotd, cutop&
1609 & , cutopd, cubot, cubotd, cuppt, cupptd, dt, config_flags, ids, ide, &
1610 & jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
1614 TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
1615 INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
1616 & jme, kms, kme, its, ite, jts, jte, kts, kte
1617 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthcuten&
1618 & , rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten
1619 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthcutend&
1620 & , rqvcutend, rqccutend, rqrcutend, rqicutend, rqscutend
1621 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainc, rainsh, &
1622 & raincv, pratec, pratesh, nca, htop, hbot, cutop, cubot, cuppt
1623 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincd, rainshd, &
1624 & pratecd, prateshd, ncad, htopd, hbotd, cutopd, cubotd, cupptd
1625 REAL, INTENT(IN) :: dt
1627 INTEGER :: i, j, k, i_start, i_end, j_start, j_end, k_start, k_end
1628 INTEGER :: ncutop, ncubot
1629 !-----------------------------------------------------------------
1630 IF (config_flags%cu_physics .EQ. 0) THEN
1633 ! SET START AND END POINTS FOR TILES
1635 IF (ite .GT. ide - 1) THEN
1641 IF (jte .GT. jde - 1) THEN
1647 ! IF( config_flags%nested .or. config_flags%specified ) THEN
1648 ! i_start = max( its,ids+1 )
1649 ! i_end = min( ite,ide-2 )
1650 ! j_start = max( jts,jds+1 )
1651 ! j_end = min( jte,jde-2 )
1655 IF (kte .GT. kde - 1) THEN
1660 ! Update total cumulus scheme precipitation
1664 raincd(i, j) = raincd(i, j) + dt*pratecd(i, j)
1665 rainc(i, j) = rainc(i, j) + pratec(i, j)*dt
1666 rainshd(i, j) = rainshd(i, j) + dt*prateshd(i, j)
1667 rainsh(i, j) = rainsh(i, j) + pratesh(i, j)*dt
1668 cupptd(i, j) = cupptd(i, j) + dt*(pratecd(i, j)+prateshd(i, j))/&
1670 cuppt(i, j) = cuppt(i, j) + (pratec(i, j)+pratesh(i, j))*dt/&
1674 SELECT CASE (config_flags%cu_physics)
1678 IF (nca(i, j) .GT. 0) THEN
1679 IF (NINT(nca(i, j)/dt) .LE. 0) THEN
1680 ! set tendency to zero
1684 rthcutend(i, k, j) = 0.0
1685 rthcuten(i, k, j) = 0.
1686 rqvcutend(i, k, j) = 0.0
1687 rqvcuten(i, k, j) = 0.
1688 rqccutend(i, k, j) = 0.0
1689 rqccuten(i, k, j) = 0.
1690 rqrcutend(i, k, j) = 0.0
1691 rqrcuten(i, k, j) = 0.
1692 IF (p_qi .GE. param_first_scalar) THEN
1693 rqicutend(i, k, j) = 0.0
1694 rqicuten(i, k, j) = 0.
1696 IF (p_qs .GE. param_first_scalar) THEN
1697 rqscutend(i, k, j) = 0.0
1698 rqscuten(i, k, j) = 0.
1703 nca(i, j) = nca(i, j) - dt
1711 IF (nca(i, j) .GT. 0) THEN
1712 IF (NINT(nca(i, j)/dt) .LE. 0) THEN
1713 ! set tendency to zero
1717 rthcutend(i, k, j) = 0.0
1718 rthcuten(i, k, j) = 0.
1719 rqvcutend(i, k, j) = 0.0
1720 rqvcuten(i, k, j) = 0.
1724 nca(i, j) = nca(i, j) - dt
1728 CASE (bmjscheme, camzmscheme)
1732 ! HTOP, HBOT FOR GFDL RADIATION
1733 ncutop = NINT(cutop(i, j))
1734 ncubot = NINT(cubot(i, j))
1735 IF (ncutop .GT. 1 .AND. ncutop .LT. kde) THEN
1736 IF (cutop(i, j) .LT. htop(i, j)) THEN
1737 htop(i, j) = htop(i, j)
1739 htopd(i, j) = cutopd(i, j)
1740 htop(i, j) = cutop(i, j)
1743 IF (ncubot .GT. 0 .AND. ncubot .LT. kde) THEN
1744 IF (cubot(i, j) .GT. hbot(i, j)) THEN
1745 hbot(i, j) = hbot(i, j)
1747 hbotd(i, j) = cubotd(i, j)
1748 hbot(i, j) = cubot(i, j)
1753 CASE (kfetascheme, MSKFSCHEME)
1756 ! HTOP, HBOT FOR GFDL RADIATION
1757 ncutop = NINT(cutop(i, j))
1758 ncubot = NINT(cubot(i, j))
1759 IF (ncutop .GT. 1 .AND. ncutop .LT. kde) THEN
1760 IF (cutop(i, j) .LT. htop(i, j)) THEN
1761 htop(i, j) = htop(i, j)
1763 htopd(i, j) = cutopd(i, j)
1764 htop(i, j) = cutop(i, j)
1767 IF (ncubot .GT. 0 .AND. ncubot .LT. kde) THEN
1768 IF (cubot(i, j) .GT. hbot(i, j)) THEN
1769 hbot(i, j) = hbot(i, j)
1771 hbotd(i, j) = cubotd(i, j)
1772 hbot(i, j) = cubot(i, j)
1775 IF (nca(i, j) .GT. 0) THEN
1776 IF (NINT(nca(i, j)/dt) .LE. 1) THEN
1777 ! set tendency to zero
1781 rthcutend(i, k, j) = 0.0
1782 rthcuten(i, k, j) = 0.
1783 rqvcutend(i, k, j) = 0.0
1784 rqvcuten(i, k, j) = 0.
1785 rqccutend(i, k, j) = 0.0
1786 rqccuten(i, k, j) = 0.
1787 rqrcutend(i, k, j) = 0.0
1788 rqrcuten(i, k, j) = 0.
1789 IF (p_qi .GE. param_first_scalar) THEN
1790 rqicutend(i, k, j) = 0.0
1791 rqicuten(i, k, j) = 0.
1793 IF (p_qs .GE. param_first_scalar) THEN
1794 rqscutend(i, k, j) = 0.0
1795 rqscuten(i, k, j) = 0.
1800 nca(i, j) = nca(i, j) - dt
1801 ! NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
1807 END SUBROUTINE G_ADVANCE_PPT
1809 SUBROUTINE add_a2a(lvar,rvar,config_flags, &
1810 ids,ide, jds, jde, kds, kde, &
1811 ims, ime, jms, jme, kms, kme, &
1812 its, ite, jts, jte, kts, kte )
1813 !------------------------------------------------------------
1815 !------------------------------------------------------------
1816 TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
1818 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1819 ims, ime, jms, jme, kms, kme, &
1820 its, ite, jts, jte, kts, kte
1822 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1824 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1828 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1831 i_end = MIN(ite,ide-1)
1833 j_end = MIN(jte,jde-1)
1834 ktf = min(kte,kde-1)
1836 IF ( config_flags%specified .or. &
1837 config_flags%nested) i_start = MAX(ids+1,its)
1838 IF ( config_flags%specified .or. &
1839 config_flags%nested) i_end = MIN(ide-2,ite)
1840 IF ( config_flags%specified .or. &
1841 config_flags%nested) j_start = MAX(jds+1,jts)
1842 IF ( config_flags%specified .or. &
1843 config_flags%nested) j_end = MIN(jde-2,jte)
1844 IF ( config_flags%periodic_x ) i_start = its
1845 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1847 DO j = j_start,j_end
1849 DO i = i_start,i_end
1850 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1855 END SUBROUTINE add_a2a
1857 SUBROUTINE add_a2a_ph(lvar,rvar,config_flags, &
1858 ids,ide, jds, jde, kds, kde, &
1859 ims, ime, jms, jme, kms, kme, &
1860 its, ite, jts, jte, kts, kte )
1861 !------------------------------------------------------------
1863 !------------------------------------------------------------
1864 TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
1866 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1867 ims, ime, jms, jme, kms, kme, &
1868 its, ite, jts, jte, kts, kte
1870 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1872 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1876 INTEGER :: i,j,k,i_start,i_end,j_start,j_end
1879 i_end = MIN(ite,ide-1)
1881 j_end = MIN(jte,jde-1)
1883 IF ( config_flags%specified .or. &
1884 config_flags%nested) i_start = MAX(ids+1,its)
1885 IF ( config_flags%specified .or. &
1886 config_flags%nested) i_end = MIN(ide-2,ite)
1887 IF ( config_flags%specified .or. &
1888 config_flags%nested) j_start = MAX(jds+1,jts)
1889 IF ( config_flags%specified .or. &
1890 config_flags%nested) j_end = MIN(jde-2,jte)
1891 IF ( config_flags%periodic_x ) i_start = its
1892 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1894 DO j = j_start,j_end
1896 DO i = i_start,i_end
1897 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1902 END SUBROUTINE add_a2a_ph
1904 !------------------------------------------------------------
1905 SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
1906 ids,ide, jds, jde, kds, kde, &
1907 ims, ime, jms, jme, kms, kme, &
1908 its, ite, jts, jte, kts, kte )
1909 !------------------------------------------------------------
1910 !------------------------------------------------------------
1912 !------------------------------------------------------------
1914 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1916 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1917 ims, ime, jms, jme, kms, kme, &
1918 its, ite, jts, jte, kts, kte
1920 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1922 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1927 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1934 j_end = MIN(jte,jde-1)
1936 IF ( config_flags%specified .or. &
1937 config_flags%nested) i_start = MAX(ids+1,its)
1938 IF ( config_flags%specified .or. &
1939 config_flags%nested) i_end = MIN(ide-1,ite)
1940 IF ( config_flags%specified .or. &
1941 config_flags%nested) j_start = MAX(jds+1,jts)
1942 IF ( config_flags%specified .or. &
1943 config_flags%nested) j_end = MIN(jde-2,jte)
1944 IF ( config_flags%periodic_x ) i_start = its
1945 IF ( config_flags%periodic_x ) i_end = ite
1947 DO j = j_start,j_end
1949 DO i = i_start,i_end
1950 lvar(i,k,j) = lvar(i,k,j) + &
1951 0.5*(rvar(i,k,j)+rvar(i-1,k,j))
1956 END SUBROUTINE add_a2c_u
1958 !------------------------------------------------------------
1959 SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
1960 ids,ide, jds, jde, kds, kde, &
1961 ims, ime, jms, jme, kms, kme, &
1962 its, ite, jts, jte, kts, kte )
1963 !------------------------------------------------------------
1964 !------------------------------------------------------------
1966 !------------------------------------------------------------
1968 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
1970 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1971 ims, ime, jms, jme, kms, kme, &
1972 its, ite, jts, jte, kts, kte
1974 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
1976 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1981 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1986 i_end = MIN(ite,ide-1)
1990 IF ( config_flags%specified .or. &
1991 config_flags%nested) i_start = MAX(ids+1,its)
1992 IF ( config_flags%specified .or. &
1993 config_flags%nested) i_end = MIN(ide-2,ite)
1994 IF ( config_flags%specified .or. &
1995 config_flags%nested) j_start = MAX(jds+1,jts)
1996 IF ( config_flags%specified .or. &
1997 config_flags%nested) j_end = MIN(jde-1,jte)
1998 IF ( config_flags%periodic_x ) i_start = its
1999 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
2001 DO j = j_start,j_end
2003 DO i = i_start,i_end
2004 lvar(i,k,j) = lvar(i,k,j) + &
2005 0.5*(rvar(i,k,j)+rvar(i,k,j-1))
2010 END SUBROUTINE add_a2c_v
2013 ! Generated by TAPENADE (INRIA, Tropics team)
2014 ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
2016 ! Differentiation of add_a2a in forward (tangent) mode:
2017 ! variations of useful results: lvar
2018 ! with respect to varying inputs: lvar rvar
2019 ! RW status of diff variables: lvar:in-out rvar:in
2020 SUBROUTINE G_ADD_A2A(lvar, lvard, rvar, rvard, config_flags, ids, ide, &
2021 & jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
2024 !------------------------------------------------------------
2025 TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
2026 INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2027 & jme, kms, kme, its, ite, jts, jte, kts, kte
2028 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar
2029 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard
2030 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar
2031 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard
2033 INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2037 IF (ite .GT. ide - 1) THEN
2043 IF (jte .GT. jde - 1) THEN
2048 IF (kte .GT. kde - 1) THEN
2053 IF (config_flags%specified .OR. config_flags%nested) THEN
2054 IF (ids + 1 .LT. its) THEN
2060 IF (config_flags%specified .OR. config_flags%nested) THEN
2061 IF (ide - 2 .GT. ite) THEN
2067 IF (config_flags%specified .OR. config_flags%nested) THEN
2068 IF (jds + 1 .LT. jts) THEN
2074 IF (config_flags%specified .OR. config_flags%nested) THEN
2075 IF (jde - 2 .GT. jte) THEN
2081 IF (config_flags%periodic_x) i_start = its
2082 IF (config_flags%periodic_x) THEN
2083 IF (ite .GT. ide - 1) THEN
2092 lvard(i, k, j) = lvard(i, k, j) + rvard(i, k, j)
2093 lvar(i, k, j) = lvar(i, k, j) + rvar(i, k, j)
2097 END SUBROUTINE G_ADD_A2A
2099 ! Generated by TAPENADE (INRIA, Tropics team)
2100 ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
2102 ! Differentiation of add_a2c_u in forward (tangent) mode:
2103 ! variations of useful results: lvar
2104 ! with respect to varying inputs: lvar rvar
2105 ! RW status of diff variables: lvar:in-out rvar:in
2106 SUBROUTINE G_ADD_A2C_U(lvar, lvard, rvar, rvard, config_flags, ids, ide&
2107 & , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte&
2110 !------------------------------------------------------------
2111 TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
2112 INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2113 & jme, kms, kme, its, ite, jts, jte, kts, kte
2114 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar
2115 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard
2116 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar
2117 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard
2119 INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2122 IF (kte .GT. kde - 1) THEN
2130 IF (jte .GT. jde - 1) THEN
2135 IF (config_flags%specified .OR. config_flags%nested) THEN
2136 IF (ids + 1 .LT. its) THEN
2142 IF (config_flags%specified .OR. config_flags%nested) THEN
2143 IF (ide - 1 .GT. ite) THEN
2149 IF (config_flags%specified .OR. config_flags%nested) THEN
2150 IF (jds + 1 .LT. jts) THEN
2156 IF (config_flags%specified .OR. config_flags%nested) THEN
2157 IF (jde - 2 .GT. jte) THEN
2163 IF (config_flags%periodic_x) i_start = its
2164 IF (config_flags%periodic_x) i_end = ite
2168 lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i-1&
2170 lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i-1, k, &
2175 END SUBROUTINE G_ADD_A2C_U
2177 ! Generated by TAPENADE (INRIA, Tropics team)
2178 ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
2180 ! Differentiation of add_a2c_v in forward (tangent) mode:
2181 ! variations of useful results: lvar
2182 ! with respect to varying inputs: lvar rvar
2183 ! RW status of diff variables: lvar:in-out rvar:in
2184 SUBROUTINE G_ADD_A2C_V(lvar, lvard, rvar, rvard, config_flags, ids, ide&
2185 & , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte&
2188 !------------------------------------------------------------
2189 TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
2190 INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2191 & jme, kms, kme, its, ite, jts, jte, kts, kte
2192 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar
2193 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard
2194 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar
2195 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard
2197 INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2200 IF (kte .GT. kde - 1) THEN
2206 IF (ite .GT. ide - 1) THEN
2213 IF (config_flags%specified .OR. config_flags%nested) THEN
2214 IF (ids + 1 .LT. its) THEN
2220 IF (config_flags%specified .OR. config_flags%nested) THEN
2221 IF (ide - 2 .GT. ite) THEN
2227 IF (config_flags%specified .OR. config_flags%nested) THEN
2228 IF (jds + 1 .LT. jts) THEN
2234 IF (config_flags%specified .OR. config_flags%nested) THEN
2235 IF (jde - 1 .GT. jte) THEN
2241 IF (config_flags%periodic_x) i_start = its
2242 IF (config_flags%periodic_x) THEN
2243 IF (ite .GT. ide - 1) THEN
2252 lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i, k&
2254 lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i, k, j-&
2259 END SUBROUTINE G_ADD_A2C_V
2261 !------------------------------------------------------------
2262 SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
2263 ids,ide, jds, jde, kds, kde, &
2264 ims, ime, jms, jme, kms, kme, &
2265 its, ite, jts, jte, kts, kte )
2266 !------------------------------------------------------------
2267 !------------------------------------------------------------
2269 !------------------------------------------------------------
2271 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
2273 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
2274 ims, ime, jms, jme, kms, kme, &
2275 its, ite, jts, jte, kts, kte
2277 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
2279 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
2284 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
2291 j_end = MIN(jte,jde-1)
2294 IF ( config_flags%specified .or. &
2295 config_flags%nested) i_start = MAX(ids+1,its)
2296 IF ( config_flags%specified .or. &
2297 config_flags%nested) i_end = MIN(ide-1,ite)
2298 IF ( config_flags%specified .or. &
2299 config_flags%nested) j_start = MAX(jds+1,jts)
2300 IF ( config_flags%specified .or. &
2301 config_flags%nested) j_end = MIN(jde-2,jte)
2303 ! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
2305 DO j = j_start,j_end
2307 DO i = i_start,i_end
2308 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
2313 END SUBROUTINE add_c2c_u
2315 SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
2316 ids,ide, jds, jde, kds, kde, &
2317 ims, ime, jms, jme, kms, kme, &
2318 its, ite, jts, jte, kts, kte )
2319 !------------------------------------------------------------
2320 !------------------------------------------------------------
2322 !------------------------------------------------------------
2324 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
2326 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
2327 ims, ime, jms, jme, kms, kme, &
2328 its, ite, jts, jte, kts, kte
2330 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
2332 REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
2337 INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
2342 i_end = MIN(ite,ide-1)
2346 IF ( config_flags%specified .or. &
2347 config_flags%nested) i_start = MAX(ids+1,its)
2348 IF ( config_flags%specified .or. &
2349 config_flags%nested) i_end = MIN(ide-2,ite)
2350 IF ( config_flags%specified .or. &
2351 config_flags%nested) j_start = MAX(jds+1,jts)
2352 IF ( config_flags%specified .or. &
2353 config_flags%nested) j_end = MIN(jde-1,jte)
2355 ! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
2357 DO j = j_start,j_end
2359 DO i = i_start,i_end
2360 lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
2365 END SUBROUTINE add_c2c_v
2369 END MODULE g_module_physics_addtendc