source: trunk/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F @ 2761

Last change on this file since 2761 was 2761, checked in by aslmd, 2 years ago

Applied planetary adaptation changes to WRFV3. job done previously by LMD_LES_MARS_install. Moved Registry.EM.newphys to put it simply in Registry.EM

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