Merge remote-tracking branch 'origin/release-v4.5.2'
[WRF.git] / wrftladj / module_physics_addtendc_tl.F
blob8f80c49397edf544ff43121092d3903217e0b897
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
21 #if ( EM_CORE == 1 )
23    USE module_state_description
24    USE module_configure
26 CONTAINS
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 !-------------------------------------------------------------------
45    IMPLICIT NONE
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) ::   &
58                                                          ru_tendf, &
59                                                        g_ru_tendf, &
60                                                          rv_tendf, &
61                                                        g_rv_tendf, &
62                                                          rt_tendf, &
63                                                        g_rt_tendf, &
64                                                          rph_tendf
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, &
70                                                     g_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  ) ::   &
76                                                        RTHRATEN, &
77                                                        RTHBLTEN, &
78                                                      g_RTHBLTEN, &
79                                                        RTHCUTEN, &
80                                                      g_RTHCUTEN, &
81                                                        RTHSHTEN, &
82                                                         RUBLTEN, &
83                                                       g_RUBLTEN, &
84                                                         RUCUTEN, &
85                                                         RUSHTEN, &
86                                                         RVBLTEN, &
87                                                       g_RVBLTEN, &
88                                                         RVCUTEN, &
89                                                         RVSHTEN, &
90                                                        RQVBLTEN, &
91                                                      g_RQVBLTEN, &
92                                                        RQCBLTEN, &
93                                                        RQIBLTEN, &
94                                                        RQVCUTEN, &
95                                                      g_RQVCUTEN, &
96                                                        RQCCUTEN, &
97                                                        RQRCUTEN, &
98                                                        RQICUTEN, &
99                                                        RQSCUTEN, &
100                                                        RQVSHTEN, &
101                                                        RQCSHTEN, &
102                                                        RQRSHTEN, &
103                                                        RQISHTEN, &
104                                                        RQSSHTEN, &
105                                                        RQGSHTEN, &
106                                                      RTHNDGDTEN, &
107                                                      RPHNDGDTEN, &
108                                                      RQVNDGDTEN, &
109                                                       RUNDGDTEN, &
110                                                       RVNDGDTEN
112    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) :: RMUNDGDTEN
114    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   & ! fire
115                                                        rthfrten, &
116                                                        rqvfrten   
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,                     &
134                       RUBLTEN,g_RUBLTEN,                       &
135                       RVBLTEN,g_RVBLTEN,                       &
136                       RQVBLTEN,g_RQVBLTEN,                     &
137                       RQCBLTEN,RQIBLTEN,                       &
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,                   &
177                       rthfrten,rqvfrten,                       &
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 !-----------------------------------------------------------------
190    IMPLICIT NONE
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  ) ::   &
199                                                        RTHRATEN
201    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
202                                                        rt_tendf
204 ! LOCAL VARS
206    INTEGER :: i,j,k
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,                       &
221                       RUBLTEN,g_RUBLTEN,                         &
222                       RVBLTEN,g_RVBLTEN,                         & 
223                       RQVBLTEN,g_RQVBLTEN,                       &
224                       RQCBLTEN,RQIBLTEN,                         &
225                       ids, ide, jds, jde, kds, kde,              &
226                       ims, ime, jms, jme, kms, kme,              &
227                       its, ite, jts, jte, kts, kte               )
228 !-----------------------------------------------------------------
229    IMPLICIT NONE
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, &
242                                                   g_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  ) ::   & 
248                                                        RTHBLTEN, &
249                                                      g_RTHBLTEN, &
250                                                         RUBLTEN, &
251                                                       g_RUBLTEN, &
252                                                         RVBLTEN, &
253                                                       g_RVBLTEN, &
254                                                        RQVBLTEN, &
255                                                      g_RQVBLTEN, &
256                                                        RQCBLTEN, &
257                                                        RQIBLTEN
259    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
260                                                        rt_tendf, &
261                                                      g_rt_tendf, &
262                                                        ru_tendf, &
263                                                      g_ru_tendf, &
264                                                        rv_tendf, &
265                                                      g_rv_tendf
266 ! LOCAL VARS
268    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
270 !-----------------------------------------------------------------
272    SELECT CASE(config_flags%bl_pbl_physics)
274       CASE (YSUSCHEME)
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,  &
293                 config_flags,                                    &
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,  &
300                 config_flags,                                    &
301                 ids,ide, jds, jde, kds, kde,                     &
302                 ims, ime, jms, jme, kms, kme,                    &
303                 its, ite, jts, jte, kts, kte                     )
304      
305         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
306            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
307                 config_flags,                                    &
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,  &
316                 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         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
322            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
323                 config_flags,                                    &
324                 ids,ide, jds, jde, kds, kde,                     &
325                 ims, ime, jms, jme, kms, kme,                    &
326                 its, ite, jts, jte, kts, kte                     )
327        ENDIF
329       CASE (MRFSCHEME)
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,  &
348                 config_flags,                                    &
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,  &
355                 config_flags,                                    &
356                 ids,ide, jds, jde, kds, kde,                     &
357                 ims, ime, jms, jme, kms, kme,                    &
358                 its, ite, jts, jte, kts, kte                     )
359      
360         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
361            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
362                 config_flags,                                    &
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,  &
371                 config_flags,                                    &
372                 ids,ide, jds, jde, kds, kde,                     &
373                 ims, ime, jms, jme, kms, kme,                    &
374                 its, ite, jts, jte, kts, kte                     )
375      
376         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
377            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
378                 config_flags,                                    &
379                 ids,ide, jds, jde, kds, kde,                     &
380                 ims, ime, jms, jme, kms, kme,                    &
381                 its, ite, jts, jte, kts, kte                     )
382        ENDIF
384       CASE (ACMPBLSCHEME)
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,  &
403                 config_flags,                                    &
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,  &
410                 config_flags,                                    &
411                 ids,ide, jds, jde, kds, kde,                     &
412                 ims, ime, jms, jme, kms, kme,                    &
413                 its, ite, jts, jte, kts, kte                     )
414      
415         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
416            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
417                 config_flags,                                    &
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,  &
426                 config_flags,                                    &
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,  &
432                 config_flags,                                    &
433                 ids,ide, jds, jde, kds, kde,                     &
434                 ims, ime, jms, jme, kms, kme,                    &
435                 its, ite, jts, jte, kts, kte                     )
436         ENDIF
437      
438        ENDIF
440       CASE (MYJPBLSCHEME)
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,  &
459                 config_flags,                                    &
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,  &
468                 config_flags,                                    &
469                 ids,ide, jds, jde, kds, kde,                     &
470                 ims, ime, jms, jme, kms, kme,                    &
471                 its, ite, jts, jte, kts, kte                     )
472      
473         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
474            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
475                 config_flags,                                    &
476                 ids,ide, jds, jde, kds, kde,                     &
477                 ims, ime, jms, jme, kms, kme,                    &
478                 its, ite, jts, jte, kts, kte                     )
479      
480 !       if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
481 !          CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSBLTEN,  &
482 !               config_flags,                                    &
483 !               ids,ide, jds, jde, kds, kde,                     &
484 !               ims, ime, jms, jme, kms, kme,                    &
485 !               its, ite, jts, jte, kts, kte                     )
486 !    
487 !       if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
488 !          CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRBLTEN,  &
489 !               config_flags,                                    &
490 !               ids,ide, jds, jde, kds, kde,                     &
491 !               ims, ime, jms, jme, kms, kme,                    &
492 !               its, ite, jts, jte, kts, kte                     )
493 !    
494 !       if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
495 !          CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQGBLTEN,  &
496 !               config_flags,                                    &
497 !               ids,ide, jds, jde, kds, kde,                     &
498 !               ims, ime, jms, jme, kms, kme,                    &
499 !               its, ite, jts, jte, kts, kte                     )
500      
501        ELSE
503         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
504            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
505                 config_flags,                                    &
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,  &
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_QS .ge. PARAM_FIRST_SCALAR)                                         &
518 !          CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSBLTEN,  &
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),RQRBLTEN,  &
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_QG .ge. PARAM_FIRST_SCALAR)                                         &
532 !          CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGBLTEN,  &
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        ENDIF
540       CASE (QNSEPBLSCHEME)
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,  &
559                 config_flags,                                    &
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,  &
568                 config_flags,                                    &
569                 ids,ide, jds, jde, kds, kde,                     &
570                 ims, ime, jms, jme, kms, kme,                    &
571                 its, ite, jts, jte, kts, kte                     )
572      
573        ELSE
575         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
576            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
577                 config_flags,                                    &
578                 ids,ide, jds, jde, kds, kde,                     &
579                 ims, ime, jms, jme, kms, kme,                    &
580                 its, ite, jts, jte, kts, kte                     )
582        ENDIF
584       CASE (GFSSCHEME)
585                                                                                                                                         
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                     )
590                                                                                                                                         
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                     )
595                                                                                                                                         
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                     )
600                                                                                                                                         
601         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
602            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
603                 config_flags,                                    &
604                 ids,ide, jds, jde, kds, kde,                     &
605                 ims, ime, jms, jme, kms, kme,                    &
606                 its, ite, jts, jte, kts, kte                     )
607                                                                                                                                         
608         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
609            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
610                 config_flags,                                    &
611                 ids,ide, jds, jde, kds, kde,                     &
612                 ims, ime, jms, jme, kms, kme,                    &
613                 its, ite, jts, jte, kts, kte                     )
614                                                                                                                                         
615         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
616            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
617                 config_flags,                                    &
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,  &
626                 config_flags,                                    &
627                 ids,ide, jds, jde, kds, kde,                     &
628                 ims, ime, jms, jme, kms, kme,                    &
629                 its, ite, jts, jte, kts, kte                     )
630      
631         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
632            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
633                 config_flags,                                    &
634                 ids,ide, jds, jde, kds, kde,                     &
635                 ims, ime, jms, jme, kms, kme,                    &
636                 its, ite, jts, jte, kts, kte                     )
637        ENDIF
639       CASE (MYNNPBLSCHEME)
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,  &
658                 config_flags,                                    &
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,  &
665                 config_flags,                                    &
666                 ids,ide, jds, jde, kds, kde,                     &
667                 ims, ime, jms, jme, kms, kme,                    &
668                 its, ite, jts, jte, kts, kte                     )
669      
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,  &
674                 config_flags,                                    &
675                 ids,ide, jds, jde, kds, kde,                     &
676                 ims, ime, jms, jme, kms, kme,                    &
677                 its, ite, jts, jte, kts, kte                     )
678      
679        ENDIF
681        CASE (BOULACSCHEME)
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,  &
700                 config_flags,                                    &
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,  &
709                 config_flags,                                    &
710                 ids,ide, jds, jde, kds, kde,                     &
711                 ims, ime, jms, jme, kms, kme,                    &
712                 its, ite, jts, jte, kts, kte                     )
714        ELSE
716         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
717            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
718                 config_flags,                                    &
719                 ids,ide, jds, jde, kds, kde,                     &
720                 ims, ime, jms, jme, kms, kme,                    &
721                 its, ite, jts, jte, kts, kte                     )
722        ENDIF
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,                         &
748                    config_flags,                                 &
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,  &
771                 config_flags,                                    &
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,  &
780                 config_flags,                                    &
781                 ids,ide, jds, jde, kds, kde,                     &
782                 ims, ime, jms, jme, kms, kme,                    &
783                 its, ite, jts, jte, kts, kte                     )
785        ELSE
787         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
788            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
789                 config_flags,                                    &
790                 ids,ide, jds, jde, kds, kde,                     &
791                 ims, ime, jms, jme, kms, kme,                    &
792                 its, ite, jts, jte, kts, kte                     )
793        ENDIF
796       CASE (TEMFPBLSCHEME)
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,  &
814                 config_flags,                                    &
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,  &
821                 config_flags,                                    &
822                 ids,ide, jds, jde, kds, kde,                     &
823                 ims, ime, jms, jme, kms, kme,                    &
824                 its, ite, jts, jte, kts, kte                     )
825      
826         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
827            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
828                 config_flags,                                    &
829                 ids,ide, jds, jde, kds, kde,                     &
830                 ims, ime, jms, jme, kms, kme,                    &
831                 its, ite, jts, jte, kts, kte                     )
833       CASE DEFAULT
835        print*,'g_phy_bl_ten: The pbl scheme does not exist'
837    END SELECT
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 !-----------------------------------------------------------------
852    IMPLICIT NONE
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  ) ::   &
870                                                         RUCUTEN, &
871                                                         RVCUTEN, &
872                                                        RTHCUTEN, &
873                                                      g_RTHCUTEN, &
874                                                        RQVCUTEN, &
875                                                      g_RQVCUTEN, &
876                                                        RQCCUTEN, &
877                                                        RQRCUTEN, &
878                                                        RQICUTEN, &
879                                                        RQSCUTEN
881    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
882                                                        rt_tendf, &
883                                                      g_rt_tendf, &
884                                                        ru_tendf, &
885                                                        rv_tendf
888 ! LOCAL VARS
890    INTEGER :: i,j,k
892    SELECT CASE (config_flags%cu_physics)   
894    CASE (KFSCHEME)
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,     &
902                 config_flags,                                    &
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,     &
909                 config_flags,                                    &
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,     &
916                 config_flags,                                    &
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,     &
923                 config_flags,                                    &
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,     &
930                 config_flags,                                    &
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, &
939                 config_flags,                                    &
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, &
946                 config_flags,                                    &
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, &
953                 config_flags,                                    &
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, &
960                 config_flags,                                    &
961                 ids,ide, jds, jde, kds, kde,                     &
962                 ims, ime, jms, jme, kms, kme,                    &
963                 its, ite, jts, jte, kts, kte                     )
965        ENDIF
967    CASE (BMJSCHEME)
968         CALL add_a2a(rt_tendf,RTHCUTEN,                          &
969                 config_flags,                                    &
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,     &
976                 config_flags,                                    &
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,     &
989                 config_flags,                                    &
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,     &
996                 config_flags,                                    &
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,     &
1003                 config_flags,                                    &
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,     &
1010                 config_flags,                                    &
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,     &
1017                 config_flags,                                    &
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, &
1026                 config_flags,                                    &
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, &
1033                 config_flags,                                    &
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, &
1040                 config_flags,                                    &
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, &
1047                 config_flags,                                    &
1048                 ids,ide, jds, jde, kds, kde,                     &
1049                 ims, ime, jms, jme, kms, kme,                    &
1050                 its, ite, jts, jte, kts, kte                     )
1052        ENDIF
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,     &
1061                 config_flags,                                    &
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,     &
1068                 config_flags,                                    &
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,     &
1075                 config_flags,                                    &
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, &
1084                 config_flags,                                    &
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, &
1091                 config_flags,                                    &
1092                 ids,ide, jds, jde, kds, kde,                     &
1093                 ims, ime, jms, jme, kms, kme,                    &
1094                 its, ite, jts, jte, kts, kte                     )
1096        ENDIF
1098    CASE (NSASSCHEME)
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,     &
1116                 config_flags,                                    &
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,     &
1123                 config_flags,                                    &
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,     &
1130                 config_flags,                                    &
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, &
1139                 config_flags,                                    &
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, &
1146                 config_flags,                                    &
1147                 ids,ide, jds, jde, kds, kde,                     &
1148                 ims, ime, jms, jme, kms, kme,                    &
1149                 its, ite, jts, jte, kts, kte                     )
1151        ENDIF
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,     &
1161                 config_flags,                                    &
1162                 ids,ide, jds, jde, kds, kde,                     &
1163                 ims, ime, jms, jme, kms, kme,                    &
1164                 its, ite, jts, jte, kts, kte                     )
1165           
1166         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
1167         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
1168                 config_flags,                                    &
1169                 ids,ide, jds, jde, kds, kde,                     &
1170                 ims, ime, jms, jme, kms, kme,                    &
1171                 its, ite, jts, jte, kts, kte                     )
1172           
1173         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
1174         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1175                 config_flags,                                    &
1176                 ids,ide, jds, jde, kds, kde,                     &
1177                 ims, ime, jms, jme, kms, kme,                    &
1178                 its, ite, jts, jte, kts, kte                     )
1180    CASE (DUCUSCHEME)
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,       &
1190                 g_RQVCUTEN,                                      &
1191                 config_flags,                                    &
1192                 ids,ide, jds, jde, kds, kde,                     &
1193                 ims, ime, jms, jme, kms, kme,                    &
1194                 its, ite, jts, jte, kts, kte                     )
1196    CASE (CAMZMSCHEME)
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                     )
1211                                                                                                                                         
1212         if (P_QV .ge. PARAM_FIRST_SCALAR)                        &
1213         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
1214                 config_flags,                                    &
1215                 ids,ide, jds, jde, kds, kde,                     &
1216                 ims, ime, jms, jme, kms, kme,                    &
1217                 its, ite, jts, jte, kts, kte                     )
1218           
1219         if (P_QC .ge. PARAM_FIRST_SCALAR)                        &
1220         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
1221                 config_flags,                                    &
1222                 ids,ide, jds, jde, kds, kde,                     &
1223                 ims, ime, jms, jme, kms, kme,                    &
1224                 its, ite, jts, jte, kts, kte                     )
1225           
1226         if (P_QI .ge. PARAM_FIRST_SCALAR)                        &
1227         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1228                 config_flags,                                    &
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, &
1236                 config_flags,                                    &
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, &
1243                 config_flags,                                    &
1244                 ids,ide, jds, jde, kds, kde,                     &
1245                 ims, ime, jms, jme, kms, kme,                    &
1246                 its, ite, jts, jte, kts, kte                     )
1248        ENDIF
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,     &
1268                 config_flags,                                    &
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,     &
1275                 config_flags,                                    &
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,     &
1282                 config_flags,                                    &
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, &
1291                 config_flags,                                    &
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, &
1298                 config_flags,                                    &
1299                 ids,ide, jds, jde, kds, kde,                     &
1300                 ims, ime, jms, jme, kms, kme,                    &
1301                 its, ite, jts, jte, kts, kte                     )
1303        ENDIF
1305    CASE DEFAULT
1307    END SELECT
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 !-----------------------------------------------------------------
1321    IMPLICIT NONE
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, &
1328                                    n_moist, rk_step
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  ) ::   &
1334                                                         RUSHTEN, &
1335                                                         RVSHTEN, &
1336                                                        RTHSHTEN, &
1337                                                        RQVSHTEN, &
1338                                                        RQCSHTEN, &
1339                                                        RQRSHTEN, &
1340                                                        RQISHTEN, &
1341                                                        RQSSHTEN, &
1342                                                        RQGSHTEN
1344    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
1345                                                        rt_tendf, &
1346                                                        ru_tendf, &
1347                                                        rv_tendf
1349 ! LOCAL VARS
1351    INTEGER :: i,j,k
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,     &
1373                 config_flags,                                    &
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,     &
1380                 config_flags,                                    &
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,     &
1387                 config_flags,                                    &
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,     &
1394                 config_flags,                                    &
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,     &
1401                 config_flags,                                    &
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,     &
1408                 config_flags,                                    &
1409                 ids,ide, jds, jde, kds, kde,                     &
1410                 ims, ime, jms, jme, kms, kme,                    &
1411                 its, ite, jts, jte, kts, kte                     )
1413    CASE DEFAULT
1415    END SELECT
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 !-----------------------------------------------------------------
1430    IMPLICIT NONE
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, &
1437                                    n_moist, rk_step
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  ) ::   &
1443                                                        RTHNDGDTEN, &
1444                                                        RPHNDGDTEN, &
1445                                                         RUNDGDTEN, &
1446                                                         RVNDGDTEN, &
1447                                                        RQVNDGDTEN
1449    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) ::  RMUNDGDTEN
1451    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
1452                                                        rph_tendf,&
1453                                                        rt_tendf, &
1454                                                        ru_tendf, &
1455                                                        rv_tendf
1457    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
1459 ! LOCAL VARS
1461    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1463 !-----------------------------------------------------------------
1465    SELECT CASE(config_flags%grid_fdda)
1467       CASE (PSUFDDAGD)
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,  &
1492                 config_flags,                                    &
1493                 ids,ide, jds, jde, kds, kde,                     &
1494                 ims, ime, jms, jme, kms, kme,                    &
1495                 its, ite, jts, jte, kts, kte                     )
1497       CASE (SPNUDGING)
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                     )
1520       CASE DEFAULT
1522    END SELECT
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 :                         &
1536                    FIRE_SFIRE
1537 !-----------------------------------------------------------------
1538    IMPLICIT NONE
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, &
1545                                    n_moist, rk_step
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  ) ::   &
1551                                                        rthfrten, &
1552                                                        rqvfrten 
1554    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
1555                                                        rt_tendf, &
1556                                                        ru_tendf, &
1557                                                        rv_tendf
1559    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
1561 ! LOCAL VARS
1563    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1565 !-----------------------------------------------------------------
1567    SELECT CASE(config_flags%ifire)
1569       CASE (FIRE_SFIRE)
1571            CALL add_a2a(rt_tendf,rthfrten,                       &
1572                 config_flags,                                    &
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,  &
1578                 config_flags,                                    &
1579                 ids,ide, jds, jde, kds, kde,                     &
1580                 ims, ime, jms, jme, kms, kme,                    &
1581                 its, ite, jts, jte, kts, kte                     )
1583       CASE DEFAULT
1585    END SELECT
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
1597 !                htop hbot
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, &
1611 &  kts, kte)
1612   IMPLICIT NONE
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
1626 ! LOCAL  VAR
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
1631     RETURN
1632   ELSE
1633 ! SET START AND END POINTS FOR TILES
1634     i_start = its
1635     IF (ite .GT. ide - 1) THEN
1636       i_end = ide - 1
1637     ELSE
1638       i_end = ite
1639     END IF
1640     j_start = jts
1641     IF (jte .GT. jde - 1) THEN
1642       j_end = jde - 1
1643     ELSE
1644       j_end = jte
1645     END IF
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 )
1652 !  ENDIF
1654     k_start = kts
1655     IF (kte .GT. kde - 1) THEN
1656       k_end = kde - 1
1657     ELSE
1658       k_end = kte
1659     END IF
1660 ! Update total cumulus scheme precipitation
1661 ! in mm  
1662     DO j=j_start,j_end
1663       DO i=i_start,i_end
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))/&
1669 &          1000.
1670         cuppt(i, j) = cuppt(i, j) + (pratec(i, j)+pratesh(i, j))*dt/&
1671 &          1000.
1672       END DO
1673     END DO
1674     SELECT CASE  (config_flags%cu_physics) 
1675     CASE (kfscheme) 
1676       DO j=j_start,j_end
1677         DO i=i_start,i_end
1678           IF (nca(i, j) .GT. 0) THEN
1679             IF (NINT(nca(i, j)/dt) .LE. 0) THEN
1680 ! set tendency to zero
1681 !                PRATEC(I,J)=0.
1682 !                RAINCV(I,J)=0.
1683               DO k=k_start,k_end
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.
1695                 END IF
1696                 IF (p_qs .GE. param_first_scalar) THEN
1697                   rqscutend(i, k, j) = 0.0
1698                   rqscuten(i, k, j) = 0.
1699                 END IF
1700               END DO
1701             END IF
1702 ! Decrease NCA
1703             nca(i, j) = nca(i, j) - dt
1704           END IF
1705         END DO
1706       END DO
1707     CASE (ducuscheme) 
1709       DO j=j_start,j_end
1710         DO i=i_start,i_end
1711           IF (nca(i, j) .GT. 0) THEN
1712             IF (NINT(nca(i, j)/dt) .LE. 0) THEN
1713 ! set tendency to zero
1714 !!                PRATEC(I,J)=0.
1715 !!                RAINCV(I,J)=0.
1716               DO k=k_start,k_end
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.
1721               END DO
1722             END IF
1723 ! Decrease NCA
1724             nca(i, j) = nca(i, j) - dt
1725           END IF
1726         END DO
1727       END DO
1728     CASE (bmjscheme, camzmscheme) 
1730       DO j=j_start,j_end
1731         DO i=i_start,i_end
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)
1738             ELSE
1739               htopd(i, j) = cutopd(i, j)
1740               htop(i, j) = cutop(i, j)
1741             END IF
1742           END IF
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)
1746             ELSE
1747               hbotd(i, j) = cubotd(i, j)
1748               hbot(i, j) = cubot(i, j)
1749             END IF
1750           END IF
1751         END DO
1752       END DO
1753     CASE (kfetascheme, MSKFSCHEME) 
1754       DO j=j_start,j_end
1755         DO i=i_start,i_end
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)
1762             ELSE
1763               htopd(i, j) = cutopd(i, j)
1764               htop(i, j) = cutop(i, j)
1765             END IF
1766           END IF
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)
1770             ELSE
1771               hbotd(i, j) = cubotd(i, j)
1772               hbot(i, j) = cubot(i, j)
1773             END IF
1774           END IF
1775           IF (nca(i, j) .GT. 0) THEN
1776             IF (NINT(nca(i, j)/dt) .LE. 1) THEN
1777 ! set tendency to zero
1778 !                PRATEC(I,J)=0.
1779 !                RAINCV(I,J)=0.
1780               DO k=k_start,k_end
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.
1792                 END IF
1793                 IF (p_qs .GE. param_first_scalar) THEN
1794                   rqscutend(i, k, j) = 0.0
1795                   rqscuten(i, k, j) = 0.
1796                 END IF
1797               END DO
1798             END IF
1799 ! Decrease NCA
1800             nca(i, j) = nca(i, j) - dt
1801 !              NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
1802           END IF
1803         END DO
1804       END DO
1805     END SELECT
1806   END IF
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 !------------------------------------------------------------
1814    IMPLICIT NONE
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   ) ::&
1823                                                       rvar
1824    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1825                                                       lvar
1827 ! LOCAL VARS
1828    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1830    i_start = its
1831    i_end   = MIN(ite,ide-1)
1832    j_start = jts
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
1848    DO k = kts,ktf
1849    DO i = i_start,i_end
1850       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1851    ENDDO
1852    ENDDO
1853    ENDDO
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 !------------------------------------------------------------
1862    IMPLICIT NONE
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   ) ::&
1871                                                       rvar
1872    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1873                                                       lvar
1875 ! LOCAL VARS
1876    INTEGER :: i,j,k,i_start,i_end,j_start,j_end
1878    i_start = its
1879    i_end   = MIN(ite,ide-1)
1880    j_start = jts
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
1895    DO k = kts,kte
1896    DO i = i_start,i_end
1897       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1898    ENDDO
1899    ENDDO
1900    ENDDO
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 !------------------------------------------------------------
1911    IMPLICIT NONE
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   ) ::&
1921                                                       rvar
1922    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1923                                                       lvar
1925 ! LOCAL VARS
1927    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1929    ktf=min(kte,kde-1)
1931    i_start = its
1932    i_end   = ite
1933    j_start = jts
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
1948    DO k = kts,ktf
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))
1952    ENDDO
1953    ENDDO
1954    ENDDO
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 !------------------------------------------------------------
1965    IMPLICIT NONE
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   ) ::&
1975                                                       rvar
1976    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1977                                                       lvar
1979 ! LOCAL VARS
1981    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1983    ktf=min(kte,kde-1)
1985    i_start = its
1986    i_end   = MIN(ite,ide-1)
1987    j_start = jts
1988    j_end   = jte
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
2002    DO k = kts,kte
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))
2006    ENDDO
2007    ENDDO
2008    ENDDO
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, &
2022 &  kts, kte)
2023   IMPLICIT NONE
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
2032 ! LOCAL VARS
2033   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2034   INTRINSIC MAX
2035   INTRINSIC MIN
2036   i_start = its
2037   IF (ite .GT. ide - 1) THEN
2038     i_end = ide - 1
2039   ELSE
2040     i_end = ite
2041   END IF
2042   j_start = jts
2043   IF (jte .GT. jde - 1) THEN
2044     j_end = jde - 1
2045   ELSE
2046     j_end = jte
2047   END IF
2048   IF (kte .GT. kde - 1) THEN
2049     ktf = kde - 1
2050   ELSE
2051     ktf = kte
2052   END IF
2053   IF (config_flags%specified .OR. config_flags%nested) THEN
2054     IF (ids + 1 .LT. its) THEN
2055       i_start = its
2056     ELSE
2057       i_start = ids + 1
2058     END IF
2059   END IF
2060   IF (config_flags%specified .OR. config_flags%nested) THEN
2061     IF (ide - 2 .GT. ite) THEN
2062       i_end = ite
2063     ELSE
2064       i_end = ide - 2
2065     END IF
2066   END IF
2067   IF (config_flags%specified .OR. config_flags%nested) THEN
2068     IF (jds + 1 .LT. jts) THEN
2069       j_start = jts
2070     ELSE
2071       j_start = jds + 1
2072     END IF
2073   END IF
2074   IF (config_flags%specified .OR. config_flags%nested) THEN
2075     IF (jde - 2 .GT. jte) THEN
2076       j_end = jte
2077     ELSE
2078       j_end = jde - 2
2079     END IF
2080   END IF
2081   IF (config_flags%periodic_x) i_start = its
2082   IF (config_flags%periodic_x) THEN
2083     IF (ite .GT. ide - 1) THEN
2084       i_end = ide - 1
2085     ELSE
2086       i_end = ite
2087     END IF
2088   END IF
2089   DO j=j_start,j_end
2090     DO k=kts,ktf
2091       DO i=i_start,i_end
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)
2094       END DO
2095     END DO
2096   END DO
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&
2108 &  , kts, kte)
2109   IMPLICIT NONE
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
2118 ! LOCAL VARS
2119   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2120   INTRINSIC MAX
2121   INTRINSIC MIN
2122   IF (kte .GT. kde - 1) THEN
2123     ktf = kde - 1
2124   ELSE
2125     ktf = kte
2126   END IF
2127   i_start = its
2128   i_end = ite
2129   j_start = jts
2130   IF (jte .GT. jde - 1) THEN
2131     j_end = jde - 1
2132   ELSE
2133     j_end = jte
2134   END IF
2135   IF (config_flags%specified .OR. config_flags%nested) THEN
2136     IF (ids + 1 .LT. its) THEN
2137       i_start = its
2138     ELSE
2139       i_start = ids + 1
2140     END IF
2141   END IF
2142   IF (config_flags%specified .OR. config_flags%nested) THEN
2143     IF (ide - 1 .GT. ite) THEN
2144       i_end = ite
2145     ELSE
2146       i_end = ide - 1
2147     END IF
2148   END IF
2149   IF (config_flags%specified .OR. config_flags%nested) THEN
2150     IF (jds + 1 .LT. jts) THEN
2151       j_start = jts
2152     ELSE
2153       j_start = jds + 1
2154     END IF
2155   END IF
2156   IF (config_flags%specified .OR. config_flags%nested) THEN
2157     IF (jde - 2 .GT. jte) THEN
2158       j_end = jte
2159     ELSE
2160       j_end = jde - 2
2161     END IF
2162   END IF
2163   IF (config_flags%periodic_x) i_start = its
2164   IF (config_flags%periodic_x) i_end = ite
2165   DO j=j_start,j_end
2166     DO k=kts,ktf
2167       DO i=i_start,i_end
2168         lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i-1&
2169 &          , k, j))
2170         lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i-1, k, &
2171 &          j))
2172       END DO
2173     END DO
2174   END DO
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&
2186 &  , kts, kte)
2187   IMPLICIT NONE
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
2196 ! LOCAL VARS
2197   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2198   INTRINSIC MAX
2199   INTRINSIC MIN
2200   IF (kte .GT. kde - 1) THEN
2201     ktf = kde - 1
2202   ELSE
2203     ktf = kte
2204   END IF
2205   i_start = its
2206   IF (ite .GT. ide - 1) THEN
2207     i_end = ide - 1
2208   ELSE
2209     i_end = ite
2210   END IF
2211   j_start = jts
2212   j_end = jte
2213   IF (config_flags%specified .OR. config_flags%nested) THEN
2214     IF (ids + 1 .LT. its) THEN
2215       i_start = its
2216     ELSE
2217       i_start = ids + 1
2218     END IF
2219   END IF
2220   IF (config_flags%specified .OR. config_flags%nested) THEN
2221     IF (ide - 2 .GT. ite) THEN
2222       i_end = ite
2223     ELSE
2224       i_end = ide - 2
2225     END IF
2226   END IF
2227   IF (config_flags%specified .OR. config_flags%nested) THEN
2228     IF (jds + 1 .LT. jts) THEN
2229       j_start = jts
2230     ELSE
2231       j_start = jds + 1
2232     END IF
2233   END IF
2234   IF (config_flags%specified .OR. config_flags%nested) THEN
2235     IF (jde - 1 .GT. jte) THEN
2236       j_end = jte
2237     ELSE
2238       j_end = jde - 1
2239     END IF
2240   END IF
2241   IF (config_flags%periodic_x) i_start = its
2242   IF (config_flags%periodic_x) THEN
2243     IF (ite .GT. ide - 1) THEN
2244       i_end = ide - 1
2245     ELSE
2246       i_end = ite
2247     END IF
2248   END IF
2249   DO j=j_start,j_end
2250     DO k=kts,kte
2251       DO i=i_start,i_end
2252         lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i, k&
2253 &          , j-1))
2254         lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i, k, j-&
2255 &          1))
2256       END DO
2257     END DO
2258   END DO
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 !------------------------------------------------------------
2268    IMPLICIT NONE
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   ) ::&
2278                                                       rvar
2279    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
2280                                                       lvar
2282 ! LOCAL VARS
2284    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
2286    ktf=min(kte,kde-1)
2288    i_start = its
2289    i_end   = ite
2290    j_start = jts
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
2306    DO k = kts,ktf
2307    DO i = i_start,i_end
2308       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
2309    ENDDO
2310    ENDDO
2311    ENDDO
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 !------------------------------------------------------------
2321    IMPLICIT NONE
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   ) ::&
2331                                                       rvar
2332    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
2333                                                       lvar
2335 ! LOCAL VARS
2337    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
2339    ktf=min(kte,kde-1)
2341    i_start = its
2342    i_end   = MIN(ite,ide-1)
2343    j_start = jts
2344    j_end   = jte
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
2358    DO k = kts,kte
2359    DO i = i_start,i_end
2360       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
2361    ENDDO
2362    ENDDO
2363    ENDDO
2365 END SUBROUTINE add_c2c_v
2367 #endif
2369 END MODULE g_module_physics_addtendc