LMDZ
CVAmnh.f90
Go to the documentation of this file.
1 ! ######spl
2  SUBROUTINE convection( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, &
3  pdtconv, odeep, oshal, orefresh_all, odown, kice, &
4  osettadj, ptadjd, ptadjs, &
5  kensm, &
6  ppabs, pzz, pdxdy, &
7  pt, prv, prc, pri, pu, pv, pw, &
8  kcount, ptten, prvten, prcten, priten, &
9  pprten, pprsten, &
10  pumf, pdmf, pprlflx, pprsflx, pcape, kcltop, kclbas,&
11  ochtrans, kch1, pch1, pch1ten )
12 ! ############################################################################
13 !
14 !!**** Interface routine to the fast MNH convection code developed for ECMWF/ARPEGE IFS
15 !! having a structure typical for operational routines
16 !!
17 !!
18 !! PURPOSE
19 !! -------
20 !! The routine interfaces the MNH convection code as developed for operational
21 !! forecast models like ECMWF, ARPEGE or HIRLAM with the typical MNH array structure
22 !! Calls the deep and/or shallow convection routine
23 !!
24 !!
25 !!** METHOD
26 !! ------
27 !! Returns one tendency for shallow+deep convection but each part can
28 !! be activated/desactivated separately.
29 !! For deep convection one can enable up to 3 additional ensemble members
30 !! - this substantially improves the smoothness of the scheme and
31 !! allows for runs with different cloud radii (entrainment rates) and
32 !! reduces the arbitrariness inherent to convective trigger condition
33 !!
34 !!
35 !!
36 !! EXTERNAL
37 !! --------
38 !! CONVECT_DEEP
39 !! CONVECT_SHALLOW
40 !! INI_CONVPAR, INI_CONVPAR1
41 !!
42 !! IMPLICIT ARGUMENTS
43 !! ------------------
44 !!
45 !! AUTHOR
46 !! ------
47 !! P. BECHTOLD * Laboratoire d'Aerologie *
48 !!
49 !! MODIFICATIONS
50 !! -------------
51 !! Original 11/12/98
52 !! Modif 11/04/O2 allow for ensemble of deep updrafts/downdrafts
53 !!
54 !! REFERENCE
55 !! ---------
56 !! Bechtold et al., 2001, Quart. J. Roy. Meteor. Soc., Vol 127, pp 869-886:
57 !! A mass flux convection scheme for regional and global models.
58 !!
59 !-------------------------------------------------------------------------------
60 !
61 !* 0. DECLARATIONS
62 ! ------------
63 !
64 !
65 IMPLICIT NONE
66 !
67 !* 0.1 Declarations of dummy arguments :
68 !
69 !
70 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
71 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
72 INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
73 INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
74 INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
75 ! ! KBDIA that is at least 1
76 INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
77  ! limited to KLEV + 1 - KTDIA
78  ! default=1
79 REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
80  ! calls of the deep convection
81  ! scheme
82 LOGICAL, INTENT(IN) :: ODEEP ! switch for deep convection
83 LOGICAL, INTENT(IN) :: OSHAL ! switch for shallow convection
84 LOGICAL, INTENT(IN) :: OREFRESH_ALL ! refresh or not all
85  ! tendencies at every call
86 LOGICAL, INTENT(IN) :: ODOWN ! take or not convective
87  ! downdrafts into account
88 INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
89  ! 0 = no ice )
90 INTEGER, INTENT(IN) :: KENSM ! number of additional deep convection calls
91  ! for ensemble (presently limited to 3)
92  ! KENSM=0 corresponds to base run with
93  ! 1 deep and 1 shallow call
94 LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
95  ! adjustment time by user
96 REAL, INTENT(IN) :: PTADJD ! user defined deep adjustment time (s)
97 REAL, INTENT(IN) :: PTADJS ! user defined shal. adjustment time (s)
98 !
99 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PT ! grid scale T at time t (K)
100 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRV ! grid scale water vapor (kg/kg)
101 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRC ! grid scale r_c (kg/kg)
102 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRI ! grid scale r_i (kg/kg)
103 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU ! grid scale horiz. wind u (m/s)
104 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV ! grid scale horiz. wind v (m/s)
105 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PW ! grid scale vertical velocity (m/s)
106 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABS ! grid scale pressure (Pa)
107 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
108 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m2)
109 !
110 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCOUNT ! convective counter(recompute
111  ! tendency or keep it
112 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperat. tendency (K/s)
113 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
114 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
115 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
116 REAL, DIMENSION(KLON), INTENT(INOUT):: PPRTEN ! total surf precipitation tendency (m/s)
117 REAL, DIMENSION(KLON), INTENT(INOUT):: PPRSTEN! solid surf precipitation tendency (m/s)
118 !
119 ! Chemical Tracers:
120 LOGICAL, INTENT(IN) :: OCHTRANS ! flag to compute convective
121  ! transport for chemical tracer
122 INTEGER, INTENT(IN) :: KCH1 ! number of species
123 REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1 ! grid scale chemical species
124 REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN ! chemical convective tendency
125  ! (1/s)
126 !
127 ! Diagnostic variables:
128 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s m2)
129 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s m2)
130 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PPRLFLX! liquid precip flux (m/s)
131 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PPRSFLX! solid precip flux (m/s)
132 REAL, DIMENSION(KLON), INTENT(INOUT) :: PCAPE ! CAPE (J/kg)
133 INTEGER, DIMENSION(KLON),INTENT(INOUT) :: KCLTOP ! cloud top level (number of model level)
134 INTEGER, DIMENSION(KLON),INTENT(INOUT) :: KCLBAS ! cloud base level(number of model level)
135  ! they are given a value of
136  ! 0 if no convection
137 !
138 !* 0.2 Declarations of local variables :
139 !
140 INTEGER :: JI, JK, JN ! loop index
141 !
142 REAL, DIMENSION(KLON) :: ZTIMEC, ZPRLTEN
143 !
144 ! special for shallow convection
145 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTTENS, ZRVTENS, ZRCTENS, ZRITENS, &
146  ZUMFS
147 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCH1TENS
148 INTEGER, DIMENSION(:), ALLOCATABLE :: ICLBASS, ICLTOPS
149 !
150 !* 0.3 Declarations of additional Ensemble fields:
151 !
152 INTEGER :: KENS ! number of allowed additional deep convection calls
153 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTTENE ! convective temperat. tendency (K/s)
154 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVTENE ! convective r_v tendency (1/s)
155 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRCTENE ! convective r_c tendency (1/s)
156 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRITENE ! convective r_i tendency (1/s)
157 REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRLTENE ! liquid surf precipitation tendency (m/s)
158 REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRSTENE ! solid surf precipitation tendency (m/s)
159 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUMFE ! updraft mass flux (kg/s m2)
160 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDMFE ! downdraft mass flux (kg/s m2)
161 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRLFLXE ! liquid precip flux (m/s)
162 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRSFLXE ! solid precip flux (m/s)
163 REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: ZCH1TENE ! chemical convective tendency
164 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICLTOPE ! cloud top level (number of model level)
165 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICLBASE ! cloud base level(number of model level)
166 REAL, DIMENSION(:), ALLOCATABLE :: ZEDUMMY ! field not to be recomputed by ensemble
167 INTEGER, DIMENSION(:), ALLOCATABLE :: IEDUMMY ! field not to be recomputed by ensemble
168 REAL, DIMENSION(:), ALLOCATABLE :: ZWEIGHT ! weighting factor for ensemble members
169 REAL :: ZSUM ! sum of weighting factors
170 !
171 !-------------------------------------------------------------------------------
172 !
173 !
174 !* 0.5 Allocate 2D (horizontal, vertical) arrays and additional ensemble arrays
175 ! ------------------------------------------------------------------------
176 !
177  ALLOCATE( zttens(klon,klev) ); ALLOCATE( zrvtens(klon,klev) )
178  ALLOCATE( zrctens(klon,klev) ); ALLOCATE( zritens(klon,klev) )
179  ALLOCATE( zch1tens(klon,klev,kch1) )
180  ALLOCATE( zumfs(klon,klev) )
181  ALLOCATE( iclbass(klon) ); ALLOCATE( icltops(klon) )
182 !
183  kcltop(:) = 1 ! set default value when no convection
184  kclbas(:) = 1 ! can be changed depending on user
185  icltops(:) = 1
186  iclbass(:) = 1
187 !
188 kens = min( kensm, 3 )
189 IF ( kens > 0 ) THEN
190  ALLOCATE( zttene(klon,klev,kens) )
191  ALLOCATE( zrvtene(klon,klev,kens) )
192  ALLOCATE( zrctene(klon,klev,kens) )
193  ALLOCATE( zritene(klon,klev,kens) )
194  ALLOCATE( zumfe(klon,klev,kens) )
195  ALLOCATE( zdmfe(klon,klev,kens) )
196  ALLOCATE( zch1tene(klon,klev,kch1,kens) )
197  ALLOCATE( zprlflxe(klon,klev,kens) )
198  ALLOCATE( zprsflxe(klon,klev,kens) )
199  ALLOCATE( zprltene(klon,kens) )
200  ALLOCATE( zprstene(klon,kens) )
201  ALLOCATE( icltope(klon,kens) )
202  ALLOCATE( iclbase(klon,kens) )
203  ALLOCATE( zedummy(klon) )
204  ALLOCATE( iedummy(klon) )
205  ALLOCATE( zweight(kens) )
206 END IF
207 !
208 !* 4.a Call deep convection routine
209 ! ----------------------------
210 !
211 IF ( odeep ) THEN
212 !
213 ! 1. Base version
214 !
215  CALL ini_convpar
216 !
217  IF ( osettadj ) ztimec(:) = ptadjd
218 
219 !
220  CALL convect_deep( klon, klev, kidia, kfdia, kbdia, ktdia, &
221  pdtconv, kice, orefresh_all, odown, osettadj, &
222  ppabs, pzz, pdxdy, ztimec, &
223  pt, prv, prc, pri, pu, pv, pw, &
224  kcount, ptten, prvten, prcten, priten, &
225  zprlten, pprsten, &
226  kcltop, kclbas, pprlflx, pprsflx, &
227  pumf, pdmf, pcape, &
228  ochtrans, kch1, pch1, pch1ten )
229 !
230 ! 2. Additional Ensemble members
231 !
232  IF ( kens > 0 ) THEN
233 !
234  CALL ini_convpar1
235 !
236 !* first member - changes in MODD_CONVPAR (cloud radius of 500 m or so)
237 ! specified in INI_CONVPAR1
238 !
239  CALL convect_deep( klon, klev, kidia, kfdia, kbdia, ktdia, &
240  pdtconv, kice, orefresh_all, odown, osettadj, &
241  ppabs, pzz, pdxdy, ztimec, &
242  pt, prv, prc, pri, pu, pv, pw, &
243  iedummy, zttene(:,:,1), zrvtene(:,:,1), zrctene(:,:,1), zritene(:,:,1),&
244  zprltene(:,1), zprstene(:,1), &
245  icltope(:,1), iclbase(:,1), zprlflxe(:,:,1), zprsflxe(:,:,1), &
246  zumfe(:,:,1), zdmfe(:,:,1), zedummy, &
247  ochtrans, kch1, pch1, zch1tene(:,:,:,1) )
248  END IF
249 !
250  IF ( kens > 1 ) THEN
251 !
252  CALL ini_convpar
253 !
254 !* second member (positive vertical velocity perturb for Trigger)
255 !
256  CALL convect_deep( klon, klev, kidia, kfdia, kbdia, ktdia, &
257  pdtconv, kice, orefresh_all, odown, osettadj, &
258  ppabs, pzz, pdxdy, ztimec, &
259  pt, prv, prc, pri, pu, pv, pw*1.5+1.e-4, &
260  iedummy, zttene(:,:,2), zrvtene(:,:,2), zrctene(:,:,2), zritene(:,:,2),&
261  zprltene(:,2), zprstene(:,2), &
262  icltope(:,2), iclbase(:,2), zprlflxe(:,:,2), zprsflxe(:,:,2), &
263  zumfe(:,:,2), zdmfe(:,:,2), zedummy, &
264  ochtrans, kch1, pch1, zch1tene(:,:,:,2) )
265  END IF
266 !
267  IF ( kens > 2 ) THEN
268 !
269 !* third member (negative vertical velocity perturb for Trigger)
270 !
271  CALL convect_deep( klon, klev, kidia, kfdia, kbdia, ktdia, &
272  pdtconv, kice, orefresh_all, odown, osettadj, &
273  ppabs, pzz, pdxdy, ztimec, &
274  pt, prv, prc, pri, pu, pv, pw*.5-1.e-4, &
275  iedummy, zttene(:,:,3), zrvtene(:,:,3), zrctene(:,:,3), zritene(:,:,3),&
276  zprltene(:,3), zprstene(:,3), &
277  icltope(:,3), iclbase(:,3), zprlflxe(:,:,3), zprsflxe(:,:,3), &
278  zumfe(:,:,3), zdmfe(:,:,3), zedummy, &
279  ochtrans, kch1, pch1, zch1tene(:,:,:,3) )
280  END IF
281 !
282 ENDIF
283 IF ( .NOT. odeep ) THEN
284  kcount(:) =0
285  ptten(:,:) =0.
286  prvten(:,:)=0.
287  prcten(:,:)=0.
288  priten(:,:)=0.
289  pumf(:,:) =0.
290  pdmf(:,:) =0.
291  ! KCLTOP(:) =1
292  ! KCLBAS(:) =1
293  pch1ten(:,:,:)=0.
294  zprlten(:) =0.
295  pprsten(:) =0.
296  pprlflx(:,:)=0.
297  pprsflx(:,:)=0.
298  pcape(:) =0.
299 END IF
300 !
301 !* 4.b Call shallow convection routine
302 ! -------------------------------
303 !
304 IF ( oshal ) THEN
305 !
306  IF ( .NOT. odeep ) CALL ini_convpar
307  CALL ini_convpar_shal
308 !
309  CALL convect_shallow( klon, klev, kidia, kfdia, kbdia, ktdia, &
310  pdtconv, kice, osettadj, ptadjs, &
311  ppabs, pzz, &
312  pt, prv, prc, pri, pw, &
313  zttens, zrvtens, zrctens, zritens, &
314  icltops, iclbass, zumfs, &
315  ochtrans, kch1, pch1, zch1tens )
316 ENDIF
317 IF ( .NOT. oshal ) THEN
318  zttens(:,:) =0.
319  zrvtens(:,:)=0.
320  zrctens(:,:)=0.
321  zritens(:,:)=0.
322  zumfs(:,:) =0
323  ! ICLTOPS(:) =1
324  ! ICLBASS(:) =1
325  zch1tens(:,:,:)=0.
326 END IF
327 !
328 !* 5. Add - if activated - ensemble average values for deep
329 ! and then shallow convective tendencies
330 ! ---------------------------------------------------------
331 !
332 zsum = 1.
333 IF ( kens > 0 ) THEN
334  IF ( kens == 1 ) zweight(:) = .5
335  IF ( kens > 1 ) zweight(:) = 1.
336  DO jn = 1, kens
337  ptten(:,:) = ptten(:,:) + zweight(jn) * zttene(:,:,jn)
338  prvten(:,:) = prvten(:,:) + zweight(jn) * zrvtene(:,:,jn)
339  prcten(:,:) = prcten(:,:) + zweight(jn) * zrctene(:,:,jn)
340  priten(:,:) = priten(:,:) + zweight(jn) * zritene(:,:,jn)
341  pprlflx(:,:)= pprlflx(:,:)+ zweight(jn) * zprlflxe(:,:,jn)
342  pprsflx(:,:)= pprsflx(:,:)+ zweight(jn) * zprsflxe(:,:,jn)
343  pumf(:,:) = pumf(:,:) + zweight(jn) * zumfe(:,:,jn)
344  pdmf(:,:) = pdmf(:,:) + zweight(jn) * zdmfe(:,:,jn)
345  zprlten(:) = zprlten(:) + zweight(jn) * zprltene(:,jn)
346  pprsten(:) = pprsten(:) + zweight(jn) * zprstene(:,jn)
347  kcltop(:) = max(kcltop(:), icltope(:,jn))
348  kclbas(:) = max(kclbas(:), iclbase(:,jn))
349  IF ( ochtrans ) &
350  & pch1ten(:,:,:) = pch1ten(:,:,:) + zweight(jn) * zch1tene(:,:,:,jn)
351  END DO
352 !
353  zsum = 1. / ( 1. + sum( zweight(:) ) )
354 END IF
355 !
356  ptten(:,:) = ptten(:,:) * zsum + zttens(:,:)
357  prvten(:,:) = prvten(:,:) * zsum + zrvtens(:,:)
358  prcten(:,:) = prcten(:,:) * zsum + zrctens(:,:)
359  priten(:,:) = priten(:,:) * zsum + zritens(:,:)
360  pprlflx(:,:)= pprlflx(:,:)* zsum
361  pprsflx(:,:)= pprsflx(:,:)* zsum
362  pumf(:,:) = pumf(:,:) * zsum + zumfs(:,:)
363  pdmf(:,:) = pdmf(:,:) * zsum
364  pprten(:) = ( zprlten(:) + pprsten(:) ) * zsum
365  pprsten(:) = pprsten(:) * zsum
366  kcltop(:) = max(kcltop(:), icltops(:))
367  kclbas(:) = max(kclbas(:), iclbass(:))
368  IF ( ochtrans ) THEN
369  pch1ten(:,:,:) = pch1ten(:,:,:) * zsum + zch1tens(:,:,:)
370  END IF
371 !
372 !* 6. Deallocate local arrays
373 !
374  DEALLOCATE( iclbass ); DEALLOCATE( icltops )
375  DEALLOCATE( zumfs )
376  DEALLOCATE( zch1tens )
377  DEALLOCATE( zrctens ); DEALLOCATE( zritens )
378  DEALLOCATE( zttens ); DEALLOCATE( zrvtens )
379 
380 IF ( kens > 0 ) THEN
381  DEALLOCATE( zttene ); DEALLOCATE( zrvtene )
382  DEALLOCATE( zrctene ); DEALLOCATE( zritene )
383  DEALLOCATE( zumfe ); DEALLOCATE( zdmfe )
384  DEALLOCATE( zch1tene )
385  DEALLOCATE( zprlflxe ); DEALLOCATE( zprsflxe )
386  DEALLOCATE( zprltene ); DEALLOCATE( zprstene )
387  DEALLOCATE( zedummy ); DEALLOCATE( iedummy )
388  DEALLOCATE( zweight )
389 END IF
390 !
391 !
392 END SUBROUTINE convection
393 ! ######spl
394  MODULE modd_convparext
395 ! ######################
396 !
397 IMPLICIT NONE
398 !
399 INTEGER, SAVE :: jcvexb ! start vertical computations at
400  ! 1 + JCVEXB = 1 + ( KBDIA - 1 )
401 INTEGER, SAVE :: jcvext ! limit vertical computations to
402  ! KLEV - JCVEXT = KLEV - ( KTDIA - 1 )
403 !
404 END MODULE modd_convparext
405 ! ######spl
406  MODULE modd_cst
407 ! ###############
408 !
409 IMPLICIT NONE
410 !
411 REAL, SAVE :: xp00 ! reference pressure
412 REAL, SAVE :: xpi ! Pi
413 REAL, SAVE :: xg ! gravity constant
414 REAL, SAVE :: xmd ! molecular weight of dry air
415 REAL, SAVE :: xmv ! molecular weight of water vapor
416 REAL, SAVE :: xrd ! gaz constant for dry air
417 REAL, SAVE :: xrv ! gaz constant for water vapor
418 REAL, SAVE :: xcpd ! specific heat of dry air
419 REAL, SAVE :: xcpv ! specific heat of water vapor
420 REAL, SAVE :: xrholw ! density of liquid water
421 REAL, SAVE :: xcl ! specific heat of liquid water
422 REAL, SAVE :: xci ! specific heat of ice
423 REAL, SAVE :: xtt ! triple point temperature
424 REAL, SAVE :: xlvtt ! latent heat of vaporisation at XTT
425 REAL, SAVE :: xlstt ! latent heat of sublimation at XTT
426 REAL, SAVE :: xlmtt ! latent heat of melting at XTT
427 REAL, SAVE :: xestt ! saturation pressure at XTT
428 REAL, SAVE :: xalpw ! constants in saturation pressure over liquid water
429 REAL, SAVE :: xbetaw
430 REAL, SAVE :: xgamw
431 REAL, SAVE :: xalpi ! constants in saturation pressure over ice
432 REAL, SAVE :: xbetai
433 REAL, SAVE :: xgami
434 !
435 END MODULE modd_cst
436 ! ######spl
437  MODULE modd_convpar
438 ! ###################
439 !
440 !!**** *MODD_CONVPAR* - Declaration of convection constants
441 !!
442 !! PURPOSE
443 !! -------
444 ! The purpose of this declarative module is to declare the
445 ! constants in the deep convection parameterization.
446 !
447 !!
448 !!** IMPLICIT ARGUMENTS
449 !! ------------------
450 !! None
451 !!
452 !! REFERENCE
453 !! ---------
454 !! Book2 of documentation of Meso-NH (MODD_CONVPAR)
455 !!
456 !! AUTHOR
457 !! ------
458 !! P. Bechtold *Laboratoire d'Aerologie*
459 !!
460 !! MODIFICATIONS
461 !! -------------
462 !! Original 26/03/96
463 !! Last modified 15/11/96
464 !-------------------------------------------------------------------------------
465 !
466 !* 0. DECLARATIONS
467 ! ------------
468 !
469 IMPLICIT NONE
470 !
471 REAL, SAVE :: xa25 ! 25 km x 25 km reference grid area
472 !
473 REAL, SAVE :: xcrad ! cloud radius
474 REAL, SAVE :: xcdepth ! minimum necessary cloud depth
475 REAL, SAVE :: xentr ! entrainment constant (m/Pa) = 0.2 (m)
476 !
477 REAL, SAVE :: xzlcl ! maximum allowed allowed height
478  ! difference between departure level and surface
479 REAL, SAVE :: xzpbl ! minimum mixed layer depth to sustain convection
480 REAL, SAVE :: xwtrig ! constant in vertical velocity trigger
481 REAL, SAVE :: xdthpbl ! temperature perturbation in PBL for trigger
482 REAL, SAVE :: xdrvpbl ! moisture perturbation in PBL for trigger
483 !
484 !
485 REAL, SAVE :: xnhgam ! accounts for non-hydrost. pressure
486  ! in buoyancy term of w equation
487  ! = 2 / (1+gamma)
488 REAL, SAVE :: xtfrz1 ! begin of freezing interval
489 REAL, SAVE :: xtfrz2 ! end of freezing interval
490 !
491 REAL, SAVE :: xrhdbc ! relative humidity below cloud in downdraft
492 !
493 REAL, SAVE :: xrconv ! constant in precipitation conversion
494 REAL, SAVE :: xstabt ! factor to assure stability in fractional time
495  ! integration, routine CONVECT_CLOSURE
496 REAL, SAVE :: xstabc ! factor to assure stability in CAPE adjustment,
497  ! routine CONVECT_CLOSURE
498 REAL, SAVE :: xusrdpth ! pressure thickness used to compute updraft
499  ! moisture supply rate for downdraft
500 REAL, SAVE :: xmeldpth ! layer (Pa) through which precipitation melt is
501  ! allowed below melting level
502 REAL, SAVE :: xuvdp ! constant for pressure perturb in momentum transport
503 !
504 END MODULE modd_convpar
505 ! ######spl
506  SUBROUTINE ini_convpar
507 ! ######################
508 !
509 !!**** *INI_CONVPAR * - routine to initialize the constants modules
510 !!
511 !! PURPOSE
512 !! -------
513 ! The purpose of this routine is to initialize the constants
514 ! stored in modules MODD_CONVPAR, MODD_CST, MODD_CONVPAREXT.
515 !
516 !
517 !!** METHOD
518 !! ------
519 !! The deep convection constants are set to their numerical values
520 !!
521 !!
522 !! EXTERNAL
523 !! --------
524 !!
525 !! IMPLICIT ARGUMENTS
526 !! ------------------
527 !! Module MODD_CONVPAR : contains deep convection constants
528 !! Module MODD_CST : contains physical constants
529 !!
530 !! REFERENCE
531 !! ---------
532 !! Book2 of the documentation (module MODD_CONVPAR, routine INI_CONVPAR)
533 !!
534 !!
535 !! AUTHOR
536 !! ------
537 !! P. BECHTOLD * Laboratoire d'Aerologie *
538 !!
539 !! MODIFICATIONS
540 !! -------------
541 !! Original 26/03/96
542 !! Last modified 15/04/98 adapted for ARPEGE
543 !-------------------------------------------------------------------------------
544 !
545 !* 0. DECLARATIONS
546 ! ------------
547 !
548 USE modd_convpar
549 USE modd_cst
550 !
551 IMPLICIT NONE
552 !
553 !-------------------------------------------------------------------------------
554 !
555 !* 1. Set the thermodynamical and numerical constants for
556 ! the deep convection parameterization
557 ! ---------------------------------------------------
558 !
559 !
560 xa25 = 625.e6 ! 25 km x 25 km reference grid area
561 !
562 xcrad = 1500. ! cloud radius
563 xcdepth = 3.e3 ! minimum necessary cloud depth
564 xentr = 0.03 ! entrainment constant (m/Pa) = 0.2 (m)
565 !
566 xzlcl = 3.5e3 ! maximum allowed allowed height
567  ! difference between the surface and the LCL
568 xzpbl = 60.e2 ! minimum mixed layer depth to sustain convection
569 xwtrig = 6.00 ! constant in vertical velocity trigger
570 xdthpbl = .3 ! Temp. perturbation in PBL for trigger
571 xdrvpbl = 1.e-4 ! moisture perturbation in PBL for trigger
572 !
573 !
574 xnhgam = 1.3333 ! accounts for non-hydrost. pressure
575  ! in buoyancy term of w equation
576  ! = 2 / (1+gamma)
577 xtfrz1 = 273.16 ! begin of freezing interval
578 xtfrz2 = 250.16 ! end of freezing interval
579 !
580 xrhdbc = 0.9 ! relative humidity below cloud in downdraft
581 
582 xrconv = 0.015 ! constant in precipitation conversion
583 xstabt = 0.75 ! factor to assure stability in fractional time
584  ! integration, routine CONVECT_CLOSURE
585 xstabc = 0.95 ! factor to assure stability in CAPE adjustment,
586  ! routine CONVECT_CLOSURE
587 xusrdpth = 165.e2 ! pressure thickness used to compute updraft
588  ! moisture supply rate for downdraft
589 xmeldpth = 200.e2 ! layer (Pa) through which precipitation melt is
590  ! allowed below downdraft
591 xuvdp = 0.7 ! constant for pressure perturb in momentum transport
592 !
593 !
594 !* 2. Set the fundamental thermodynamical constants
595 ! these have the same values (not names) as in ARPEGE IFS
596 ! -------------------------------------------------------
597 !
598 !
599 xp00 = 1.e5 ! reference pressure
600 xpi = 3.141592654 ! Pi
601  xg = 9.80665 ! gravity constant
602 xmd = 28.9644e-3 ! molecular weight of dry air
603 xmv = 18.0153e-3 ! molecular weight of water vapor
604 xrd = 287.05967 ! gaz constant for dry air
605 xrv = 461.524993 ! gaz constant for water vapor
606 xcpd = 1004.708845 ! specific heat of dry air
607 xcpv = 1846.1 ! specific heat of water vapor
608 xrholw = 1000. ! density of liquid water
609 xcl = 4218. ! specific heat of liquid water
610 xci = 2106. ! specific heat of ice
611 xtt = 273.16 ! triple point temperature
612 xlvtt = 2.5008e6 ! latent heat of vaporisation at XTT
613 xlstt = 2.8345e6 ! latent heat of sublimation at XTT
614 xlmtt = 0.3337e6 ! latent heat of melting at XTT
615 xestt = 611.14 ! saturation pressure at XTT
616 xalpw = 60.22416 ! constants in saturation pressure over liquid water
617 xbetaw = 6822.459384
618 xgamw = 5.13948
619 xalpi = 32.62116 ! constants in saturation pressure over ice
620 xbetai = 6295.421
621 xgami = 0.56313
622 !
623 !
624 END SUBROUTINE ini_convpar
625 ! ######spl
626  SUBROUTINE ini_convpar1
627 ! #######################
628 !
629 !!**** *INI_CONVPAR * - routine to initialize the convective constants modules
630 !! with modifications for ensemble run.
631 !!
632 !! PURPOSE
633 !! -------
634 ! The purpose of this routine is to initialize the constants
635 ! stored in modules MODD_CONVPAR, MODD_CST, MODD_CONVPAREXT.
636 !
637 !
638 !!** METHOD
639 !! ------
640 !! The deep convection constants are set to their numerical values
641 !!
642 !!
643 !! EXTERNAL
644 !! --------
645 !!
646 !! IMPLICIT ARGUMENTS
647 !! ------------------
648 !! Module MODD_CONVPAR : contains deep convection constants
649 !!
650 !! REFERENCE
651 !! ---------
652 !! Book2 of the documentation (module MODD_CONVPAR, routine INI_CONVPAR)
653 !!
654 !!
655 !! AUTHOR
656 !! ------
657 !! P. BECHTOLD * Laboratoire d'Aerologie *
658 !!
659 !! MODIFICATIONS
660 !! -------------
661 !! Original 26/03/96
662 !! Last modified 15/04/98 adapted for ARPEGE
663 !-------------------------------------------------------------------------------
664 !
665 !* 0. DECLARATIONS
666 ! ------------
667 !
668 USE modd_convpar
669 !
670 IMPLICIT NONE
671 !
672 !-------------------------------------------------------------------------------
673 !
674 !* 1. Set the thermodynamical and numerical constants for
675 ! the deep convection parameterization
676 ! ---------------------------------------------------
677 !
678 !
679 xa25 = 625.e6 ! 25 km x 25 km reference grid area
680 !
681 xcrad = 500. ! cloud radius
682 xcdepth = 3.e3 ! minimum necessary cloud depth
683 xentr = 0.03 ! entrainment constant (m/Pa) = 0.2 (m)
684 !
685 xzlcl = 3.5e3 ! maximum allowed allowed height
686  ! difference between the surface and the LCL
687 xzpbl = 60.e2 ! minimum mixed layer depth to sustain convection
688 xwtrig = 6.00 ! constant in vertical velocity trigger
689 xdthpbl = .3 ! Temp. perturbation in PBL for trigger
690 xdrvpbl = 1.e-4 ! moisture perturbation in PBL for trigger
691 !
692 !
693 xnhgam = 1.3333 ! accounts for non-hydrost. pressure
694  ! in buoyancy term of w equation
695  ! = 2 / (1+gamma)
696 xtfrz1 = 273.16 ! begin of freezing interval
697 xtfrz2 = 250.16 ! end of freezing interval
698 !
699 xrhdbc = 0.9 ! relative humidity below cloud in downdraft
700 
701 xrconv = 0.015 ! constant in precipitation conversion
702 xstabt = 0.75 ! factor to assure stability in fractional time
703  ! integration, routine CONVECT_CLOSURE
704 xstabc = 0.95 ! factor to assure stability in CAPE adjustment,
705  ! routine CONVECT_CLOSURE
706 xusrdpth = 165.e2 ! pressure thickness used to compute updraft
707  ! moisture supply rate for downdraft
708 xmeldpth = 200.e2 ! layer (Pa) through which precipitation melt is
709  ! allowed below downdraft
710 xuvdp = 0.7 ! constant for pressure perturb in momentum transport
711 !
712 !
713 END SUBROUTINE ini_convpar1
714 ! ######spl
715  SUBROUTINE convect_deep( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, &
716  pdtconv, kice, orefresh, odown, osettadj, &
717  ppabst, pzz, pdxdy, ptimec, &
718  ptt, prvt, prct, prit, put, pvt, pwt, &
719  kcount, ptten, prvten, prcten, priten, &
720  pprlten, pprsten, &
721  kcltop, kclbas, pprlflx, pprsflx, &
722  pumf, pdmf, pcape, &
723  och1conv, kch1, pch1, pch1ten )
724 ! ############################################################################
725 !
726 !!**** Monitor routine to compute all convective tendencies by calls
727 !! of several subroutines.
728 !!
729 !!
730 !! PURPOSE
731 !! -------
732 !! The purpose of this routine is to determine the convective
733 !! tendencies. The routine first prepares all necessary grid-scale
734 !! variables. The final convective tendencies are then computed by
735 !! calls of different subroutines.
736 !!
737 !!
738 !!** METHOD
739 !! ------
740 !! We start by selecting convective columns in the model domain through
741 !! the call of routine TRIGGER_FUNCT. Then, we allocate memory for the
742 !! convection updraft and downdraft variables and gather the grid scale
743 !! variables in convective arrays.
744 !! The updraft and downdraft computations are done level by level starting
745 !! at the bottom and top of the domain, respectively.
746 !! All computations are done on MNH thermodynamic levels. The depth
747 !! of the current model layer k is defined by DP(k)=P(k-1)-P(k)
748 !!
749 !!
750 !!
751 !! EXTERNAL
752 !! --------
753 !! CONVECT_TRIGGER_FUNCT
754 !! CONVECT_SATMIXRATIO
755 !! CONVECT_UPDRAFT
756 !! CONVECT_CONDENS
757 !! CONVECT_MIXING_FUNCT
758 !! CONVECT_TSTEP_PREF
759 !! CONVECT_DOWNDRAFT
760 !! CONVECT_PRECIP_ADJUST
761 !! CONVECT_CLOSURE
762 !! CONVECT_CLOSURE_THRVLCL
763 !! CONVECT_CLOSURE_ADJUST
764 !!
765 !! IMPLICIT ARGUMENTS
766 !! ------------------
767 !! Module MODD_CST
768 !! XG ! gravity constant
769 !! XPI ! number Pi
770 !! XP00 ! reference pressure
771 !! XRD, XRV ! gaz constants for dry air and water vapor
772 !! XCPD, XCPV ! specific heat for dry air and water vapor
773 !! XRHOLW ! density of liquid water
774 !! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
775 !! XTT ! triple point temperature
776 !! XLVTT, XLSTT ! vaporization, sublimation heat constant
777 !! XCL, XCI ! specific heat for liquid water and ice
778 !!
779 !! Module MODD_CONVPAREXT
780 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
781 !!
782 !! Module MODD_CONVPAR
783 !! XA25 ! reference grid area
784 !! XCRAD ! cloud radius
785 !!
786 !!
787 !! REFERENCE
788 !! ---------
789 !!
790 !! Bechtold et al., 2001, Quart. J. Roy. Meteor. Soc. :
791 !! A mass flux convection scheme for regional and global models.
792 !! Kain and Fritsch, 1990, J. Atmos. Sci., Vol. 47, 2784-2801.
793 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol. 24, 165-170.
794 !!
795 !! AUTHOR
796 !! ------
797 !! P. BECHTOLD * Laboratoire d'Aerologie *
798 !!
799 !! MODIFICATIONS
800 !! -------------
801 !! Original 26/03/96
802 !! Peter Bechtold 04/10/97 replace theta_il by enthalpy
803 !! " 10/12/98 changes for ARPEGE
804 !-------------------------------------------------------------------------------
805 !
806 !* 0. DECLARATIONS
807 ! ------------
808 !
809 USE modd_cst
810 USE modd_convparext
811 USE modd_convpar
812 !
813 !
814 IMPLICIT NONE
815 !
816 !* 0.1 Declarations of dummy arguments :
817 !
818 !
819 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
820 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
821 INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
822 INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
823 INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
824 ! ! KBDIA that is at least 1
825 INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
826  ! limited to KLEV + 1 - KTDIA
827  ! default=1
828 REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
829  ! calls of the deep convection
830  ! scheme
831 INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
832  ! 0 = no ice )
833 LOGICAL, INTENT(IN) :: OREFRESH ! refresh or not tendencies
834  ! at every call
835 LOGICAL, INTENT(IN) :: ODOWN ! take or not convective
836  ! downdrafts into account
837 LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
838  ! adjustment time by user
839 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT ! grid scale temperature at t
840 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT ! grid scale water vapor "
841 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT ! grid scale r_c "
842 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT ! grid scale r_i "
843 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUT ! grid scale horiz. wind u "
844 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PVT ! grid scale horiz. wind v "
845 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
846  ! velocity (m/s)
847 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
848 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
849 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (m-a2)
850 REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC ! value of convective adjustment
851  ! time if OSETTADJ=.TRUE.
852 !
853 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCOUNT ! convective counter (recompute
854  ! tendency or keep it)
855 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperature
856  ! tendency (K/s)
857 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
858 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
859 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
860 REAL, DIMENSION(KLON), INTENT(INOUT):: PPRLTEN! liquid surf. precipitation
861  ! tendency (m/s)
862 REAL, DIMENSION(KLON), INTENT(INOUT):: PPRSTEN! solid surf. precipitation
863  ! tendency (m/s)
864 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLTOP ! cloud top level
865 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLBAS ! cloud base level
866  ! they are given a value of
867  ! 0 if no convection
868 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRLFLX! liquid precip flux (m/s)
869 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRSFLX! solid precip flux (m/s)
870 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s m2)
871 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s m2)
872 REAL, DIMENSION(KLON), INTENT(INOUT):: PCAPE ! maximum CAPE (J/kg)
873 !
874 LOGICAL, INTENT(IN) :: OCH1CONV ! include tracer transport
875 INTEGER, INTENT(IN) :: KCH1 ! number of species
876 REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
877 REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
878 !
879 !
880 !* 0.2 Declarations of local fixed memory variables :
881 !
882 INTEGER :: ITEST, ICONV, ICONV1 ! number of convective columns
883 INTEGER :: IIB, IIE ! horizontal loop bounds
884 INTEGER :: IKB, IKE ! vertical loop bounds
885 INTEGER :: IKS ! vertical dimension
886 INTEGER :: JI, JL ! horizontal loop index
887 INTEGER :: JN ! number of tracers
888 INTEGER :: JK, JKP, JKM ! vertical loop index
889 INTEGER :: IFTSTEPS ! only used for chemical tracers
890 REAL :: ZEPS, ZEPSA, ZEPSB ! R_d / R_v, R_v / R_d, XCPV / XCPD - ZEPSA
891 REAL :: ZCPORD, ZRDOCP ! C_p/R_d, R_d/C_p
892 !
893 LOGICAL, DIMENSION(KLON, KLEV) :: GTRIG3 ! 3D logical mask for convection
894 LOGICAL, DIMENSION(KLON) :: GTRIG ! 2D logical mask for trigger test
895 REAL, DIMENSION(KLON,KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta,
896  ! theta_v, theta_es
897 REAL, DIMENSION(KLON) :: ZTIME ! convective time period
898 REAL, DIMENSION(KLON) :: ZWORK2, ZWORK2B ! work array
899 !
900 !
901 !* 0.2 Declarations of local allocatable variables :
902 !
903 INTEGER, DIMENSION(:),ALLOCATABLE :: IDPL ! index for parcel departure level
904 INTEGER, DIMENSION(:),ALLOCATABLE :: IPBL ! index for source layer top
905 INTEGER, DIMENSION(:),ALLOCATABLE :: ILCL ! index for lifting condensation level
906 INTEGER, DIMENSION(:),ALLOCATABLE :: IETL ! index for zero buoyancy level
907 INTEGER, DIMENSION(:),ALLOCATABLE :: ICTL ! index for cloud top level
908 INTEGER, DIMENSION(:),ALLOCATABLE :: ILFS ! index for level of free sink
909 INTEGER, DIMENSION(:),ALLOCATABLE :: IDBL ! index for downdraft base level
910 INTEGER, DIMENSION(:),ALLOCATABLE :: IML ! melting level
911 !
912 INTEGER, DIMENSION(:), ALLOCATABLE :: ISDPL ! index for parcel departure level
913 INTEGER, DIMENSION(:),ALLOCATABLE :: ISPBL ! index for source layer top
914 INTEGER, DIMENSION(:), ALLOCATABLE :: ISLCL ! index for lifting condensation level
915 REAL, DIMENSION(:), ALLOCATABLE :: ZSTHLCL ! updraft theta at LCL
916 REAL, DIMENSION(:), ALLOCATABLE :: ZSTLCL ! updraft temp. at LCL
917 REAL, DIMENSION(:), ALLOCATABLE :: ZSRVLCL ! updraft rv at LCL
918 REAL, DIMENSION(:), ALLOCATABLE :: ZSWLCL ! updraft w at LCL
919 REAL, DIMENSION(:), ALLOCATABLE :: ZSZLCL ! LCL height
920 REAL, DIMENSION(:), ALLOCATABLE :: ZSTHVELCL! envir. theta_v at LCL
921 REAL, DIMENSION(:), ALLOCATABLE :: ZSDXDY ! grid area (m^2)
922 !
923 ! grid scale variables
924 REAL, DIMENSION(:,:), ALLOCATABLE :: ZZ ! height of model layer (m)
925 REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES ! grid scale pressure
926 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! pressure difference between
927  ! bottom and top of layer (Pa)
928 REAL, DIMENSION(:,:), ALLOCATABLE :: ZU ! grid scale horiz. u component on theta grid
929 REAL, DIMENSION(:,:), ALLOCATABLE :: ZV ! grid scale horiz. v component on theta grid
930 REAL, DIMENSION(:,:), ALLOCATABLE :: ZW ! grid scale vertical velocity on theta grid
931 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTT ! temperature
932 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH ! grid scale theta
933 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHV ! grid scale theta_v
934 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHL ! grid scale enthalpy (J/kg)
935 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHES, ZTHEST ! grid scale saturated theta_e
936 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRW ! grid scale total water (kg/kg)
937 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRV ! grid scale water vapor (kg/kg)
938 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRC ! grid scale cloud water (kg/kg)
939 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRI ! grid scale cloud ice (kg/kg)
940 REAL, DIMENSION(:), ALLOCATABLE :: ZDXDY ! grid area (m^2)
941 !
942 ! updraft variables
943 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUMF ! updraft mass flux (kg/s)
944 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUER ! updraft entrainment (kg/s)
945 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUDR ! updraft detrainment (kg/s)
946 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUPR ! updraft precipitation in
947  ! flux units (kg water / s)
948 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHL ! updraft enthalpy (J/kg)
949 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHV ! updraft theta_v (K)
950 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURW ! updraft total water (kg/kg)
951 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURC ! updraft cloud water (kg/kg)
952 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURI ! updraft cloud ice (kg/kg)
953 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURR ! liquid precipit. (kg/kg)
954  ! produced in model layer
955 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURS ! solid precipit. (kg/kg)
956  ! produced in model layer
957 REAL, DIMENSION(:), ALLOCATABLE :: ZUTPR ! total updraft precipitation (kg/s)
958 REAL, DIMENSION(:), ALLOCATABLE :: ZMFLCL ! cloud base unit mass flux(kg/s)
959 REAL, DIMENSION(:), ALLOCATABLE :: ZCAPE ! available potent. energy
960 REAL, DIMENSION(:), ALLOCATABLE :: ZTHLCL ! updraft theta at LCL
961 REAL, DIMENSION(:), ALLOCATABLE :: ZTLCL ! updraft temp. at LCL
962 REAL, DIMENSION(:), ALLOCATABLE :: ZRVLCL ! updraft rv at LCL
963 REAL, DIMENSION(:), ALLOCATABLE :: ZWLCL ! updraft w at LCL
964 REAL, DIMENSION(:), ALLOCATABLE :: ZZLCL ! LCL height
965 REAL, DIMENSION(:), ALLOCATABLE :: ZTHVELCL! envir. theta_v at LCL
966 !
967 ! downdraft variables
968 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDMF ! downdraft mass flux (kg/s)
969 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDER ! downdraft entrainment (kg/s)
970 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDDR ! downdraft detrainment (kg/s)
971 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTHL ! downdraft enthalpy (J/kg)
972 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDRW ! downdraft total water (kg/kg)
973 REAL, DIMENSION(:), ALLOCATABLE :: ZMIXF ! mixed fraction at LFS
974 REAL, DIMENSION(:), ALLOCATABLE :: ZTPR ! total surf precipitation (kg/s)
975 REAL, DIMENSION(:), ALLOCATABLE :: ZSPR ! solid surf precipitation (kg/s)
976 REAL, DIMENSION(:), ALLOCATABLE :: ZDTEVR ! donwndraft evapor. (kg/s)
977 REAL, DIMENSION(:), ALLOCATABLE :: ZPREF ! precipitation efficiency
978 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTEVRF ! donwndraft evapor. (kg/s)
979 REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRLFLX ! liquid precip flux
980 REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRSFLX ! solid precip flux
981 !
982 ! closure variables
983 REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMASS ! mass of model layer (kg)
984 REAL, DIMENSION(:), ALLOCATABLE :: ZTIMEA ! advective time period
985 REAL, DIMENSION(:), ALLOCATABLE :: ZTIMEC, ZTIMED! time during which convection is
986  ! active at grid point (as ZTIME)
987 !
988 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHC ! conv. adj. grid scale theta
989 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRVC ! conv. adj. grid scale r_w
990 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c
991 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i
992 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s)
993 !
994 LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection
995 LOGICAL, DIMENSION(:),ALLOCATABLE :: GWORK ! logical work array
996 INTEGER, DIMENSION(:),ALLOCATABLE :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX!hor.index
997 REAL, DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph
998 REAL, DIMENSION(:), ALLOCATABLE :: ZLV, ZLS! latent heat of vaporis., sublim.
999 REAL :: ZES ! saturation vapor mixng ratio
1000 !
1001 ! Chemical Tracers:
1002 REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg)
1003 REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1
1004 REAL, DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! work arrays
1005 LOGICAL, DIMENSION(:,:,:),ALLOCATABLE::GTRIG4 ! logical mask
1006 !
1007 !-------------------------------------------------------------------------------
1008 !
1009 !
1010 !* 0.3 Compute loop bounds
1011 ! -------------------
1012 !
1013 iib = kidia
1014 iie = kfdia
1015 jcvexb = max( 0, kbdia - 1 )
1016 ikb = 1 + jcvexb
1017 iks = klev
1018 jcvext = max( 0, ktdia - 1 )
1019 ike = iks - jcvext
1020 !
1021 !
1022 !* 0.5 Update convective counter ( where KCOUNT > 0
1023 ! convection is still active ).
1024 ! ---------------------------------------------
1025 !
1026 kcount(iib:iie) = kcount(iib:iie) - 1
1027 !
1028 IF ( orefresh ) THEN
1029 kcount(:) = 1
1030 kcount(iib:iie) = 0 ! refresh or not at every call
1031 END IF
1032 !
1033 gtrig(:) = kcount(:) <= 0
1034 itest = count( gtrig(:) )
1035 IF ( itest == 0 ) RETURN ! if convection is already active at every grid point
1036  ! exit CONVECT_DEEP
1037 !
1038 !
1039 !* 0.7 Reset convective tendencies to zero if convective
1040 ! counter becomes negative
1041 ! -------------------------------------------------
1042 !
1043 gtrig3(:,:) = spread( gtrig(:), dim=2, ncopies=iks )
1044 WHERE ( gtrig3(:,:) )
1045  ptten(:,:) = 0.
1046  prvten(:,:) = 0.
1047  prcten(:,:) = 0.
1048  priten(:,:) = 0.
1049  pprlflx(:,:)= 0.
1050  pprsflx(:,:)= 0.
1051 ! PUTEN(:,:) = 0.
1052 ! PVTEN(:,:) = 0.
1053  pumf(:,:) = 0.
1054  pdmf(:,:) = 0.
1055 END WHERE
1056 WHERE ( gtrig(:) )
1057  pprlten(:) = 0.
1058  pprsten(:) = 0.
1059 ! KCLTOP(:) = 0 ! already initialized in CONVECTION
1060 ! KCLBAS(:) = 0
1061  pcape(:) = 0.
1062 END WHERE
1063 IF ( och1conv ) THEN
1064  ALLOCATE( gtrig4(klon,klev,kch1) )
1065  gtrig4(:,:,:) = spread( gtrig3(:,:), dim=3, ncopies=kch1 )
1066  WHERE( gtrig4(:,:,:) ) pch1ten(:,:,:) = 0.
1067  DEALLOCATE( gtrig4 )
1068 END IF
1069 !
1070 !
1071 !* 1. Initialize local variables
1072 ! ----------------------------
1073 !
1074 zeps = xrd / xrv
1075 zepsa = xrv / xrd
1076 zepsb = xcpv / xcpd - zepsa
1077 zcpord = xcpd / xrd
1078 zrdocp = xrd / xcpd
1079 !
1080 !
1081 !* 1.1 Set up grid scale theta, theta_v, theta_es
1082 ! ------------------------------------------
1083 !
1084 ztht(:,:) = 300.
1085 zsthv(:,:)= 300.
1086 zsthes(:,:) = 400.
1087 DO jk = ikb, ike
1088 DO ji = iib, iie
1089  IF ( ppabst(ji,jk) > 40.e2 ) THEN
1090  ztht(ji,jk) = ptt(ji,jk) * ( xp00 / ppabst(ji,jk) ) ** zrdocp
1091  zsthv(ji,jk) = ztht(ji,jk) * ( 1. + zepsa * prvt(ji,jk) ) / &
1092  ( 1. + prvt(ji,jk) + prct(ji,jk) + prit(ji,jk) )
1093 !
1094  ! use conservative Bolton (1980) formula for theta_e
1095  ! it is used to compute CAPE for undilute parcel ascent
1096  ! For economical reasons we do not use routine CONVECT_SATMIXRATIO here
1097 !
1098  zes = exp( xalpw - xbetaw / ptt(ji,jk) - xgamw * log( ptt(ji,jk) ) )
1099  zes = min( 1., zeps * zes / ( ppabst(ji,jk) - zes ) )
1100  zsthes(ji,jk) = ptt(ji,jk) * ( ztht(ji,jk) / ptt(ji,jk) ) ** &
1101  ( 1. - 0.28 * zes ) * exp( min(500., &
1102  ( 3374.6525 / ptt(ji,jk) - 2.5403 ) &
1103  * zes * ( 1. + 0.81 * zes ) ) )
1104  END IF
1105 END DO
1106 END DO
1107 !
1108 !
1109 !
1110 !* 2. Test for convective columns and determine properties at the LCL
1111 ! --------------------------------------------------------------
1112 !
1113 !* 2.1 Allocate arrays depending on number of model columns that need
1114 ! to be tested for convection (i.e. where no convection is present
1115 ! at the moment.
1116 ! --------------------------------------------------------------
1117 !
1118  ALLOCATE( zpres(itest,iks) )
1119  ALLOCATE( zz(itest,iks) )
1120  ALLOCATE( zw(itest,iks) )
1121  ALLOCATE( zth(itest,iks) )
1122  ALLOCATE( zthv(itest,iks) )
1123  ALLOCATE( zthest(itest,iks) )
1124  ALLOCATE( zrv(itest,iks) )
1125  ALLOCATE( zsthlcl(itest) )
1126  ALLOCATE( zstlcl(itest) )
1127  ALLOCATE( zsrvlcl(itest) )
1128  ALLOCATE( zswlcl(itest) )
1129  ALLOCATE( zszlcl(itest) )
1130  ALLOCATE( zsthvelcl(itest) )
1131  ALLOCATE( isdpl(itest) )
1132  ALLOCATE( ispbl(itest) )
1133  ALLOCATE( islcl(itest) )
1134  ALLOCATE( zsdxdy(itest) )
1135  ALLOCATE( gtrig1(itest) )
1136  ALLOCATE( zcape(itest) )
1137  ALLOCATE( iindex(klon) )
1138  ALLOCATE( ijsindex(itest) )
1139  DO ji = 1, klon
1140  iindex(ji) = ji
1141  END DO
1142  ijsindex(:) = pack( iindex(:), mask=gtrig(:) )
1143 !
1144  DO jk = ikb, ike
1145  DO ji = 1, itest
1146  jl = ijsindex(ji)
1147  zpres(ji,jk) = ppabst(jl,jk)
1148  zz(ji,jk) = pzz(jl,jk)
1149  zth(ji,jk) = ztht(jl,jk)
1150  zthv(ji,jk) = zsthv(jl,jk)
1151  zthest(ji,jk) = zsthes(jl,jk)
1152  zrv(ji,jk) = max( 0., prvt(jl,jk) )
1153  zw(ji,jk) = pwt(jl,jk)
1154  END DO
1155  END DO
1156  DO ji = 1, itest
1157  jl = ijsindex(ji)
1158  zsdxdy(ji) = pdxdy(jl)
1159  END DO
1160 !
1161 !* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c
1162 ! and envir. saturation theta_e
1163 ! ------------------------------------------------------------
1164 !
1165 !
1166 !* 2.3 Test for convective columns and determine properties at the LCL
1167 ! --------------------------------------------------------------
1168 !
1169  islcl(:) = max( ikb, 2 ) ! initialize DPL PBL and LCL
1170  isdpl(:) = ikb
1171  ispbl(:) = ikb
1172 !
1173 !
1174  CALL convect_trigger_funct( itest, klev, &
1175  zpres, zth, zthv, zthest, &
1176  zrv, zw, zz, zsdxdy, &
1177  zsthlcl, zstlcl, zsrvlcl, zswlcl, zszlcl, &
1178  zsthvelcl, islcl, isdpl, ispbl, gtrig1, &
1179  zcape )
1180 !
1181  DO ji = 1, itest
1182  jl = ijsindex(ji)
1183  pcape(jl) = zcape(ji)
1184  END DO
1185 !
1186  DEALLOCATE( zpres )
1187  DEALLOCATE( zz )
1188  DEALLOCATE( zth )
1189  DEALLOCATE( zthv )
1190  DEALLOCATE( zthest )
1191  DEALLOCATE( zrv )
1192  DEALLOCATE( zw )
1193  DEALLOCATE( zcape )
1194 !
1195 !
1196 !* 3. After the call of TRIGGER_FUNCT we allocate all the dynamic
1197 ! arrays used in the convection scheme using the mask GTRIG, i.e.
1198 ! we do calculus only in convective columns. This corresponds to
1199 ! a GATHER operation.
1200 ! --------------------------------------------------------------
1201 !
1202  iconv = count( gtrig1(:) )
1203  IF ( iconv == 0 ) THEN
1204  DEALLOCATE( zsthlcl )
1205  DEALLOCATE( zstlcl )
1206  DEALLOCATE( zsrvlcl )
1207  DEALLOCATE( zswlcl )
1208  DEALLOCATE( zszlcl )
1209  DEALLOCATE( zsthvelcl )
1210  DEALLOCATE( zsdxdy )
1211  DEALLOCATE( islcl )
1212  DEALLOCATE( isdpl )
1213  DEALLOCATE( ispbl )
1214  DEALLOCATE( gtrig1 )
1215  DEALLOCATE( iindex )
1216  DEALLOCATE( ijsindex )
1217  RETURN ! no convective column has been found, exit CONVECT_DEEP
1218  ENDIF
1219 !
1220  ! vertical index variables
1221 !
1222  ALLOCATE( idpl(iconv) )
1223  ALLOCATE( ipbl(iconv) )
1224  ALLOCATE( ilcl(iconv) )
1225  ALLOCATE( ictl(iconv) )
1226  ALLOCATE( ietl(iconv) )
1227 !
1228  ! grid scale variables
1229 !
1230  ALLOCATE( zz(iconv,iks) )
1231  ALLOCATE( zpres(iconv,iks) )
1232  ALLOCATE( zdpres(iconv,iks) )
1233  ALLOCATE( zu(iconv,iks) )
1234  ALLOCATE( zv(iconv,iks) )
1235  ALLOCATE( ztt(iconv, iks) )
1236  ALLOCATE( zth(iconv,iks) )
1237  ALLOCATE( zthv(iconv,iks) )
1238  ALLOCATE( zthl(iconv,iks) )
1239  ALLOCATE( zthes(iconv,iks) )
1240  ALLOCATE( zrv(iconv,iks) )
1241  ALLOCATE( zrc(iconv,iks) )
1242  ALLOCATE( zri(iconv,iks) )
1243  ALLOCATE( zrw(iconv,iks) )
1244  ALLOCATE( zdxdy(iconv) )
1245 !
1246  ! updraft variables
1247 !
1248  ALLOCATE( zumf(iconv,iks) )
1249  ALLOCATE( zuer(iconv,iks) )
1250  ALLOCATE( zudr(iconv,iks) )
1251  ALLOCATE( zupr(iconv,iks) )
1252  ALLOCATE( zuthl(iconv,iks) )
1253  ALLOCATE( zuthv(iconv,iks) )
1254  ALLOCATE( zurw(iconv,iks) )
1255  ALLOCATE( zurc(iconv,iks) )
1256  ALLOCATE( zuri(iconv,iks) )
1257  ALLOCATE( zurr(iconv,iks) )
1258  ALLOCATE( zurs(iconv,iks) )
1259  ALLOCATE( zutpr(iconv) )
1260  ALLOCATE( zthlcl(iconv) )
1261  ALLOCATE( ztlcl(iconv) )
1262  ALLOCATE( zrvlcl(iconv) )
1263  ALLOCATE( zwlcl(iconv) )
1264  ALLOCATE( zmflcl(iconv) )
1265  ALLOCATE( zzlcl(iconv) )
1266  ALLOCATE( zthvelcl(iconv) )
1267  ALLOCATE( zcape(iconv) )
1268 !
1269  ! work variables
1270 !
1271  ALLOCATE( ijindex(iconv) )
1272  ALLOCATE( ijpindex(iconv) )
1273  ALLOCATE( zcph(iconv) )
1274  ALLOCATE( zlv(iconv) )
1275  ALLOCATE( zls(iconv) )
1276 !
1277 !
1278 !* 3.1 Gather grid scale and updraft base variables in
1279 ! arrays using mask GTRIG
1280 ! ---------------------------------------------------
1281 !
1282  gtrig(:) = unpack( gtrig1(:), mask=gtrig(:), field=.false. )
1283  ijindex(:) = pack( iindex(:), mask=gtrig(:) )
1284 !
1285  DO jk = ikb, ike
1286  DO ji = 1, iconv
1287  jl = ijindex(ji)
1288  zz(ji,jk) = pzz(jl,jk)
1289  zpres(ji,jk) = ppabst(jl,jk)
1290  ztt(ji,jk) = ptt(jl,jk)
1291  zth(ji,jk) = ztht(jl,jk)
1292  zthes(ji,jk) = zsthes(jl,jk)
1293  zrv(ji,jk) = max( 0., prvt(jl,jk) )
1294  zrc(ji,jk) = max( 0., prct(jl,jk) )
1295  zri(ji,jk) = max( 0., prit(jl,jk) )
1296  zthv(ji,jk) = zsthv(jl,jk)
1297  zu(ji,jk) = put(jl,jk)
1298  zv(ji,jk) = pvt(jl,jk)
1299  END DO
1300  END DO
1301  IF ( osettadj ) THEN
1302  ALLOCATE( ztimed(iconv) )
1303  DO ji = 1, iconv
1304  jl = ijindex(ji)
1305  ztimed(ji) = ptimec(jl)
1306  END DO
1307  END IF
1308 !
1309  DO ji = 1, itest
1310  ijsindex(ji) = ji
1311  END DO
1312  ijpindex(:) = pack( ijsindex(:), mask=gtrig1(:) )
1313  DO ji = 1, iconv
1314  jl = ijpindex(ji)
1315  idpl(ji) = isdpl(jl)
1316  ipbl(ji) = ispbl(jl)
1317  ilcl(ji) = islcl(jl)
1318  zthlcl(ji) = zsthlcl(jl)
1319  ztlcl(ji) = zstlcl(jl)
1320  zrvlcl(ji) = zsrvlcl(jl)
1321  zwlcl(ji) = zswlcl(jl)
1322  zzlcl(ji) = zszlcl(jl)
1323  zthvelcl(ji) = zsthvelcl(jl)
1324  zdxdy(ji) = zsdxdy(jl)
1325  END DO
1326  ALLOCATE( gwork(iconv) )
1327  gwork(:) = pack( gtrig1(:), mask=gtrig1(:) )
1328  DEALLOCATE( gtrig1 )
1329  ALLOCATE( gtrig1(iconv) )
1330  gtrig1(:) = gwork(:)
1331 !
1332  DEALLOCATE( gwork )
1333  DEALLOCATE( ijpindex )
1334  DEALLOCATE( isdpl )
1335  DEALLOCATE( ispbl )
1336  DEALLOCATE( islcl )
1337  DEALLOCATE( zsthlcl )
1338  DEALLOCATE( zstlcl )
1339  DEALLOCATE( zsrvlcl )
1340  DEALLOCATE( zswlcl )
1341  DEALLOCATE( zszlcl )
1342  DEALLOCATE( zsthvelcl )
1343  DEALLOCATE( zsdxdy )
1344 !
1345 !
1346 !* 3.2 Compute pressure difference
1347 ! ---------------------------------------------------
1348 !
1349  zdpres(:,ikb) = 0.
1350  DO jk = ikb + 1, ike
1351  zdpres(:,jk) = zpres(:,jk-1) - zpres(:,jk)
1352  END DO
1353 !
1354 !* 3.3 Compute environm. enthalpy and total water = r_v + r_i + r_c
1355 ! ----------------------------------------------------------
1356 !
1357  DO jk = ikb, ike, 1
1358  zrw(:,jk) = zrv(:,jk) + zrc(:,jk) + zri(:,jk)
1359  zcph(:) = xcpd + xcpv * zrw(:,jk)
1360  zlv(:) = xlvtt + ( xcpv - xcl ) * ( ztt(:,jk) - xtt ) ! compute L_v
1361  zls(:) = xlstt + ( xcpv - xci ) * ( ztt(:,jk) - xtt ) ! compute L_i
1362  zthl(:,jk) = zcph(:) * ztt(:,jk) + ( 1. + zrw(:,jk) ) * xg * zz(:,jk) &
1363  - zlv(:) * zrc(:,jk) - zls(:) * zri(:,jk)
1364  END DO
1365 !
1366 !
1367 !* 4. Compute updraft properties
1368 ! ----------------------------
1369 !
1370 !* 4.1 Set mass flux at LCL ( here a unit mass flux with w = 1 m/s )
1371 ! -------------------------------------------------------------
1372 !
1373  DO ji = 1, iconv
1374  jk = ilcl(ji) - 1
1375  zmflcl(ji) = zpres(ji,jk) / ( xrd * ztt(ji,jk) * &
1376  ( 1. + zeps * zrvlcl(ji) ) ) * xpi * xcrad * xcrad
1377  END DO
1378 !
1379  DEALLOCATE( zcph )
1380  DEALLOCATE( zlv )
1381  DEALLOCATE( zls )
1382 !
1383 !
1384  CALL convect_updraft( iconv, klev, &
1385  kice, zpres, zdpres, zz, zthl, zthv, zthes, zrw, &
1386  zthlcl, ztlcl, zrvlcl, zwlcl, zzlcl, zthvelcl, &
1387  zmflcl, gtrig1, ilcl, idpl, ipbl, &
1388  zumf, zuer, zudr, zuthl, zuthv, zurw, &
1389  zurc, zuri, zurr, zurs, zupr, &
1390  zutpr, zcape, ictl, ietl )
1391 !
1392 !
1393 !
1394 !* 4.2 In routine UPDRAFT GTRIG1 has been set to false when cloud
1395 ! thickness is smaller than 3 km
1396 ! -----------------------------------------------------------
1397 !
1398 !
1399  iconv1 = count(gtrig1)
1400 !
1401  IF ( iconv1 > 0 ) THEN
1402 !
1403 !* 4.3 Allocate memory for downdraft variables
1404 ! ---------------------------------------
1405 !
1406 ! downdraft variables
1407 !
1408  ALLOCATE( ilfs(iconv) )
1409  ALLOCATE( idbl(iconv) )
1410  ALLOCATE( iml(iconv) )
1411  ALLOCATE( zdmf(iconv,iks) )
1412  ALLOCATE( zder(iconv,iks) )
1413  ALLOCATE( zddr(iconv,iks) )
1414  ALLOCATE( zdthl(iconv,iks) )
1415  ALLOCATE( zdrw(iconv,iks) )
1416  ALLOCATE( zlmass(iconv,iks) )
1417  DO jk = ikb, ike
1418  zlmass(:,jk) = zdxdy(:) * zdpres(:,jk) / xg ! mass of model layer
1419  END DO
1420  zlmass(:,ikb) = zlmass(:,ikb+1)
1421  ALLOCATE( zmixf(iconv) )
1422  ALLOCATE( ztpr(iconv) )
1423  ALLOCATE( zspr(iconv) )
1424  ALLOCATE( zdtevr(iconv) )
1425  ALLOCATE( zpref(iconv) )
1426  ALLOCATE( zdtevrf(iconv,iks) )
1427  ALLOCATE( zprlflx(iconv,iks) )
1428  ALLOCATE( zprsflx(iconv,iks) )
1429 !
1430 ! closure variables
1431 !
1432  ALLOCATE( ztimea(iconv) )
1433  ALLOCATE( ztimec(iconv) )
1434  ALLOCATE( zthc(iconv,iks) )
1435  ALLOCATE( zrvc(iconv,iks) )
1436  ALLOCATE( zrcc(iconv,iks) )
1437  ALLOCATE( zric(iconv,iks) )
1438  ALLOCATE( zwsub(iconv,iks) )
1439 !
1440 !
1441 !* 5. Compute downdraft properties
1442 ! ----------------------------
1443 !
1444 !* 5.1 Compute advective time period and precipitation
1445 ! efficiency as a function of mean ambient wind (shear)
1446 ! --------------------------------------------------------
1447 !
1448  CALL convect_tstep_pref( iconv, klev, &
1449  zu, zv, zpres, zz, zdxdy, ilcl, ictl, &
1450  ztimea, zpref )
1451 !
1452  ! exclude convective downdrafts if desired
1453  IF ( .NOT. odown ) zpref(:) = 1.
1454 !
1455  ! Compute the period during which convection is active
1456  ztimec(:) = max( 1800., min( 3600., ztimea(:) ) )
1457  ztimec(:) = REAL( INT( ZTIMEC(:) / PDTCONV ) ) * PDTCONV
1458  ztimec(:) = max( pdtconv, ztimec(:) ) ! necessary if PDTCONV > 1800
1459  IF ( osettadj ) THEN
1460  ztimec(:) = max( pdtconv, ztimed(:) )
1461  END IF
1462 !
1463 !
1464 !* 5.2 Compute melting level
1465 ! ----------------------
1466 !
1467  iml(:) = ikb
1468  DO jk = ike, ikb, -1
1469  WHERE( ztt(:,jk) <= xtt ) iml(:) = jk
1470  END DO
1471 !
1472  CALL convect_downdraft( iconv, klev, &
1473  kice, zpres, zdpres, zz, zth, zthes, &
1474  zrw, zrc, zri, &
1475  zpref, ilcl, ictl, ietl, &
1476  zuthl, zurw, zurc, zuri, &
1477  zdmf, zder, zddr, zdthl, zdrw, &
1478  zmixf, zdtevr, ilfs, idbl, iml, &
1479  zdtevrf )
1480 !
1481 !
1482 !* 6. Adjust up and downdraft mass flux to be consistent
1483 ! with precipitation efficiency relation.
1484 ! ---------------------------------------------------
1485 !
1486  CALL convect_precip_adjust( iconv, klev, &
1487  zpres,zumf, zuer, zudr, zupr, zutpr, zurw,&
1488  zdmf, zder, zddr, zdthl, zdrw, &
1489  zpref, ztpr, zmixf, zdtevr, &
1490  ilfs, idbl, ilcl, ictl, ietl, &
1491  zdtevrf )
1492 !
1493 !
1494 !* 7. Determine adjusted environmental values assuming
1495 ! that all available buoyant energy must be removed
1496 ! within an advective time step ZTIMEC.
1497 ! ---------------------------------------------------
1498 !
1499  CALL convect_closure( iconv, klev, &
1500  zpres, zdpres, zz, zdxdy, zlmass, &
1501  zthl, zth, zrw, zrc, zri, gtrig1, &
1502  zthc, zrvc, zrcc, zric, zwsub, &
1503  ilcl, idpl, ipbl, ilfs, ictl, iml, &
1504  zumf, zuer, zudr, zuthl, zurw, &
1505  zurc, zuri, zupr, &
1506  zdmf, zder, zddr, zdthl, zdrw, &
1507  ztpr, zspr, zdtevr, &
1508  zcape, ztimec, &
1509  iftsteps, &
1510  zdtevrf, zprlflx, zprsflx )
1511 !
1512 
1513 
1514 !
1515 !* 8. Determine the final grid-scale (environmental) convective
1516 ! tendencies and set convective counter
1517 ! --------------------------------------------------------
1518 !
1519 !
1520 !* 8.1 Grid scale tendencies
1521 ! ---------------------
1522 !
1523  ! in order to save memory, the tendencies are temporarily stored
1524  ! in the tables for the adjusted grid-scale values
1525 !
1526  DO jk = ikb, ike
1527  zthc(:,jk) = ( zthc(:,jk) - zth(:,jk) ) / ztimec(:) &
1528  * ( zpres(:,jk) / xp00 ) ** zrdocp ! change theta in temperature
1529  zrvc(:,jk) = ( zrvc(:,jk) - zrw(:,jk) + zrc(:,jk) + zri(:,jk) ) &
1530  / ztimec(:)
1531 
1532  zrcc(:,jk) = ( zrcc(:,jk) - zrc(:,jk) ) / ztimec(:)
1533  zric(:,jk) = ( zric(:,jk) - zri(:,jk) ) / ztimec(:)
1534 !
1535  zprlflx(:,jk) = zprlflx(:,jk) / ( xrholw * zdxdy(:) )
1536  zprsflx(:,jk) = zprsflx(:,jk) / ( xrholw * zdxdy(:) )
1537 !
1538  END DO
1539 !
1540  zprlflx(:,ikb) = zprlflx(:,ikb+1)
1541  zprsflx(:,ikb) = zprsflx(:,ikb+1)
1542 !
1543 !
1544 !* 8.2 Apply conservation correction
1545 ! -----------------------------
1546 !
1547  ! Compute vertical integrals
1548 !
1549  jkm = maxval( ictl(:) )
1550  zwork2(:) = 0.
1551  zwork2b(:) = 0.
1552  DO jk = jkm, ikb+1, -1
1553  jkp = jk + 1
1554  DO ji = 1, iconv
1555  zwork2(ji) = zwork2(ji) + ( zrvc(ji,jk) + zrcc(ji,jk) + zric(ji,jk) ) * & ! moisture
1556  (zpres(ji,jk) - zpres(ji,jkp)) / xg
1557  ! ZWORK2B(JI) = ZWORK2B(JI) + ( & ! energy
1558  ! ( XCPD + XCPV * ZRW(JI,JK) )* ZTHC(JI,JK) - &
1559  ! ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRCC(JI,JK) - &
1560  ! ( XLSTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRIC(JI,JK) ) * &
1561  ! (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
1562  END DO
1563  END DO
1564 !
1565  ! Budget error (compare integral to surface precip.)
1566 !
1567  DO ji = 1, iconv
1568  IF ( ztpr(ji) > 0.) THEN
1569  jkp = ictl(ji) + 1
1570  zwork2(ji) = ( ztpr(ji) / zdxdy(ji) + zwork2(ji) ) * xg / &
1571  ( zpres(ji,ikb+1) - zpres(ji,jkp) )
1572  ! ZWORK2B(JI) = ( ZTPR(JI) / ZDXDY(JI) * &
1573  ! ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,IKB) - XTT ) ) - ZWORK2B(JI) ) &
1574  ! * XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
1575  END IF
1576  END DO
1577 !
1578  ! Apply uniform correction
1579 !
1580  DO jk = jkm, ikb+1, -1
1581  DO ji = 1, iconv
1582  IF ( ztpr(ji) > 0. .AND. jk <= ictl(ji) ) THEN
1583  zrvc(ji,jk) = zrvc(ji,jk) - zwork2(ji) ! moisture
1584  ! ZTHC(JI,JK) = ZTHC(JI,JK) + ZWORK2B(JI) / ( XCPD + XCPV * ZRW(JI,JK) )! energy
1585  END IF
1586  END DO
1587  END DO
1588 !
1589 !
1590 
1591  ! execute a "scatter"= pack command to store the tendencies in
1592  ! the final 2D tables
1593 !
1594  DO jk = ikb, ike
1595  DO ji = 1, iconv
1596  jl = ijindex(ji)
1597  ptten(jl,jk) = zthc(ji,jk)
1598  prvten(jl,jk) = zrvc(ji,jk)
1599  prcten(jl,jk) = zrcc(ji,jk)
1600  priten(jl,jk) = zric(ji,jk)
1601 !
1602  pprlflx(jl,jk) = zprlflx(ji,jk)
1603  pprsflx(jl,jk) = zprsflx(ji,jk)
1604  END DO
1605  END DO
1606 !
1607 !
1608 !
1609 !
1610 !* 8.3 Convective rainfall tendency
1611 ! ----------------------------
1612 !
1613  ! liquid and solid surface rainfall tendency in m/s
1614  ztpr(:) = ztpr(:) / ( xrholw * zdxdy(:) ) ! total surf precip
1615  zspr(:) = zspr(:) / ( xrholw * zdxdy(:) ) ! solid surf precip
1616  ztpr(:) = ztpr(:) - zspr(:) ! compute liquid part
1617 !
1618  DO ji = 1, iconv
1619  jl = ijindex(ji)
1620  pprlten(jl) = ztpr(ji)
1621  pprsten(jl) = zspr(ji)
1622  END DO
1623 !
1624 !
1625 ! Cloud base and top levels
1626 ! -------------------------
1627 !
1628  ilcl(:) = min( ilcl(:), ictl(:) )
1629  DO ji = 1, iconv
1630  jl = ijindex(ji)
1631  kcltop(jl) = ictl(ji)
1632  kclbas(jl) = ilcl(ji)
1633  END DO
1634 !
1635 !
1636 !* 8.4 Set convective counter
1637 ! ----------------------
1638 !
1639  ! compute convective counter for just activated convective
1640  ! grid points
1641  ! If the advective time period is less than specified
1642  ! minimum for convective period, allow feedback to occur only
1643  ! during advective time
1644 !
1645  ztime(:) = 1.
1646  zwork2(:) = 0.
1647  DO ji = 1, iconv
1648  jl = ijindex(ji)
1649  ztime(jl) = ztimec(ji)
1650  zwork2(jl) = ztimea(ji)
1651  zwork2(jl) = min( zwork2(jl), ztime(jl) )
1652  zwork2(jl) = max( zwork2(jl), pdtconv )
1653  IF ( gtrig(jl) ) kcount(jl) = int( zwork2(jl) / pdtconv )
1654  IF ( gtrig(jl) .AND. pprlten(jl)<1.e-14 ) kcount(jl) = 0
1655  END DO
1656 !
1657 !
1658 !
1659 !* 8.7 Compute convective tendencies for Tracers
1660 ! ------------------------------------------
1661 !
1662  IF ( och1conv ) THEN
1663 !
1664  ALLOCATE( zch1(iconv,iks,kch1) )
1665  ALLOCATE( zch1c(iconv,iks,kch1) )
1666  ALLOCATE( zwork3(iconv,kch1) )
1667 !
1668  DO jk = ikb, ike
1669  DO ji = 1, iconv
1670  jl = ijindex(ji)
1671  zch1(ji,jk,:) = pch1(jl,jk,:)
1672  END DO
1673  END DO
1674 !
1675  CALL convect_chem_transport( iconv, klev, kch1, zch1, zch1c, &
1676  idpl, ipbl, ilcl, ictl, ilfs, idbl, &
1677  zumf, zuer, zudr, zdmf, zder, zddr, &
1678  ztimec, zdxdy, zmixf, zlmass, zwsub, &
1679  iftsteps )
1680 !
1681  DO jk = ikb, ike
1682  DO jn = 1, kch1
1683  zch1c(:,jk,jn) = ( zch1c(:,jk,jn)- zch1(:,jk,jn) ) / ztimec(:)
1684  END DO
1685  END DO
1686 !
1687 !* 8.8 Apply conservation correction
1688 ! -----------------------------
1689 !
1690  ! Compute vertical integrals
1691 !
1692  jkm = maxval( ictl(:) )
1693  zwork3(:,:) = 0.
1694  DO jk = jkm, ikb+1, -1
1695  jkp = jk + 1
1696  DO ji = 1, iconv
1697  zwork3(ji,:) = zwork3(ji,:) + zch1c(ji,jk,:) * &
1698  (zpres(ji,jk) - zpres(ji,jkp)) / xg
1699  END DO
1700  END DO
1701 !
1702  ! Mass error (integral must be zero)
1703 !
1704  DO ji = 1, iconv
1705  IF ( ztpr(ji) > 0.) THEN
1706  jkp = ictl(ji) + 1
1707  zwork3(ji,:) = zwork3(ji,:) * &
1708  xg / ( zpres(ji,ikb+1) - zpres(ji,jkp) )
1709  END IF
1710  END DO
1711 !
1712  ! Apply uniform correction but assure positive mass at each level
1713 !
1714  DO jk = jkm, ikb+1, -1
1715  DO ji = 1, iconv
1716  IF ( ztpr(ji) > 0. .AND. jk <= ictl(ji) ) THEN
1717  zch1c(ji,jk,:) = zch1c(ji,jk,:) - zwork3(ji,:)
1718  zch1c(ji,jk,:) = max( zch1c(ji,jk,:), -zch1(ji,jk,:)/ztimec(ji) )
1719  END IF
1720  END DO
1721  END DO
1722 !
1723  DO jk = ikb, ike
1724  DO ji = 1, iconv
1725  jl = ijindex(ji)
1726  pch1ten(jl,jk,:) = zch1c(ji,jk,:)
1727  END DO
1728  END DO
1729  END IF
1730 !
1731 !
1732 !* 9. Write up- and downdraft mass fluxes
1733 ! ------------------------------------
1734 !
1735  DO jk = ikb, ike
1736  zumf(:,jk) = zumf(:,jk) / zdxdy(:) ! Mass flux per unit area
1737  zdmf(:,jk) = zdmf(:,jk) / zdxdy(:)
1738  END DO
1739  zwork2(:) = 1.
1740  WHERE ( pprlten(:)<1.e-14 ) zwork2(:) = 0.
1741  DO jk = ikb, ike
1742  DO ji = 1, iconv
1743  jl = ijindex(ji)
1744  pumf(jl,jk) = zumf(ji,jk) * zwork2(jl)
1745  pdmf(jl,jk) = zdmf(ji,jk) * zwork2(jl)
1746  END DO
1747  END DO
1748 !
1749 !
1750 !* 10. Deallocate all local arrays
1751 ! ---------------------------
1752 !
1753 ! downdraft variables
1754 !
1755  DEALLOCATE( zdmf )
1756  DEALLOCATE( zder )
1757  DEALLOCATE( zddr )
1758  DEALLOCATE( zdthl )
1759  DEALLOCATE( zdrw )
1760  DEALLOCATE( zlmass )
1761  DEALLOCATE( zmixf )
1762  DEALLOCATE( ztpr )
1763  DEALLOCATE( zspr )
1764  DEALLOCATE( zdtevr )
1765  DEALLOCATE( zpref )
1766  DEALLOCATE( iml )
1767  DEALLOCATE( ilfs )
1768  DEALLOCATE( idbl )
1769  DEALLOCATE( zdtevrf )
1770  DEALLOCATE( zprlflx )
1771  DEALLOCATE( zprsflx )
1772 !
1773 ! closure variables
1774 !
1775  DEALLOCATE( ztimea )
1776  DEALLOCATE( ztimec )
1777  DEALLOCATE( zthc )
1778  DEALLOCATE( zrvc )
1779  DEALLOCATE( zrcc )
1780  DEALLOCATE( zric )
1781  DEALLOCATE( zwsub )
1782 !
1783  IF ( och1conv ) THEN
1784  DEALLOCATE( zch1 )
1785  DEALLOCATE( zch1c )
1786  DEALLOCATE( zwork3 )
1787  END IF
1788 !
1789  ENDIF
1790 !
1791 ! vertical index
1792 !
1793  DEALLOCATE( idpl )
1794  DEALLOCATE( ipbl )
1795  DEALLOCATE( ilcl )
1796  DEALLOCATE( ictl )
1797  DEALLOCATE( ietl )
1798 !
1799 ! grid scale variables
1800 !
1801  DEALLOCATE( zz )
1802  DEALLOCATE( zpres )
1803  DEALLOCATE( zdpres )
1804  DEALLOCATE( zu )
1805  DEALLOCATE( zv )
1806  DEALLOCATE( ztt )
1807  DEALLOCATE( zth )
1808  DEALLOCATE( zthv )
1809  DEALLOCATE( zthl )
1810  DEALLOCATE( zthes )
1811  DEALLOCATE( zrw )
1812  DEALLOCATE( zrv )
1813  DEALLOCATE( zrc )
1814  DEALLOCATE( zri )
1815  DEALLOCATE( zdxdy )
1816 !
1817 ! updraft variables
1818 !
1819  DEALLOCATE( zumf )
1820  DEALLOCATE( zuer )
1821  DEALLOCATE( zudr )
1822  DEALLOCATE( zuthl )
1823  DEALLOCATE( zuthv )
1824  DEALLOCATE( zurw )
1825  DEALLOCATE( zurc )
1826  DEALLOCATE( zuri )
1827  DEALLOCATE( zurr )
1828  DEALLOCATE( zurs )
1829  DEALLOCATE( zupr )
1830  DEALLOCATE( zutpr )
1831  DEALLOCATE( zthlcl )
1832  DEALLOCATE( ztlcl )
1833  DEALLOCATE( zrvlcl )
1834  DEALLOCATE( zwlcl )
1835  DEALLOCATE( zzlcl )
1836  DEALLOCATE( zthvelcl )
1837  DEALLOCATE( zmflcl )
1838  DEALLOCATE( zcape )
1839  IF ( osettadj ) DEALLOCATE( ztimed )
1840 !
1841 ! work arrays
1842 !
1843  DEALLOCATE( iindex )
1844  DEALLOCATE( ijindex )
1845  DEALLOCATE( ijsindex )
1846  DEALLOCATE( gtrig1 )
1847 !
1848 !
1849 END SUBROUTINE convect_deep
1850 ! ######spl
1851  SUBROUTINE convect_trigger_funct( KLON, KLEV, &
1852  ppres, pth, pthv, pthes, &
1853  prv, pw, pz, pdxdy, &
1854  pthlcl, ptlcl, prvlcl, pwlcl, pzlcl, &
1855  pthvelcl, klcl, kdpl, kpbl, otrig, &
1856  pcape )
1857 ! ######################################################################
1858 !
1859 !!**** Determine convective columns as well as the cloudy values of theta,
1860 !! and qv at the lifting condensation level (LCL)
1861 !!
1862 !! PURPOSE
1863 !! -------
1864 !! The purpose of this routine is to determine convective columns
1865 !!
1866 !!
1867 !!
1868 !!** METHOD
1869 !! ------
1870 !! Computations are done at every model level starting from bottom.
1871 !! The use of masks allows to optimise the inner loops (horizontal loops).
1872 !! What we look for is the undermost unstable level at each grid point.
1873 !!
1874 !!
1875 !!
1876 !! EXTERNAL
1877 !! --------
1878 !! Routine CONVECT_SATMIXRATIO
1879 !!
1880 !!
1881 !! IMPLICIT ARGUMENTS
1882 !! ------------------
1883 !! Module MODD_CST
1884 !! XG ! gravity constant
1885 !! XP00 ! Reference pressure
1886 !! XRD, XRV ! Gaz constants for dry air and water vapor
1887 !! XCPD ! Cpd (dry air)
1888 !! XTT ! triple point temperature
1889 !! XBETAW, XGAMW ! constants for vapor saturation pressure
1890 !!
1891 !! Module MODD_CONVPAR
1892 !! XA25 ! reference grid area
1893 !! XZLCL ! maximum height difference between
1894 !! ! the surface and the DPL
1895 !! XZPBL ! minimum mixed layer depth to sustain convection
1896 !! XWTRIG ! constant in vertical velocity trigger
1897 !! XCDEPTH ! minimum necessary cloud depth
1898 !! XNHGAM ! coefficient for buoyancy term in w eq.
1899 !! ! accounting for nh-pressure
1900 !!
1901 !! Module MODD_CONVPAREXT
1902 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
1903 !!
1904 !! REFERENCE
1905 !! ---------
1906 !!
1907 !! Book2 of documentation ( routine TRIGGER_FUNCT)
1908 !! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
1909 !!
1910 !! AUTHOR
1911 !! ------
1912 !! P. BECHTOLD * Laboratoire d'Aerologie *
1913 !!
1914 !! MODIFICATIONS
1915 !! -------------
1916 !! Original 07/11/95
1917 !! Last modified 20/03/97 Select first departure level
1918 !! that produces a cloud thicker than XCDEPTH
1919 !-------------------------------------------------------------------------------
1920 !
1921 !* 0. DECLARATIONS
1922 ! ------------
1923 !
1924 USE modd_cst
1925 USE modd_convpar
1926 USE modd_convparext
1927 !
1928 !
1929 IMPLICIT NONE
1930 !
1931 !* 0.1 Declarations of dummy arguments :
1932 !
1933 INTEGER, INTENT(IN) :: KLON ! horizontal loop index
1934 INTEGER, INTENT(IN) :: KLEV ! vertical loop index
1935 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area
1936 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
1937 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES ! envir. satur. theta_e
1938 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV ! vapor mixing ratio
1939 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES ! pressure
1940 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ ! height of grid point (m)
1941 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW ! vertical velocity
1942 !
1943 REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
1944 REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temp. at LCL
1945 REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
1946 REAL, DIMENSION(KLON), INTENT(OUT):: PWLCL ! parcel velocity at LCL
1947 REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
1948 REAL, DIMENSION(KLON), INTENT(OUT):: PTHVELCL ! environm. theta_v at LCL (K)
1949 LOGICAL, DIMENSION(KLON), INTENT(OUT):: OTRIG ! logical mask for convection
1950 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KLCL ! contains vert. index of LCL
1951 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KDPL ! contains vert. index of DPL
1952 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KPBL ! contains index of source layer top
1953 REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! CAPE (J/kg) for diagnostics
1954 !
1955 !* 0.2 Declarations of local variables :
1956 !
1957 INTEGER :: JKK, JK, JKP, JKM, JKDL, JL, JKT, JT! vertical loop index
1958 INTEGER :: JI ! horizontal loop index
1959 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
1960 REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
1961 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
1962 !
1963 REAL, DIMENSION(KLON) :: ZTHLCL, ZTLCL, ZRVLCL, & ! locals for PTHLCL,PTLCL
1964  ZWLCL, ZZLCL, ZTHVELCL ! PRVLCL, ....
1965 INTEGER, DIMENSION(KLON) :: IDPL, IPBL, ILCL ! locals for KDPL, ...
1966 REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
1967 REAL, DIMENSION(KLON) :: ZZDPL ! height of DPL
1968 REAL, DIMENSION(KLON) :: ZTHVLCL ! theta_v at LCL = mixed layer value
1969 REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
1970 REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
1971 REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
1972 REAL, DIMENSION(KLON) :: ZCAPE ! convective available energy (m^2/s^2/g)
1973 REAL, DIMENSION(KLON) :: ZTHEUL ! updraft equiv. pot. temperature (K)
1974 REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
1975 REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
1976 REAL, DIMENSION(KLON) :: ZTOP ! estimated cloud top (m)
1977 REAL, DIMENSION(KLON,KLEV):: ZCAP ! CAPE at every level for diagnostics
1978 !INTEGER, DIMENSION(KLON) :: ITOP ! work array to store highest test layer
1979 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
1980 LOGICAL, DIMENSION(KLON) :: GTRIG, GTRIG2 ! local arrays for OTRIG
1981 LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
1982 !
1983 !
1984 !-------------------------------------------------------------------------------
1985 !
1986 !* 0.3 Compute array bounds
1987 ! --------------------
1988 !
1989 iie = klon
1990 ikb = 1 + jcvexb
1991 ike = klev - jcvext
1992 !
1993 !
1994 !* 1. Initialize local variables
1995 ! --------------------------
1996 !
1997 zeps = xrd / xrv
1998 zepsa = xrv / xrd
1999 zcpord = xcpd / xrd
2000 zrdocp = xrd / xcpd
2001 otrig(:) = .false.
2002 idpl(:) = kdpl(:)
2003 ipbl(:) = kpbl(:)
2004 ilcl(:) = klcl(:)
2005 !ITOP(:) = IKB
2006 pwlcl(:) = 0.
2007 zwlcl(:) = 0.
2008 pthlcl(:) = 1.
2009 pthvelcl(:)= 1.
2010 ptlcl(:) = 1.
2011 prvlcl(:) = 0.
2012 pwlcl(:) = 0.
2013 pzlcl(:) = pz(:,ikb)
2014 zzdpl(:) = pz(:,ikb)
2015 gtrig2(:) = .true.
2016 zcap(:,:) = 0.
2017 !
2018 !
2019 !
2020 ! 1. Determine highest necessary loop test layer
2021 ! -------------------------------------------
2022 !
2023 jt = ike - 2
2024 DO jk = ikb + 1, ike - 2
2025  ! DO JI = 1, IIE
2026  ! IF ( PZ(JI,JK) - PZ(JI,IKB) <= XZLCL ) ITOP(JI) = JK
2027  ! END DO
2028  IF ( pz(1,jk) - pz(1,ikb) < 12.e3 ) jt = jk
2029 END DO
2030 !
2031 !
2032 !* 2. Enter loop for convection test
2033 ! ------------------------------
2034 !
2035 jkp = minval( idpl(:) ) + 1
2036 !JKT = MAXVAL( ITOP(:) )
2037 jkt = jt
2038 DO jkk = jkp, jkt
2039 !
2040  gwork1(:) = zzdpl(:) - pz(:,ikb) < xzlcl
2041  ! we exit the trigger test when the center of the mixed layer is more
2042  ! than 3500 m above soil level.
2043  WHERE ( gwork1(:) )
2044  zdpthmix(:) = 0.
2045  zpresmix(:) = 0.
2046  zthlcl(:) = 0.
2047  zrvlcl(:) = 0.
2048  zzdpl(:) = pz(:,jkk)
2049  idpl(:) = jkk
2050  END WHERE
2051 !
2052 !
2053 !* 3. Construct a mixed layer of at least 60 hPa (XZPBL)
2054 ! ------------------------------------------
2055 !
2056  DO jk = jkk, ike - 1
2057  jkm = jk + 1
2058  DO ji = 1, iie
2059  IF ( gwork1(ji) .AND. zdpthmix(ji) < xzpbl ) THEN
2060  ipbl(ji) = jk
2061  zwork1(ji) = ppres(ji,jk) - ppres(ji,jkm)
2062  zdpthmix(ji) = zdpthmix(ji) + zwork1(ji)
2063  zpresmix(ji) = zpresmix(ji) + ppres(ji,jk) * zwork1(ji)
2064  zthlcl(ji) = zthlcl(ji) + pth(ji,jk) * zwork1(ji)
2065  zrvlcl(ji) = zrvlcl(ji) + prv(ji,jk) * zwork1(ji)
2066  END IF
2067  END DO
2068  IF ( minval( zdpthmix(:) ) >= xzpbl ) EXIT
2069  END DO
2070 !
2071 !
2072  WHERE ( gwork1(:) )
2073 !
2074  zpresmix(:) = zpresmix(:) / zdpthmix(:)
2075  ! ZTHLCL(:) = ZTHLCL(:) / ZDPTHMIX(:)
2076  ! ZRVLCL(:) = ZRVLCL(:) / ZDPTHMIX(:)
2077  zthlcl(:) = zthlcl(:) / zdpthmix(:) + xdthpbl
2078  zrvlcl(:) = zrvlcl(:) / zdpthmix(:) + xdrvpbl
2079  zthvlcl(:) = zthlcl(:) * ( 1. + zepsa * zrvlcl(:) ) &
2080  / ( 1. + zrvlcl(:) )
2081 !
2082 !* 4.1 Use an empirical direct solution ( Bolton formula )
2083 ! to determine temperature and pressure at LCL.
2084 ! Nota: the adiabatic saturation temperature is not
2085 ! equal to the dewpoint temperature
2086 ! ----------------------------------------------------
2087 !
2088 !
2089  ztmix(:) = zthlcl(:) * ( zpresmix(:) / xp00 ) ** zrdocp
2090  zevmix(:) = zrvlcl(:) * zpresmix(:) / ( zrvlcl(:) + zeps )
2091  zevmix(:) = max( 1.e-8, zevmix(:) )
2092  zwork1(:) = log( zevmix(:) / 613.3 )
2093  ! dewpoint temperature
2094  zwork1(:) = ( 4780.8 - 32.19 * zwork1(:) ) / ( 17.502 - zwork1(:) )
2095  ! adiabatic saturation temperature
2096  ztlcl(:) = zwork1(:) - ( .212 + 1.571e-3 * ( zwork1(:) - xtt ) &
2097  - 4.36e-4 * ( ztmix(:) - xtt ) ) * ( ztmix(:) - zwork1(:) )
2098  ztlcl(:) = min( ztlcl(:), ztmix(:) )
2099  zplcl(:) = xp00 * ( ztlcl(:) / zthlcl(:) ) ** zcpord
2100 !
2101  END WHERE
2102 !
2103 !
2104 !* 4.2 Correct ZTLCL in order to be completely consistent
2105 ! with MNH saturation formula
2106 ! ---------------------------------------------
2107 !
2108  CALL convect_satmixratio( klon, zplcl, ztlcl, zwork1, zlv, zwork2, zcph )
2109  WHERE( gwork1(:) )
2110  zwork2(:) = zwork1(:) / ztlcl(:) * ( xbetaw / ztlcl(:) - xgamw ) ! dr_sat/dT
2111  zwork2(:) = ( zwork1(:) - zrvlcl(:) ) / &
2112  ( 1. + zlv(:) / zcph(:) * zwork2(:) )
2113  ztlcl(:) = ztlcl(:) - zlv(:) / zcph(:) * zwork2(:)
2114 !
2115  END WHERE
2116 !
2117 !
2118 !* 4.3 If ZRVLCL = PRVMIX is oversaturated set humidity
2119 ! and temperature to saturation values.
2120 ! ---------------------------------------------
2121 !
2122  CALL convect_satmixratio( klon, zpresmix, ztmix, zwork1, zlv, zwork2, zcph )
2123  WHERE( gwork1(:) .AND. zrvlcl(:) > zwork1(:) )
2124  zwork2(:) = zwork1(:) / ztmix(:) * ( xbetaw / ztmix(:) - xgamw ) ! dr_sat/dT
2125  zwork2(:) = ( zwork1(:) - zrvlcl(:) ) / &
2126  ( 1. + zlv(:) / zcph(:) * zwork2(:) )
2127  ztlcl(:) = ztmix(:) - zlv(:) / zcph(:) * zwork2(:)
2128  zrvlcl(:) = zrvlcl(:) - zwork2(:)
2129  zplcl(:) = zpresmix(:)
2130  zthlcl(:) = ztlcl(:) * ( xp00 / zplcl(:) ) ** zrdocp
2131  zthvlcl(:)= zthlcl(:) * ( 1. + zepsa * zrvlcl(:) ) &
2132  / ( 1. + zrvlcl(:) )
2133  END WHERE
2134 !
2135 !
2136 !* 5.1 Determine vertical loop index at the LCL and DPL
2137 ! --------------------------------------------------
2138 !
2139  DO jk = jkk, ike - 1
2140  DO ji = 1, iie
2141  IF ( zplcl(ji) <= ppres(ji,jk) .AND. gwork1(ji) ) ilcl(ji) = jk + 1
2142  END DO
2143  END DO
2144 !
2145 !
2146 !* 5.2 Estimate height and environm. theta_v at LCL
2147 ! --------------------------------------------------
2148 !
2149  DO ji = 1, iie
2150  jk = ilcl(ji)
2151  jkm = jk - 1
2152  zdp(ji) = log( zplcl(ji) / ppres(ji,jkm) ) / &
2153  log( ppres(ji,jk) / ppres(ji,jkm) )
2154  zwork1(ji) = pthv(ji,jkm) + ( pthv(ji,jk) - pthv(ji,jkm) ) * zdp(ji)
2155  ! we compute the precise value of the LCL
2156  ! The precise height is between the levels ILCL and ILCL-1.
2157  zwork2(ji) = pz(ji,jkm) + ( pz(ji,jk) - pz(ji,jkm) ) * zdp(ji)
2158  END DO
2159  WHERE( gwork1(:) )
2160  zthvelcl(:) = zwork1(:)
2161  zzlcl(:) = zwork2(:)
2162  END WHERE
2163 !
2164 !
2165 !* 6. Check to see if cloud is bouyant
2166 ! --------------------------------
2167 !
2168 !* 6.1 Compute grid scale vertical velocity perturbation term ZWORK1
2169 ! -------------------------------------------------------------
2170 !
2171  ! normalize w grid scale to a 25 km refer. grid
2172  DO ji = 1, iie
2173  jk = ilcl(ji)
2174  jkm = jk - 1
2175  jkdl = idpl(ji)
2176  !ZWORK1(JI) = ( PW(JI,JKM) + ( PW(JI,JK) - PW(JI,JKM) ) * ZDP(JI) ) &
2177  zwork1(ji) = ( pw(ji,jk) + pw(ji,jkdl)*zzlcl(ji)/pz(ji,jkdl) ) * .5 &
2178  * sqrt( pdxdy(ji) / xa25 )
2179 ! - 0.02 * ZZLCL(JI) / XZLCL ! avoid spurious convection
2180  END DO
2181  ! compute sign of normalized grid scale w
2182  zwork2(:) = sign( 1., zwork1(:) )
2183  zwork1(:) = xwtrig * zwork2(:) * abs( zwork1(:) ) ** 0.333 &
2184  * ( xp00 / zplcl(:) ) ** zrdocp
2185 !
2186 !* 6.2 Compute parcel vertical velocity at LCL
2187 ! ---------------------------------------
2188 !
2189  DO ji = 1, iie
2190  jkdl = idpl(ji)
2191  zwork3(ji) = xg * zwork1(ji) * ( zzlcl(ji) - pz(ji,jkdl) ) &
2192  / ( pthv(ji,jkdl) + zthvelcl(ji) )
2193  END DO
2194  WHERE( gwork1(:) )
2195  zwlcl(:) = 1. + .5 * zwork2(:) * sqrt( abs( zwork3(:) ) )
2196  gtrig(:) = zthvlcl(:) - zthvelcl(:) + zwork1(:) > 0. .AND. &
2197  zwlcl(:) > 0.
2198  END WHERE
2199 !
2200 !
2201 !* 6.3 Look for parcel that produces sufficient cloud depth.
2202 ! The cloud top is estimated as the level where the CAPE
2203 ! is smaller than a given value (based on vertical velocity eq.)
2204 ! --------------------------------------------------------------
2205 !
2206  ztheul(:) = ztlcl(:) * ( zthlcl(:) / ztlcl(:) ) &
2207  ** ( 1. - 0.28 * zrvlcl(:) ) &
2208  * exp( ( 3374.6525 / ztlcl(:) - 2.5403 ) * &
2209  zrvlcl(:) * ( 1. + 0.81 * zrvlcl(:) ) )
2210 !
2211  zcape(:) = 0.
2212  ztop(:) = 0.
2213  zwork3(:)= 0.
2214  jkm = minval( ilcl(:) )
2215  DO jl = jkm, jt
2216  jk = jl + 1
2217  DO ji = 1, iie
2218  zwork1(ji) = ( 2. * ztheul(ji) / &
2219  ( pthes(ji,jk) + pthes(ji,jl) ) - 1. ) * ( pz(ji,jk) - pz(ji,jl) )
2220  IF ( jl < ilcl(ji) ) zwork1(ji) = 0.
2221  zcape(ji) = zcape(ji) + zwork1(ji)
2222  zcap(ji,jkk) = zcap(ji,jkk) + xg * max( 0., zwork1(ji) ) ! actual CAPE
2223  zwork2(ji) = xnhgam * xg * zcape(ji) + 1.05 * zwlcl(ji) * zwlcl(ji)
2224  ! the factor 1.05 takes entrainment into account
2225  zwork2(ji) = sign( 1., zwork2(ji) )
2226  zwork3(ji) = zwork3(ji) + min(0., zwork2(ji) )
2227  zwork3(ji) = max( -1., zwork3(ji) )
2228  ! Nota, the factors ZWORK2 and ZWORK3 are only used to avoid
2229  ! if and goto statements, the difficulty is to extract only
2230  ! the level where the criterium is first fullfilled
2231  ztop(ji) = pz(ji,jl) * .5 * ( 1. + zwork2(ji) ) * ( 1. + zwork3(ji) ) + &
2232  ztop(ji) * .5 * ( 1. - zwork2(ji) )
2233  END DO
2234  END DO
2235 !
2236 !
2237  WHERE( ztop(:) - zzlcl(:) .GE. xcdepth .AND. gtrig(:) .AND. gtrig2(:) )
2238  gtrig2(:) = .false.
2239  otrig(:) = gtrig(:) ! we select the first departure level
2240  pthlcl(:) = zthlcl(:) ! that gives sufficient cloud depth
2241  prvlcl(:) = zrvlcl(:)
2242  ptlcl(:) = ztlcl(:)
2243  pwlcl(:) = zwlcl(:)
2244  pzlcl(:) = zzlcl(:)
2245  pthvelcl(:) = zthvelcl(:)
2246  kdpl(:) = idpl(:)
2247  kpbl(:) = ipbl(:)
2248  klcl(:) = ilcl(:)
2249  END WHERE
2250 !
2251 END DO
2252 !
2253  DO ji = 1, iie
2254  pcape(ji) = maxval( zcap(ji,:) ) ! maximum CAPE for diagnostics
2255  END DO
2256 !
2257 !
2258 END SUBROUTINE convect_trigger_funct
2259 ! ######spl
2260  SUBROUTINE convect_updraft( KLON, KLEV, &
2261  kice, ppres, pdpres, pz, pthl, pthv, pthes, prw, &
2262  pthlcl, ptlcl, prvlcl, pwlcl, pzlcl, pthvelcl, &
2263  pmflcl, otrig, klcl, kdpl, kpbl, &
2264  pumf, puer, pudr, puthl, puthv, purw, &
2265  purc, puri, purr, purs, pupr, &
2266  putpr, pcape, kctl, ketl )
2267 ! #############################################################################
2268 !
2269 !!**** Compute updraft properties from DPL to CTL.
2270 !!
2271 !!
2272 !! PURPOSE
2273 !! -------
2274 !! The purpose of this routine is to determine updraft properties
2275 !! ( mass flux, thermodynamics, precipitation )
2276 !!
2277 !!
2278 !!** METHOD
2279 !! ------
2280 !! Computations are done at every model level starting from bottom.
2281 !! The use of masks allows to optimise the inner loops (horizontal loops).
2282 !!
2283 !!
2284 !!
2285 !! EXTERNAL
2286 !! --------
2287 !! Routine CONVECT_MIXING_FUNCT
2288 !! Routine CONVECT_CONDENS
2289 !!
2290 !!
2291 !! IMPLICIT ARGUMENTS
2292 !! ------------------
2293 !! Module MODD_CST
2294 !! XG ! gravity constant
2295 !! XP00 ! reference pressure
2296 !! XRD, XRV ! gaz constants for dry air and water vapor
2297 !! XCPD, XCPV, XCL ! Cp of dry air, water vapor and liquid water
2298 !! XTT ! triple point temperature
2299 !! XLVTT ! vaporisation heat at XTT
2300 !!
2301 !!
2302 !! Module MODD_CONVPAR
2303 !! XA25 ! reference grid area
2304 !! XCRAD ! cloud radius
2305 !! XCDEPTH ! minimum necessary cloud depth
2306 !! XENTR ! entrainment constant
2307 !! XRCONV ! constant in precipitation conversion
2308 !! XNHGAM ! coefficient for buoyancy term in w eq.
2309 !! ! accounting for nh-pressure
2310 !! XTFRZ1 ! begin of freezing interval
2311 !! XTFRZ2 ! begin of freezing interval
2312 !!
2313 !! Module MODD_CONVPAREXT
2314 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
2315 !!
2316 !! REFERENCE
2317 !! ---------
2318 !!
2319 !! Book1,2 of documentation ( routine CONVECT_UPDRAFT)
2320 !! Kain and Fritsch, 1990, J. Atmos. Sci., Vol.
2321 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
2322 !!
2323 !! AUTHOR
2324 !! ------
2325 !! P. BECHTOLD * Laboratoire d'Aerologie *
2326 !!
2327 !! MODIFICATIONS
2328 !! -------------
2329 !! Original 07/11/95
2330 !! Last modified 10/12/97
2331 !-------------------------------------------------------------------------------
2332 !
2333 !* 0. DECLARATIONS
2334 ! ------------
2335 !
2336 USE modd_cst
2337 USE modd_convpar
2338 USE modd_convparext
2339 !
2340 !
2341 IMPLICIT NONE
2342 !
2343 !* 0.1 Declarations of dummy arguments :
2344 !
2345 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
2346 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
2347 INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
2348  ! 0 = no ice )
2349 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
2350 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV ! grid scale theta_v
2351 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
2352 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
2353  ! mixing ratio
2354 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
2355 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
2356  ! bottom and top of layer (Pa)
2357 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
2358 REAL, DIMENSION(KLON), INTENT(IN) :: PTHLCL ! theta at LCL
2359 REAL, DIMENSION(KLON), INTENT(IN) :: PTLCL ! temp. at LCL
2360 REAL, DIMENSION(KLON), INTENT(IN) :: PRVLCL ! vapor mixing ratio at LCL
2361 REAL, DIMENSION(KLON), INTENT(IN) :: PWLCL ! parcel velocity at LCL (m/s)
2362 REAL, DIMENSION(KLON), INTENT(IN) :: PMFLCL ! cloud base unit mass flux
2363  ! (kg/s)
2364 REAL, DIMENSION(KLON), INTENT(IN) :: PZLCL ! height at LCL (m)
2365 REAL, DIMENSION(KLON), INTENT(IN) :: PTHVELCL ! environm. theta_v at LCL (K)
2366 LOGICAL, DIMENSION(KLON), INTENT(INOUT):: OTRIG! logical mask for convection
2367 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
2368 INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
2369 INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layertop
2370 !
2371 !
2372 INTEGER, DIMENSION(KLON), INTENT(OUT):: KCTL ! contains vert. index of CTL
2373 INTEGER, DIMENSION(KLON), INTENT(OUT):: KETL ! contains vert. index of &
2374  !equilibrium (zero buoyancy) level
2375 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF ! updraft mass flux (kg/s)
2376 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER ! updraft entrainment (kg/s)
2377 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR ! updraft detrainment (kg/s)
2378 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
2379 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
2380 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW ! updraft total water (kg/kg)
2381 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC ! updraft cloud water (kg/kg)
2382 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI ! updraft cloud ice (kg/kg)
2383 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURR ! liquid precipit. (kg/kg)
2384  ! produced in model layer
2385 REAL, DIMENSION(KLON,KLEV), INTENT(OUT)::PURS ! solid precipit. (kg/kg)
2386  ! produced in model layer
2387 REAL, DIMENSION(KLON,KLEV), INTENT(OUT)::PUPR ! updraft precipitation in
2388  ! flux units (kg water / s)
2389 REAL, DIMENSION(KLON), INTENT(OUT):: PUTPR ! total updraft precipitation
2390  ! in flux units (kg water / s)
2391 REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! available potent. energy
2392 !
2393 !* 0.2 Declarations of local variables :
2394 !
2395 INTEGER :: IIE, IKB, IKE ! horizontal and vertical loop bounds
2396 INTEGER :: JI ! horizontal loop index
2397 INTEGER :: JK, JKP, JKM, JK1, JK2, JKMIN ! vertical loop index
2398 REAL :: ZEPSA, ZCVOCD ! R_v / R_d, C_pv / C_pd
2399 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
2400 !
2401 REAL, DIMENSION(KLON) :: ZUT ! updraft temperature (K)
2402 REAL, DIMENSION(KLON) :: ZUW1, ZUW2 ! square of updraft vert.
2403  ! velocity at levels k and k+1
2404 REAL, DIMENSION(KLON) :: ZE1,ZE2,ZD1,ZD2 ! fractional entrainm./detrain
2405  ! rates at levels k and k+1
2406 REAL, DIMENSION(KLON) :: ZMIXF ! critical mixed fraction
2407 REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
2408 REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
2409 REAL, DIMENSION(KLON) :: ZURV ! updraft water vapor at level k+1
2410 REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
2411 REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
2412 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, &
2413  ZWORK6 ! work arrays
2414 INTEGER, DIMENSION(KLON) :: IWORK ! wok array
2415 LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK2, GWORK4, GWORK5
2416  ! work arrays
2417 LOGICAL, DIMENSION(KLON,KLEV) :: GWORK6 ! work array
2418 !
2419 !
2420 !-------------------------------------------------------------------------------
2421 !
2422 ! 0.3 Set loop bounds
2423 ! ---------------
2424 !
2425 ikb = 1 + jcvexb
2426 ike = klev - jcvext
2427 iie = klon
2428 !
2429 !
2430 !* 1. Initialize updraft properties and local variables
2431 ! -------------------------------------------------
2432 !
2433 zepsa = xrv / xrd
2434 zcvocd = xcpv / xcpd
2435 zcpord = xcpd / xrd
2436 zrdocp = xrd / xcpd
2437 !
2438 pumf(:,:) = 0.
2439 puer(:,:) = 0.
2440 pudr(:,:) = 0.
2441 puthl(:,:) = 0.
2442 puthv(:,:) = 0.
2443 purw(:,:) = 0.
2444 purc(:,:) = 0.
2445 puri(:,:) = 0.
2446 pupr(:,:) = 0.
2447 purr(:,:) = 0.
2448 purs(:,:) = 0.
2449 putpr(:) = 0.
2450 zuw1(:) = pwlcl(:) * pwlcl(:)
2451 zuw2(:) = 0.
2452 ze1(:) = 1.
2453 zd1(:) = 0.
2454 pcape(:) = 0.
2455 kctl(:) = ikb
2456 ketl(:) = klcl(:)
2457 gwork2(:) = .true.
2458 gwork5(:) = .true.
2459 zpi(:) = 1.
2460 zwork3(:) = 0.
2461 zwork4(:) = 0.
2462 zwork5(:) = 0.
2463 zwork6(:) = 0.
2464 gwork1(:) = .false.
2465 gwork4(:) = .false.
2466 !
2467 !
2468 !* 1.1 Compute undilute updraft theta_e for CAPE computations
2469 ! Bolton (1980) formula.
2470 ! Define accurate enthalpy for updraft
2471 ! -----------------------------------------------------
2472 !
2473 ztheul(:) = ptlcl(:) * ( pthlcl(:) / ptlcl(:) ) ** ( 1. - 0.28 * prvlcl(:) ) &
2474  * exp( ( 3374.6525 / ptlcl(:) - 2.5403 ) * &
2475  prvlcl(:) * ( 1. + 0.81 * prvlcl(:) ) )
2476 !
2477 !
2478 zwork1(:) = ( xcpd + prvlcl(:) * xcpv ) * ptlcl(:) &
2479  + ( 1. + prvlcl(:) ) * xg * pzlcl(:)
2480 !
2481 !
2482 !* 2. Set updraft properties between DPL and LCL
2483 ! ------------------------------------------
2484 !
2485 jkp = maxval( klcl(:) )
2486 jkm = minval( kdpl(:) )
2487 DO jk = jkm, jkp
2488  DO ji = 1, iie
2489  IF ( jk >= kdpl(ji) .AND. jk < klcl(ji) ) THEN
2490  pumf(ji,jk) = pmflcl(ji)
2491  puthl(ji,jk) = zwork1(ji)
2492  puthv(ji,jk) = pthlcl(ji) * ( 1. + zepsa * prvlcl(ji) ) / &
2493  ( 1. + prvlcl(ji) )
2494  purw(ji,jk) = prvlcl(ji)
2495  END IF
2496  END DO
2497 END DO
2498 !
2499 !
2500 !* 3. Enter loop for updraft computations
2501 ! ------------------------------------
2502 !
2503 jkmin = minval( klcl(:) - 1 )
2504 DO jk = max( ikb + 1, jkmin ), ike - 1
2505  zwork6(:) = 1.
2506  jkp = jk + 1
2507 !
2508  gwork4(:) = jk >= klcl(:) - 1
2509  gwork1(:) = gwork4(:) .AND. gwork2(:) ! this mask is used to confine
2510  ! updraft computations between the LCL and the CTL
2511 !
2512  WHERE( jk == klcl(:) - 1 ) zwork6(:) = 0. ! factor that is used in buoyancy
2513  ! computation at first level above LCL
2514 !
2515 !
2516 !* 4. Estimate condensate, L_v L_i, Cph and theta_v at level k+1
2517 ! ----------------------------------------------------------
2518 !
2519  zwork1(:) = purc(:,jk) + purr(:,jk)
2520  zwork2(:) = puri(:,jk) + purs(:,jk)
2521  CALL convect_condens( klon, kice, ppres(:,jkp), puthl(:,jk), purw(:,jk),&
2522  zwork1, zwork2, pz(:,jkp), gwork1, zut, zurv, &
2523  purc(:,jkp), puri(:,jkp), zlv, zls, zcph )
2524 !
2525 !
2526  zpi(:) = ( xp00 / ppres(:,jkp) ) ** zrdocp
2527  WHERE ( gwork1(:) )
2528 !
2529  puthv(:,jkp) = zpi(:) * zut(:) * ( 1. + zepsa * zurv(:) ) &
2530  / ( 1. + purw(:,jk) )
2531 !
2532 !
2533 !* 5. Compute square of vertical velocity using entrainment
2534 ! at level k
2535 ! -----------------------------------------------------
2536 !
2537  zwork3(:) = pz(:,jkp) - pz(:,jk) * zwork6(:) - &
2538  ( 1. - zwork6(:) ) * pzlcl(:) ! level thickness
2539  zwork4(:) = pthv(:,jk) * zwork6(:) + &
2540  ( 1. - zwork6(:) ) * pthvelcl(:)
2541  zwork5(:) = 2. * zuw1(:) * puer(:,jk) / max( .1, pumf(:,jk) )
2542  zuw2(:) = zuw1(:) + zwork3(:) * xnhgam * xg * &
2543  ( ( puthv(:,jk) + puthv(:,jkp) ) / &
2544  ( zwork4(:) + pthv(:,jkp) ) - 1. ) & ! buoyancy term
2545  - zwork5(:) ! entrainment term
2546 !
2547 !
2548 !* 6. Update total precipitation: dr_r=(r_c+r_i)*exp(-rate*dz)
2549 ! --------------------------------------------------------
2550 !
2551 ! compute level mean vertical velocity
2552  zwork2(:) = 0.5 * &
2553  ( sqrt( max( 1.e-2, zuw2(:) ) ) + &
2554  sqrt( max( 1.e-2, zuw1(:) ) ) )
2555  purr(:,jkp) = 0.5 * ( purc(:,jk) + purc(:,jkp) + puri(:,jk) + puri(:,jkp) )&
2556  * ( 1. - exp( - xrconv * zwork3(:) / zwork2(:) ) )
2557  pupr(:,jkp) = purr(:,jkp) * pumf(:,jk) ! precipitation rate ( kg water / s)
2558  putpr(:) = putpr(:) + pupr(:,jkp) ! total precipitation rate
2559  zwork2(:) = purr(:,jkp) / max( 1.e-8, purc(:,jkp) + puri(:,jkp) )
2560  purr(:,jkp) = zwork2(:) * purc(:,jkp) ! liquid precipitation
2561  purs(:,jkp) = zwork2(:) * puri(:,jkp) ! solid precipitation
2562 !
2563 !
2564 !* 7. Update r_c, r_i, enthalpy, r_w for precipitation
2565 ! -------------------------------------------------------
2566 !
2567  purw(:,jkp) = purw(:,jk) - purr(:,jkp) - purs(:,jkp)
2568  purc(:,jkp) = purc(:,jkp) - purr(:,jkp)
2569  puri(:,jkp) = puri(:,jkp) - purs(:,jkp)
2570  puthl(:,jkp) = ( xcpd + purw(:,jkp) * xcpv ) * zut(:) &
2571  + ( 1. + purw(:,jkp) ) * xg * pz(:,jkp) &
2572  - zlv(:) * purc(:,jkp) - zls(:) * puri(:,jkp)
2573 !
2574  zuw1(:) = zuw2(:)
2575 !
2576  END WHERE
2577 !
2578 !
2579 !* 8. Compute entrainment and detrainment using conservative
2580 ! variables adjusted for precipitation ( not for entrainment)
2581 ! -----------------------------------------------------------
2582 !
2583 !* 8.1 Compute critical mixed fraction by estimating unknown
2584 ! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
2585 ! We determine the zero crossing of the linear curve
2586 ! evaluating the derivative using ZMIXF=0.1.
2587 ! -----------------------------------------------------
2588 !
2589  zmixf(:) = 0.1 ! starting value for critical mixed fraction
2590  zwork1(:) = zmixf(:) * pthl(:,jkp) &
2591  + ( 1. - zmixf(:) ) * puthl(:,jkp) ! mixed enthalpy
2592  zwork2(:) = zmixf(:) * prw(:,jkp) &
2593  + ( 1. - zmixf(:) ) * purw(:,jkp) ! mixed r_w
2594 !
2595  CALL convect_condens( klon, kice, ppres(:,jkp), zwork1, zwork2, &
2596  purc(:,jkp), puri(:,jkp), pz(:,jkp), gwork1, zut,&
2597  zwork3, zwork4, zwork5, zlv, zls, zcph )
2598 ! put in enthalpy and r_w and get T r_c, r_i (ZUT, ZWORK4-5)
2599 !
2600  ! compute theta_v of mixture
2601  zwork3(:) = zut(:) * zpi(:) * ( 1. + zepsa * ( &
2602  zwork2(:) - zwork4(:) - zwork5(:) ) ) / ( 1. + zwork2(:) )
2603  ! compute final value of critical mixed fraction using theta_v
2604  ! of mixture, grid-scale and updraft
2605  zmixf(:) = max( 0., puthv(:,jkp) - pthv(:,jkp) ) * zmixf(:) / &
2606  ( puthv(:,jkp) - zwork3(:) + 1.e-10 )
2607  zmixf(:) = max( 0., min( 1., zmixf(:) ) )
2608 !
2609 !
2610 !* 8.2 Compute final midlevel values for entr. and detrainment
2611 ! after call of distribution function
2612 ! -------------------------------------------------------
2613 !
2614 !
2615  CALL convect_mixing_funct ( klon, zmixf, 1, ze2, zd2 )
2616 ! Note: routine MIXING_FUNCT returns fractional entrainm/detrainm. rates
2617 !
2618 ! ZWORK1(:) = XENTR * PMFLCL(:) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
2619 !*MOD
2620  zwork1(:) = xentr * xg / xcrad * pumf(:,jk) * ( pz(:,jkp) - pz(:,jk) )
2621 ! ZWORK1(:) = XENTR * pumf(:,jk) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
2622 !*MOD
2623  zwork2(:) = 0.
2624  WHERE ( gwork1(:) ) zwork2(:) = 1.
2625  WHERE ( puthv(:,jkp) > pthv(:,jkp) )
2626  ze2=.5; zd2=.5 ! modif entrainment=detrainment, this avoids
2627  ! too large mass flux values at upper levels
2628  puer(:,jkp) = 0.5 * zwork1(:) * ( ze1(:) + ze2(:) ) * zwork2(:)
2629  pudr(:,jkp) = 0.5 * zwork1(:) * ( zd1(:) + zd2(:) ) * zwork2(:)
2630  ELSEWHERE
2631  puer(:,jkp) = 0.
2632  pudr(:,jkp) = zwork1(:) * zwork2(:)
2633  END WHERE
2634 !
2635 !* 8.3 Determine equilibrium temperature level
2636 ! --------------------------------------
2637 !
2638  WHERE ( puthv(:,jkp) > pthv(:,jkp) .AND. jk > klcl(:) + 1 &
2639  .AND. gwork1(:) )
2640  ketl(:) = jkp ! equilibrium temperature level
2641  END WHERE
2642 !
2643 !* 8.4 If the calculated detrained mass flux is greater than
2644 ! the total updraft mass flux, or vertical velocity is
2645 ! negative, all cloud mass detrains at previous model level,
2646 ! exit updraft calculations - CTL is attained
2647 ! -------------------------------------------------------
2648 !
2649  WHERE( gwork1(:) ) &
2650  gwork2(:) = pumf(:,jk) - pudr(:,jkp) > 10. .AND. zuw2(:) > 0.
2651  WHERE ( gwork2(:) ) kctl(:) = jkp ! cloud top level
2652  gwork1(:) = gwork2(:) .AND. gwork4(:)
2653 !
2654  IF ( count( gwork2(:) ) == 0 ) EXIT
2655 !
2656 !
2657 !* 9. Compute CAPE for undilute ascent using theta_e and
2658 ! theta_es instead of theta_v. This estimation produces
2659 ! a significantly larger value for CAPE than the actual one.
2660 ! ----------------------------------------------------------
2661 !
2662  WHERE ( gwork1(:) )
2663 !
2664  zwork3(:) = pz(:,jkp) - pz(:,jk) * zwork6(:) - &
2665  ( 1. - zwork6(:) ) * pzlcl(:) ! level thickness
2666  zwork2(:) = pthes(:,jk) + ( 1. - zwork6(:) ) * &
2667  ( pthes(:,jkp) - pthes(:,jk) ) / ( pz(:,jkp) - pz(:,jk) ) * &
2668  ( pzlcl(:) - pz(:,jk) ) ! linear interpolation for theta_es at LCL
2669  ! ( this is only done for model level just above LCL
2670 !
2671  zwork1(:) = ( 2. * ztheul(:) ) / ( zwork2(:) + pthes(:,jkp) ) - 1.
2672  pcape(:) = pcape(:) + xg * zwork3(:) * max( 0., zwork1(:) )
2673 !
2674 !
2675 !* 10. Compute final values of updraft mass flux, enthalpy, r_w
2676 ! at level k+1
2677 ! --------------------------------------------------------
2678 !
2679  pumf(:,jkp) = pumf(:,jk) - pudr(:,jkp) + puer(:,jkp)
2680  pumf(:,jkp) = max( pumf(:,jkp), 0.1 )
2681  puthl(:,jkp) = ( pumf(:,jk) * puthl(:,jk) + &
2682  puer(:,jkp) * pthl(:,jk) - pudr(:,jkp) * puthl(:,jk) ) &
2683  / pumf(:,jkp) + puthl(:,jkp) - puthl(:,jk)
2684  purw(:,jkp) = ( pumf(:,jk) * purw(:,jk) + &
2685  puer(:,jkp) * prw(:,jk) - pudr(:,jkp) * purw(:,jk) ) &
2686  / pumf(:,jkp) - purr(:,jkp) - purs(:,jkp)
2687 !
2688  ze1(:) = ze2(:) ! update fractional entrainment/detrainment
2689  zd1(:) = zd2(:)
2690 !
2691  END WHERE
2692 !
2693 END DO
2694 !
2695 !* 12.1 Set OTRIG to False if cloud thickness < XCDEPTH
2696 ! or CAPE < 1
2697 ! ------------------------------------------------
2698 !
2699  DO ji = 1, iie
2700  jk = kctl(ji)
2701  otrig(ji) = pz(ji,jk) - pzlcl(ji) >= xcdepth &
2702  .AND. pcape(ji) > 1.
2703  END DO
2704  WHERE( .NOT. otrig(:) )
2705  kctl(:) = ikb
2706  END WHERE
2707 ketl(:) = max( ketl(:), klcl(:) + 2 )
2708 ketl(:) = min( ketl(:), kctl(:) )
2709 !
2710 !
2711 !* 12.2 If the ETL and CTL are the same detrain updraft mass
2712 ! flux at this level
2713 ! -------------------------------------------------------
2714 !
2715 zwork1(:) = 0.
2716 WHERE ( ketl(:) == kctl(:) ) zwork1(:) = 1.
2717 !
2718 DO ji = 1, iie
2719  jk = ketl(ji)
2720  pudr(ji,jk) = pudr(ji,jk) + &
2721  ( pumf(ji,jk) - puer(ji,jk) ) * zwork1(ji)
2722  puer(ji,jk) = puer(ji,jk) * ( 1. - zwork1(ji) )
2723  pumf(ji,jk) = pumf(ji,jk) * ( 1. - zwork1(ji) )
2724  jkp = kctl(ji) + 1
2725  puer(ji,jkp) = 0. ! entrainm/detr rates have been already computed
2726  pudr(ji,jkp) = 0. ! at level KCTL+1, set them to zero
2727 END DO
2728 !
2729 !* 12.3 Adjust mass flux profiles, detrainment rates, and
2730 ! precipitation fallout rates to reflect linear decrease
2731 ! in mass flux between the ETL and CTL
2732 ! -------------------------------------------------------
2733 !
2734 zwork1(:) = 0.
2735 jk1 = minval( ketl(:) )
2736 jk2 = maxval( kctl(:) )
2737 DO jk = jk1, jk2
2738  DO ji = 1, iie
2739  IF( jk > ketl(ji) .AND. jk <= kctl(ji) ) THEN
2740  zwork1(ji) = zwork1(ji) + pdpres(ji,jk)
2741  END IF
2742  END DO
2743 END DO
2744 !
2745 DO ji = 1, iie
2746  jk = ketl(ji)
2747  zwork1(ji) = pumf(ji,jk) / max( 1., zwork1(ji) )
2748 END DO
2749 !
2750 DO jk = jk1 + 1, jk2
2751  jkp = jk - 1
2752  DO ji = 1, iie
2753  IF ( jk > ketl(ji) .AND. jk <= kctl(ji) ) THEN
2754  ! PUTPR(JI) = PUTPR(JI) - ( PURR(JI,JK) + PURS(JI,JK) ) * PUMF(JI,JKP)
2755  putpr(ji) = putpr(ji) - pupr(ji,jk)
2756  pudr(ji,jk) = pdpres(ji,jk) * zwork1(ji)
2757  pumf(ji,jk) = pumf(ji,jkp) - pudr(ji,jk)
2758  pupr(ji,jk) = pumf(ji,jkp) * ( purr(ji,jk) + purs(ji,jk) )
2759  putpr(ji) = putpr(ji) + pupr(ji,jk)
2760  END IF
2761  END DO
2762 END DO
2763 !
2764 ! 12.4 Set mass flux and entrainment in the source layer.
2765 ! Linear increase throughout the source layer.
2766 ! -------------------------------------------------------
2767 !
2768 !IWORK(:) = MIN( KPBL(:), KLCL(:) - 1 )
2769 iwork(:) = kpbl(:)
2770 DO ji = 1, iie
2771  jk = kdpl(ji)
2772  jkp = iwork(ji)
2773 ! mixed layer depth
2774  zwork2(ji) = ppres(ji,jk) - ppres(ji,jkp) + pdpres(ji,jk)
2775 END DO
2776 !
2777 jkp = maxval( iwork(:) )
2778 DO jk = jkm, jkp
2779  DO ji = 1, iie
2780  IF ( jk >= kdpl(ji) .AND. jk <= iwork(ji) ) THEN
2781  puer(ji,jk) = puer(ji,jk) + pmflcl(ji) * pdpres(ji,jk) / ( zwork2(ji) + 0.1 )
2782  pumf(ji,jk) = pumf(ji,jk-1) + puer(ji,jk)
2783  END IF
2784  END DO
2785 END DO
2786 !
2787 !
2788 !* 13. If cloud thickness is smaller than 3 km, no
2789 ! convection is allowed
2790 ! Nota: For technical reasons, we stop the convection
2791 ! computations in this case and do not go back to
2792 ! TRIGGER_FUNCT to look for the next unstable LCL
2793 ! which could produce a thicker cloud.
2794 ! ---------------------------------------------------
2795 !
2796 gwork6(:,:) = spread( otrig(:), dim=2, ncopies=klev )
2797 WHERE ( .NOT. otrig(:) ) putpr(:) = 0.
2798 WHERE ( .NOT. gwork6(:,:) )
2799  pumf(:,:) = 0.
2800  pudr(:,:) = 0.
2801  puer(:,:) = 0.
2802  puthl(:,:) = pthl(:,:)
2803  purw(:,:) = prw(:,:)
2804  pupr(:,:) = 0.
2805  purc(:,:) = 0.
2806  puri(:,:) = 0.
2807  purr(:,:) = 0.
2808  purs(:,:) = 0.
2809 END WHERE
2810 !
2811 END SUBROUTINE convect_updraft
2812 ! ######spl
2813  SUBROUTINE convect_condens( KLON, &
2814  kice, ppres, pthl, prw, prco, prio, pz, owork1, &
2815  pt, pew, prc, pri, plv, pls, pcph )
2816 ! ###########################################################################
2817 !
2818 !!**** Compute temperature cloud and ice water content from enthalpy and r_w
2819 !!
2820 !!
2821 !! PURPOSE
2822 !! -------
2823 !! The purpose of this routine is to determine cloud condensate
2824 !! and to return values for L_v, L_s and C_ph
2825 !!
2826 !!
2827 !!** METHOD
2828 !! ------
2829 !! Condensate is extracted iteratively
2830 !!
2831 !!
2832 !! EXTERNAL
2833 !! --------
2834 !! None
2835 !!
2836 !!
2837 !! IMPLICIT ARGUMENTS
2838 !! ------------------
2839 !!
2840 !! Module MODD_CST
2841 !! XG ! gravity constant
2842 !! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
2843 !! XALPI, XBETAI, XGAMI ! constants for ice saturation pressure
2844 !! XP00 ! reference pressure
2845 !! XRD, XRV ! gaz constants for dry air and water vapor
2846 !! XCPD, XCPV ! specific heat for dry air and water vapor
2847 !! XCL, XCI ! specific heat for liquid water and ice
2848 !! XTT ! triple point temperature
2849 !! XLVTT, XLSTT ! vaporization, sublimation heat constant
2850 !!
2851 !! IMPLICIT ARGUMENTS
2852 !! ------------------
2853 !! Module MODD_CONVPAR
2854 !! XTFRZ1 ! begin of freezing interval
2855 !! XTFRZ2 ! end of freezing interval
2856 !!
2857 !! REFERENCE
2858 !! ---------
2859 !!
2860 !! Book1,2 of documentation ( routine CONVECT_CONDENS)
2861 !!
2862 !! AUTHOR
2863 !! ------
2864 !! P. BECHTOLD * Laboratoire d'Aerologie *
2865 !!
2866 !! MODIFICATIONS
2867 !! -------------
2868 !! Original 07/11/95
2869 !! Last modified 04/10/97
2870 !-------------------------------------------------------------------------------
2871 !
2872 !* 0. DECLARATIONS
2873 ! ------------
2874 !
2875 USE modd_cst
2876 USE modd_convpar
2877 !
2878 !
2879 IMPLICIT NONE
2880 !
2881 !* 0.1 Declarations of dummy arguments :
2882 !
2883 INTEGER, INTENT(IN) :: KLON ! horizontal loop index
2884 INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
2885  ! 0 = no ice )
2886 REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
2887 REAL, DIMENSION(KLON), INTENT(IN) :: PTHL ! enthalpy (J/kg)
2888 REAL, DIMENSION(KLON), INTENT(IN) :: PRW ! total water mixing ratio
2889 REAL, DIMENSION(KLON), INTENT(IN) :: PRCO ! cloud water estimate (kg/kg)
2890 REAL, DIMENSION(KLON), INTENT(IN) :: PRIO ! cloud ice estimate (kg/kg)
2891 REAL, DIMENSION(KLON), INTENT(IN) :: PZ ! level height (m)
2892 LOGICAL, DIMENSION(KLON),INTENT(IN) :: OWORK1 ! logical mask
2893 !
2894 !
2895 REAL, DIMENSION(KLON), INTENT(OUT):: PT ! temperature
2896 REAL, DIMENSION(KLON), INTENT(OUT):: PRC ! cloud water mixing ratio(kg/kg)
2897 REAL, DIMENSION(KLON), INTENT(OUT):: PRI ! cloud ice mixing ratio (kg/kg)
2898 REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
2899 REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
2900 REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
2901 REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! water saturation mixing ratio
2902 !
2903 !* 0.2 Declarations of local variables KLON
2904 !
2905 INTEGER :: JITER ! iteration index
2906 REAL :: ZEPS, ZEPSA ! R_d / R_v, 1 / ZEPS
2907 REAL :: ZCVOCD ! XCPV / XCPD
2908 REAL :: ZRDOCP ! R_d / C_pd
2909 !
2910 REAL, DIMENSION(KLON) :: ZEI ! ice saturation mixing ratio
2911 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZT ! work arrays
2912 !
2913 !
2914 !-------------------------------------------------------------------------------
2915 !
2916 !* 1. Initialize temperature and Exner function
2917 ! -----------------------------------------
2918 !
2919 zrdocp = xrd / xcpd
2920 zeps = xrd / xrv
2921 zepsa = 1. / zeps
2922 zcvocd = xcpv / xcpd
2923 !
2924 !
2925  ! Make a first temperature estimate, based e.g. on values of
2926  ! r_c and r_i at lower level
2927 !
2928  !! Note that the definition of ZCPH is not the same as used in
2929  !! routine CONVECT_SATMIXRATIO
2930  pcph(:) = xcpd + xcpv * prw(:)
2931  zwork1(:) = ( 1. + prw(:) ) * xg * pz(:)
2932  pt(:) = ( pthl(:) + prco(:) * xlvtt + prio(:) * xlstt - zwork1(:) ) &
2933  / pcph(:)
2934  pt(:) = max(180., min( 330., pt(:) ) ) ! set overflow bounds in
2935  ! case that PTHL=0
2936 !
2937 !
2938 !* 2. Enter the iteration loop
2939 ! ------------------------
2940 !
2941 DO jiter = 1,6
2942  pew(:) = exp( xalpw - xbetaw / pt(:) - xgamw * log( pt(:) ) )
2943  zei(:) = exp( xalpi - xbetai / pt(:) - xgami * log( pt(:) ) )
2944  pew(:) = zeps * pew(:) / ( ppres(:) - pew(:) )
2945  zei(:) = zeps * zei(:) / ( ppres(:) - zei(:) )
2946 !
2947  plv(:) = xlvtt + ( xcpv - xcl ) * ( pt(:) - xtt ) ! compute L_v
2948  pls(:) = xlstt + ( xcpv - xci ) * ( pt(:) - xtt ) ! compute L_i
2949 !
2950  zwork2(:) = ( pt(:) - xtfrz2 ) / ( xtfrz1 - xtfrz2 ) ! freezing interval
2951  zwork2(:) = max( 0., min(1., zwork2(:) ) )
2952  zwork2(:) = zwork2(:) * zwork2(:)
2953  IF ( kice == 0 ) zwork2(:) = 1.
2954  zwork3(:) = ( 1. - zwork2(:) ) * zei(:) + zwork2(:) * pew(:)
2955  prc(:) = max( 0., zwork2(:) * ( prw(:) - zwork3(:) ) )
2956  pri(:) = max( 0., ( 1. - zwork2(:) ) * ( prw(:) - zwork3(:) ) )
2957  zt(:) = ( pthl(:) + prc(:) * plv(:) + pri(:) * pls(:) - zwork1(:) ) &
2958  / pcph(:)
2959  pt(:) = pt(:) + ( zt(:) - pt(:) ) * 0.4 ! force convergence
2960  pt(:) = max( 175., min( 330., pt(:) ) )
2961 END DO
2962 !
2963 !
2964 END SUBROUTINE convect_condens
2965 ! ######spl
2966  SUBROUTINE convect_satmixratio( KLON, &
2967  ppres, pt, pew, plv, pls, pcph )
2968 ! ################################################################
2969 !
2970 !!**** Compute vapor saturation mixing ratio over liquid water
2971 !!
2972 !!
2973 !! PDRPOSE
2974 !! -------
2975 !! The purpose of this routine is to determine saturation mixing ratio
2976 !! and to return values for L_v L_s and C_ph
2977 !!
2978 !!
2979 !!** METHOD
2980 !! ------
2981 !!
2982 !!
2983 !! EXTERNAL
2984 !! --------
2985 !! None
2986 !!
2987 !!
2988 !! IMPLICIT ARGUMENTS
2989 !! ------------------
2990 !! Module MODD_CST
2991 !! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
2992 !! XRD, XRV ! gaz constants for dry air and water vapor
2993 !! XCPD, XCPV ! specific heat for dry air and water vapor
2994 !! XCL, XCI ! specific heat for liquid water and ice
2995 !! XTT ! triple point temperature
2996 !! XLVTT, XLSTT ! vaporization, sublimation heat constant
2997 !!
2998 !!
2999 !! REFERENCE
3000 !! ---------
3001 !!
3002 !! Book1,2 of documentation ( routine CONVECT_SATMIXRATIO)
3003 !!
3004 !! AUTHOR
3005 !! ------
3006 !! P. BECHTOLD * Laboratoire d'Aerologie *
3007 !!
3008 !! MODIFICATIONS
3009 !! -------------
3010 !! Original 07/11/95
3011 !! Last modified 04/10/97
3012 !------------------------- ------------------------------------------------------
3013 !
3014 !* 0. DECLARATIONS
3015 ! ------------
3016 !
3017 USE modd_cst
3018 !
3019 !
3020 IMPLICIT NONE
3021 !
3022 !* 0.1 Declarations of dummy arguments :
3023 !
3024 !
3025 INTEGER, INTENT(IN) :: KLON ! horizontal loop index
3026 REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
3027 REAL, DIMENSION(KLON), INTENT(IN) :: PT ! temperature
3028 !
3029 REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! vapor saturation mixing ratio
3030 REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
3031 REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
3032 REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
3033 !
3034 !* 0.2 Declarations of local variables :
3035 !
3036 REAL, DIMENSION(KLON) :: ZT ! temperature
3037 REAL :: ZEPS ! R_d / R_v
3038 !
3039 !
3040 !-------------------------------------------------------------------------------
3041 !
3042  zeps = xrd / xrv
3043 !
3044  zt(:) = min( 400., max( pt(:), 10. ) ) ! overflow bound
3045  pew(:) = exp( xalpw - xbetaw / zt(:) - xgamw * log( zt(:) ) )
3046  pew(:) = zeps * pew(:) / ( ppres(:) - pew(:) )
3047 !
3048  plv(:) = xlvtt + ( xcpv - xcl ) * ( zt(:) - xtt ) ! compute L_v
3049  pls(:) = xlstt + ( xcpv - xci ) * ( zt(:) - xtt ) ! compute L_i
3050 !
3051  pcph(:) = xcpd + xcpv * pew(:) ! compute C_ph
3052 !
3053 END SUBROUTINE convect_satmixratio
3054 ! ######spl
3055  SUBROUTINE convect_mixing_funct( KLON, &
3056  pmixc, kmf, per, pdr )
3057 ! #######################################################
3058 !
3059 !!**** Determine the area under the distribution function
3060 !! KMF = 1 : gaussian KMF = 2 : triangular distribution function
3061 !!
3062 !! PURPOSE
3063 !! -------
3064 !! The purpose of this routine is to determine the entrainment and
3065 !! detrainment rate by evaluating the are under the distribution
3066 !! function. The integration interval is limited by the critical
3067 !! mixed fraction PMIXC
3068 !!
3069 !!
3070 !!
3071 !!** METHOD
3072 !! ------
3073 !! Use handbook of mathemat. functions by Abramowitz and Stegun, 1968
3074 !!
3075 !!
3076 !!
3077 !! EXTERNAL
3078 !! --------
3079 !! None
3080 !!
3081 !!
3082 !! IMPLICIT ARGUMENTS
3083 !! ------------------
3084 !! None
3085 !!
3086 !!
3087 !! REFERENCE
3088 !! ---------
3089 !!
3090 !! Book2 of documentation ( routine MIXING_FUNCT)
3091 !! Abramovitz and Stegun (1968), handbook of math. functions
3092 !!
3093 !! AUTHOR
3094 !! ------
3095 !! P. BECHTOLD * Laboratoire d'Aerologie *
3096 !!
3097 !! MODIFICATIONS
3098 !! -------------
3099 !! Original 07/11/95
3100 !! Last modified 04/10/97
3101 !-------------------------------------------------------------------------------
3102 !
3103 !* 0. DECLARATIONS
3104 ! ------------
3105 !
3106 !
3107 IMPLICIT NONE
3108 !
3109 !* 0.1 Declarations of dummy arguments :
3110 !
3111 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
3112 INTEGER, INTENT(IN) :: KMF ! switch for dist. function
3113 REAL, DIMENSION(KLON), INTENT(IN) :: PMIXC ! critical mixed fraction
3114 !
3115 REAL, DIMENSION(KLON), INTENT(OUT):: PER ! normalized entrainment rate
3116 REAL, DIMENSION(KLON), INTENT(OUT):: PDR ! normalized detrainment rate
3117 !
3118 !* 0.2 Declarations of local variables :
3119 !
3120 REAL :: ZSIGMA = 0.166666667 ! standard deviation
3121 REAL :: ZFE = 4.931813949 ! integral normalization
3122 REAL :: ZSQRTP = 2.506628, zp = 0.33267 ! constants
3123 REAL :: ZA1 = 0.4361836, za2 =-0.1201676 ! constants
3124 REAL :: ZA3 = 0.9372980, zt1 = 0.500498 ! constants
3125 REAL :: ZE45 = 0.01111 ! constant
3126 !
3127 REAL, DIMENSION(KLON) :: ZX, ZY, ZW1, ZW2 ! work variables
3128 REAL :: ZW11
3129 !
3130 !
3131 !-------------------------------------------------------------------------------
3132 !
3133 ! 1. Use gaussian function for KMF=1
3134 ! -------------------------------
3135 !
3136 IF( kmf == 1 ) THEN
3137  ! ZX(:) = ( PMIXC(:) - 0.5 ) / ZSIGMA
3138  zx(:) = 6. * pmixc(:) - 3.
3139  zw1(:) = 1. / ( 1.+ zp * abs( zx(:) ) )
3140  zy(:) = exp( -0.5 * zx(:) * zx(:) )
3141  zw2(:) = za1 * zw1(:) + za2 * zw1(:) * zw1(:) + &
3142  za3 * zw1(:) * zw1(:) * zw1(:)
3143  zw11 = za1 * zt1 + za2 * zt1 * zt1 + za3 * zt1 * zt1 * zt1
3144 ENDIF
3145 !
3146 WHERE ( kmf == 1 .AND. zx(:) >= 0. )
3147  per(:) = zsigma * ( 0.5 * ( zsqrtp - ze45 * zw11 &
3148  - zy(:) * zw2(:) ) + zsigma * ( ze45 - zy(:) ) ) &
3149  - 0.5 * ze45 * pmixc(:) * pmixc(:)
3150  pdr(:) = zsigma*( 0.5 * ( zy(:) * zw2(:) - ze45 * zw11 ) &
3151  + zsigma * ( ze45 - zy(:) ) ) &
3152  - ze45 * ( 0.5 + 0.5 * pmixc(:) * pmixc(:) - pmixc(:) )
3153 END WHERE
3154 WHERE ( kmf == 1 .AND. zx(:) < 0. )
3155  per(:) = zsigma*( 0.5 * ( zy(:) * zw2(:) - ze45 * zw11 ) &
3156  + zsigma * ( ze45 - zy(:) ) ) &
3157  - 0.5 * ze45 * pmixc(:) * pmixc(:)
3158  pdr(:) = zsigma * ( 0.5 * ( zsqrtp - ze45 * zw11 - zy(:) &
3159  * zw2(:) ) + zsigma * ( ze45 - zy(:) ) ) &
3160  - ze45 * ( 0.5 + 0.5 * pmixc(:) * pmixc(:) - pmixc(:) )
3161 END WHERE
3162 !
3163  per(:) = per(:) * zfe
3164  pdr(:) = pdr(:) * zfe
3165 !
3166 !
3167 ! 2. Use triangular function KMF=2
3168 ! -------------------------------
3169 !
3170 ! not yet released
3171 !
3172 !
3173 END SUBROUTINE convect_mixing_funct
3174 ! ######spl
3175  SUBROUTINE convect_tstep_pref( KLON, KLEV, &
3176  pu, pv, ppres, pz, pdxdy, klcl, kctl, &
3177  ptimea, ppref )
3178 ! ######################################################################
3179 !
3180 !!**** Routine to compute convective advection time step and precipitation
3181 !! efficiency
3182 !!
3183 !!
3184 !! PURPOSE
3185 !! -------
3186 !! The purpose of this routine is to determine the convective
3187 !! advection time step PTIMEC as a function of the mean ambient
3188 !! wind as well as the precipitation efficiency as a function
3189 !! of wind shear and cloud base height.
3190 !!
3191 !!
3192 !!** METHOD
3193 !! ------
3194 !!
3195 !!
3196 !! EXTERNAL
3197 !! --------
3198 !! None
3199 !!
3200 !!
3201 !! IMPLICIT ARGUMENTS
3202 !! ------------------
3203 !!
3204 !! Module MODD_CONVPAREXT
3205 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
3206 !!
3207 !! REFERENCE
3208 !! ---------
3209 !!
3210 !! Book1,2 of documentation
3211 !! Fritsch and Chappell, 1980, J. Atmos. Sci.
3212 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
3213 !!
3214 !! AUTHOR
3215 !! ------
3216 !! P. BECHTOLD * Laboratoire d'Aerologie *
3217 !!
3218 !! MODIFICATIONS
3219 !! -------------
3220 !! Original 07/11/95
3221 !! Last modified 04/10/97
3222 !-------------------------------------------------------------------------------
3223 !
3224 !* 0. DECLARATIONS
3225 ! ------------
3226 !
3227 USE modd_convparext
3228 !
3229 !
3230 IMPLICIT NONE
3231 !
3232 !* 0.1 Declarations of dummy arguments :
3233 !
3234 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
3235 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
3236 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
3237 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU ! grid scale horiz. wind u
3238 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV ! grid scale horiz. wind v
3239 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
3240 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
3241 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! lifting condensation level index
3242 INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! cloud top level index
3243 !
3244 REAL, DIMENSION(KLON), INTENT(OUT):: PTIMEA ! advective time period
3245 REAL, DIMENSION(KLON), INTENT(OUT):: PPREF ! precipitation efficiency
3246 !
3247 !
3248 !* 0.2 Declarations of local variables KLON
3249 !
3250 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
3251 INTEGER :: JI ! horizontal loop index
3252 INTEGER :: JK, JKLC, JKP5, JKCT ! vertical loop index
3253 !
3254 INTEGER, DIMENSION(KLON) :: IP500 ! index of 500 hPa levels
3255 REAL, DIMENSION(KLON) :: ZCBH ! cloud base height
3256 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
3257 !
3258 !
3259 !-------------------------------------------------------------------------------
3260 !
3261 ! 0.3 Set loop bounds
3262 ! ---------------
3263 !
3264 iie = klon
3265 ikb = 1 + jcvexb
3266 ike = klev - jcvext
3267 !
3268 !
3269 !* 1. Determine vertical index for 500 hPa levels
3270 ! ------------------------------------------
3271 !
3272 !
3273 ip500(:) = ikb
3274 DO jk = ikb, ike
3275  WHERE ( ppres(:,jk) >= 500.e2 ) ip500(:) = jk
3276 END DO
3277 !
3278 !
3279 !* 2. Compute convective time step
3280 ! ----------------------------
3281 !
3282  ! compute wind speed at LCL, 500 hPa, CTL
3283 
3284 DO ji = 1, iie
3285  jklc = klcl(ji)
3286  jkp5 = ip500(ji)
3287  jkct = kctl(ji)
3288  zwork1(ji) = sqrt( pu(ji,jklc) * pu(ji,jklc) + &
3289  pv(ji,jklc) * pv(ji,jklc) )
3290  zwork2(ji) = sqrt( pu(ji,jkp5) * pu(ji,jkp5) + &
3291  pv(ji,jkp5) * pv(ji,jkp5) )
3292  zwork3(ji) = sqrt( pu(ji,jkct) * pu(ji,jkct) + &
3293  pv(ji,jkct) * pv(ji,jkct) )
3294 END DO
3295 !
3296 zwork2(:) = max( 0.1, 0.5 * ( zwork1(:) + zwork2(:) ) )
3297 !
3298 ptimea(:) = sqrt( pdxdy(:) ) / zwork2(:)
3299 !
3300 !
3301 !* 3. Compute precipitation efficiency
3302 ! -----------------------------------
3303 !
3304 !* 3.1 Precipitation efficiency as a function of wind shear
3305 ! ----------------------------------------------------
3306 !
3307 zwork2(:) = sign( 1., zwork3(:) - zwork1(:) )
3308 DO ji = 1, iie
3309  jklc = klcl(ji)
3310  jkct = kctl(ji)
3311  zwork1(ji) = ( pu(ji,jkct) - pu(ji,jklc) ) * &
3312  ( pu(ji,jkct) - pu(ji,jklc) ) + &
3313  ( pv(ji,jkct) - pv(ji,jklc) ) * &
3314  ( pv(ji,jkct) - pv(ji,jklc) )
3315  zwork1(ji) = 1.e3 * zwork2(ji) * sqrt( zwork1(ji) ) / &
3316  max( 1.e-2, pz(ji,jkct) - pz(ji,jklc) )
3317 END DO
3318 !
3319 ppref(:) = 1.591 + zwork1(:) * ( -.639 + zwork1(:) * ( &
3320  9.53e-2 - zwork1(:) * 4.96e-3 ) )
3321 ppref(:) = max( .4, min( ppref(:), .92 ) )
3322 !
3323 !* 3.2 Precipitation efficiency as a function of cloud base height
3324 ! ----------------------------------------------------------
3325 !
3326 DO ji = 1, iie
3327  jklc = klcl(ji)
3328  zcbh(ji) = max( 3., ( pz(ji,jklc) - pz(ji,ikb) ) * 3.281e-3 )
3329 END DO
3330 zwork1(:) = .9673 + zcbh(:) * ( -.7003 + zcbh(:) * ( .1622 + &
3331  zcbh(:) * ( -1.2570e-2 + zcbh(:) * ( 4.2772e-4 - &
3332  zcbh(:) * 5.44e-6 ) ) ) )
3333 zwork1(:) = max( .4, min( .92, 1./ ( 1. + zwork1(:) ) ) )
3334 !
3335 !* 3.3 Mean precipitation efficiency is used to compute rainfall
3336 ! ----------------------------------------------------------
3337 !
3338 ppref(:) = 0.5 * ( ppref(:) + zwork1(:) )
3339 !
3340 !
3341 END SUBROUTINE convect_tstep_pref
3342 ! ######spl
3343  SUBROUTINE convect_downdraft( KLON, KLEV, &
3344  kice, ppres, pdpres, pz, pth, pthes, &
3345  prw, prc, pri, &
3346  ppref, klcl, kctl, ketl, &
3347  puthl, purw, purc, puri, &
3348  pdmf, pder, pddr, pdthl, pdrw, &
3349  pmixf, pdtevr, klfs, kdbl, kml, &
3350  pdtevrf )
3351 ! ########################################################################
3352 !
3353 !!**** Compute downdraft properties from LFS to DBL.
3354 !!
3355 !!
3356 !! PDRPOSE
3357 !! -------
3358 !! The purpose of this routine is to determine downdraft properties
3359 !! ( mass flux, thermodynamics )
3360 !!
3361 !!
3362 !!** METHOD
3363 !! ------
3364 !! Computations are done at every model level starting from top.
3365 !! The use of masks allows to optimise the inner loops (horizontal loops).
3366 !!
3367 !!
3368 !!
3369 !! EXTERNAL
3370 !! --------
3371 !! Routine CONVECT_SATMIXRATIO
3372 !!
3373 !!
3374 !! IMPLICIT ARGUMENTS
3375 !! ------------------
3376 !!
3377 !! Module MODD_CST
3378 !! XG ! gravity constant
3379 !! XPI ! Pi
3380 !! XP00 ! reference pressure
3381 !! XRD, XRV ! gaz constants for dry air and water vapor
3382 !! XCPD ! Cpd (dry air)
3383 !! XCPV, XCL, XCI ! Cp of water vapor, liquid water and ice
3384 !! XTT ! triple point temperature
3385 !! XLVTT, XLSTT ! vaporisation/sublimation heat at XTT
3386 !!
3387 !! Module MODD_CONVPAR
3388 !! XCRAD ! cloud radius
3389 !! XZPBL ! thickness of downdraft detrainment layer
3390 !! XENTR ! entrainment constant in pressure coordinates
3391 !! XRHDBC ! relative humidity in downdraft below cloud
3392 !!
3393 !! Module MODD_CONVPAREXT
3394 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
3395 !!
3396 !! REFERENCE
3397 !! ---------
3398 !!
3399 !! Book1,2 of documentation ( routine CONVECT_DOWNDRAFT)
3400 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
3401 !!
3402 !! AUTHOR
3403 !! ------
3404 !! P. BECHTOLD * Laboratoire d'Aerologie *
3405 !!
3406 !! MODIFICATIONS
3407 !! -------------
3408 !! Original 07/11/95
3409 !! Last modified 04/10/97
3410 !-------------------------------------------------------------------------------
3411 !
3412 !* 0. DECLARATIONS
3413 ! ------------
3414 !
3415 USE modd_cst
3416 USE modd_convpar
3417 USE modd_convparext
3418 !
3419 !
3420 IMPLICIT NONE
3421 !
3422 !* 0.1 Declarations of dummy arguments :
3423 !
3424 !
3425 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
3426 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
3427 INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
3428  ! 0 = no ice )
3429 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! grid scale theta
3430 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
3431 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
3432  ! mixing ratio
3433 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRC ! grid scale r_c (cloud water)
3434 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRI ! grid scale r_i (cloud ice)
3435 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
3436 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
3437  ! bottom and top of layer (Pa)
3438 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! level height (m)
3439 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
3440 INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
3441 INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of
3442  ! equilibrium (zero buoyancy) level
3443 INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! " vert. index of melting level
3444 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
3445 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
3446 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft r_c (kg/kg)
3447 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft r_i (kg/kg)
3448 REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
3449 !
3450 !
3451 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDMF ! downdraft mass flux (kg/s)
3452 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDER ! downdraft entrainment (kg/s)
3453 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDDR ! downdraft detrainment (kg/s)
3454 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTHL ! downdraft enthalpy (J/kg)
3455 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDRW ! downdraft total water (kg/kg)
3456 REAL, DIMENSION(KLON), INTENT(OUT):: PMIXF ! mixed fraction at LFS
3457 REAL, DIMENSION(KLON), INTENT(OUT):: PDTEVR ! total downdraft evaporation
3458  ! rate at LFS (kg/s)
3459 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTEVRF! downdraft evaporation rate
3460 INTEGER, DIMENSION(KLON), INTENT(OUT):: KLFS ! contains vert. index of LFS
3461 INTEGER, DIMENSION(KLON), INTENT(OUT):: KDBL ! contains vert. index of DBL
3462 !
3463 !* 0.2 Declarations of local variables :
3464 !
3465 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
3466 INTEGER :: JK, JKP, JKM, JKT ! vertical loop index
3467 INTEGER :: JI, JL ! horizontal loop index
3468 INTEGER :: JITER ! iteration loop index
3469 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
3470 REAL :: ZEPS ! R_d / R_v
3471 REAL :: ZEPSA, ZCVOCD ! R_v / R_d, C_pv / C_pd
3472 !
3473 INTEGER, DIMENSION(KLON) :: IDDT ! top level of detrainm. layer
3474 REAL, DIMENSION(KLON) :: ZTHE ! environm. theta_e (K)
3475 REAL, DIMENSION(KLON) :: ZDT, ZDTP ! downdraft temperature (K)
3476 REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
3477 REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
3478 REAL, DIMENSION(KLON) :: ZDDT ! thickness (hPa) of detrainm. layer
3479 REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
3480 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, &
3481  ZWORK5 ! work arrays
3482 LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
3483 !
3484 !
3485 !-------------------------------------------------------------------------------
3486 !
3487 ! 0.3 Set loop bounds
3488 ! ---------------
3489 !
3490 iie = klon
3491 ikb = 1 + jcvexb
3492 ike = klev - jcvext
3493 !
3494 !
3495 !* 1. Initialize downdraft properties
3496 ! -------------------------------
3497 !
3498 zcpord = xcpd / xrd
3499 zrdocp = xrd / xcpd
3500 zeps = xrd / xrv
3501 zepsa = xrv / xrd
3502 zcvocd = xcpv / xcpd
3503 pdmf(:,:) = 0.
3504 pder(:,:) = 0.
3505 pddr(:,:) = 0.
3506 pdrw(:,:) = 0.
3507 pdthl(:,:) = 0.
3508 pdtevr(:) = 0.
3509 pmixf(:) = 0.
3510 zthe(:) = 0.
3511 zddt(:) = pdpres(:,ikb+2)
3512 kdbl(:) = ikb + 1
3513 klfs(:) = ikb + 1
3514 iddt(:) = kdbl(:) + 1
3515 !
3516 !
3517 !* 2. Determine the LFS by looking for minimum of environmental
3518 ! saturated theta_e
3519 ! ----------------------------------------------------------
3520 !
3521 zwork1(:) = 900. ! starting value for search of minimum envir. theta_e
3522 DO jk = minval( klcl(:) ) + 2, maxval( ketl(:) )
3523  DO ji = 1, iie
3524  gwork1(ji) = jk >= klcl(ji) + 2 .AND. jk < ketl(ji)
3525  IF ( gwork1(ji) .AND. zwork1(ji) > pthes(ji,jk) ) THEN
3526  klfs(ji) = jk
3527  zwork1(ji) = min( zwork1(ji), pthes(ji,jk) )
3528  END IF
3529  END DO
3530 END DO
3531 !
3532 !
3533 !* 3. Determine the mixed fraction using environmental and updraft
3534 ! values of theta_e at LFS
3535 ! ---------------------------------------------------------
3536 !
3537 DO ji = 1, iie
3538  jk = klfs(ji)
3539  zpi(ji) = ( xp00 / ppres(ji,jk) ) ** zrdocp
3540  ! compute updraft theta_e
3541  zwork3(ji) = purw(ji,jk) - purc(ji,jk) - puri(ji,jk)
3542  zdt(ji) = pth(ji,jk) / zpi(ji)
3543  zlv(ji) = xlvtt + ( xcpv - xcl ) * ( zdt(ji) - xtt )
3544  zls(ji) = xlstt + ( xcpv - xci ) * ( zdt(ji) - xtt )
3545  zcph(ji) = xcpd + xcpv * purw(ji,jk)
3546  zdt(ji) = ( puthl(ji,jk) - ( 1. + purw(ji,jk) ) * xg * pz(ji,jk) &
3547  + zlv(ji) * purc(ji,jk) + zls(ji) * puri(ji,jk) ) / zcph(ji)
3548  zwork1(ji) = zdt(ji) * zpi(ji) ** ( 1. - 0.28 * zwork3(ji) ) &
3549  * exp( ( 3374.6525 / zdt(ji) - 2.5403 ) &
3550  * zwork3(ji) * ( 1. + 0.81 * zwork3(ji) ) )
3551  ! compute environmental theta_e
3552  zdt(ji) = pth(ji,jk) / zpi(ji)
3553  zlv(ji) = xlvtt + ( xcpv - xcl ) * ( zdt(ji) - xtt )
3554  zls(ji) = xlstt + ( xcpv - xci ) * ( zdt(ji) - xtt )
3555  zwork3(ji) = prw(ji,jk) - prc(ji,jk) - pri(ji,jk)
3556  zcph(ji) = xcpd + xcpv * prw(ji,jk)
3557  zwork2(ji) = zdt(ji) * zpi(ji) ** ( 1. - 0.28 * zwork3(ji) ) &
3558  * exp( ( 3374.6525 / zdt(ji) - 2.5403 ) &
3559  * zwork3(ji) * ( 1. + 0.81 * zwork3(ji) ) )
3560  ! compute mixed fraction
3561  pmixf(ji) = max( 0., ( zwork1(ji) - pthes(ji,jk) ) ) &
3562  / ( zwork1(ji) - zwork2(ji) + 1.e-10 )
3563  pmixf(ji) = max(0., min( 1., pmixf(ji) ) )
3564  zwork4(ji) = ppres(ji,jk)
3565 END DO
3566 !
3567 !
3568 !* 4. Estimate the effect of melting on the downdraft
3569 ! ---------------------------------------------
3570 !
3571 zwork1(:) = 0.
3572  ! use total solid precipitation
3573 !DO JK = IKB + 1, IKE
3574 ! ZWORK1(:) = ZWORK1(:) + PURS(:,JK) ! total snow/hail content
3575 !END DO
3576 !
3577 DO ji = 1, iie
3578  jk = klcl(ji)
3579  jkp = kctl(ji)
3580  zwork1(ji) = 0.5 * ( purw(ji,jk) - purw(ji,jkp) )
3581 END DO
3582 !
3583  ! temperature perturbation due to melting at LFS
3584 zwork3(:) = 0.
3585 WHERE( kml(:) > ikb + 2 )
3586  zwork3(:) = zwork1(:) * ( zls(:) - zlv(:) ) / zcph(:)
3587  zdt(:) = zdt(:) - zwork3(:) * REAL(kice)
3588 END WHERE
3589 !
3590 !
3591 !* 5. Initialize humidity at LFS as a saturated mixture of
3592 ! updraft and environmental air
3593 ! -----------------------------------------------------
3594 !
3595 DO ji = 1, iie
3596  jk = klfs(ji)
3597  pdrw(ji,jk) = pmixf(ji) * prw(ji,jk) + ( 1. - pmixf(ji) ) * purw(ji,jk)
3598  zwork2(ji) = pdrw(ji,jk) - ( 1. - pmixf(ji) ) &
3599  * ( purc(ji,jk) + puri(ji,jk) )
3600 END DO
3601 !
3602 !
3603 !* 6.1 Determine the DBL by looking for level where the envir.
3604 ! theta_es at the LFS corrected by melting effects becomes
3605 ! larger than envir. value
3606 ! ---------------------------------------------------------
3607 !
3608  ! compute satur. mixing ratio for melting corrected temperature
3609 CALL convect_satmixratio( klon, zwork4, zdt, zwork3, zlv, zls, zcph )
3610 !
3611  ! compute envir. saturated theta_e for melting corrected temperature
3612  zwork1(:) = min( zwork2(:), zwork3(:) )
3613  zwork3(:) = zwork3(:) * zwork4(:) / ( zwork3(:) + zeps ) ! sat. pressure
3614  zwork3(:) = log( zwork3(:) / 613.3 )
3615  ! dewp point temperature
3616  zwork3(:) = ( 4780.8 - 32.19 * zwork3(:) ) / ( 17.502 - zwork3(:) )
3617  ! adiabatic saturation temperature
3618  zwork3(:) = zwork3(:) - ( .212 + 1.571e-3 * ( zwork3(:) - xtt ) &
3619  - 4.36e-4 * ( zdt(:) - xtt ) ) * ( zdt(:) - zwork3(:) )
3620  zwork4(:) = sign(0.5, zwork2(:) - zwork3(:) )
3621  zdt(:) = zdt(:) * ( .5 + zwork4(:) ) + ( .5 - zwork4(:) ) * zwork3(:)
3622  zwork2(:) = zdt(:) * zpi(:) ** ( 1. - 0.28 * zwork2(:) ) &
3623  * exp( ( 3374.6525 / zdt(:) - 2.5403 ) &
3624  * zwork1(:) * ( 1. + 0.81 * zwork1(:) ) )
3625 !
3626 gwork1(:) = .true.
3627 jkm = maxval( klfs(:) )
3628 DO jk = jkm - 1, ikb + 1, -1
3629  DO ji = 1, iie
3630  IF ( jk < klfs(ji) .AND. zwork2(ji) > pthes(ji,jk) .AND. gwork1(ji) ) THEN
3631  kdbl(ji) = jk
3632  gwork1(ji) = .false.
3633  END IF
3634  END DO
3635 END DO
3636 !
3637 !
3638 !* 7. Define mass flux and entr/detr. rates at LFS
3639 ! -------------------------------------------
3640 !
3641 DO ji = 1, iie
3642  jk = klfs(ji)
3643  zwork1(ji) = ppres(ji,jk) / &
3644  ( xrd * zdt(ji) * ( 1. + zeps * zwork1(ji) ) ) ! density
3645  pdmf(ji,jk) = - ( 1. - ppref(ji) ) * zwork1(ji) * xpi * xcrad * xcrad
3646  pdthl(ji,jk)= zwork2(ji) ! theta_l is here actually theta_e
3647  zwork2(ji) = pdmf(ji,jk)
3648  pddr(ji,jk) = 0.
3649  pder(ji,jk) = - pmixf(ji) * pdmf(ji,jk)
3650 END DO
3651 !
3652 !
3653 ! 7.1 Downdraft detrainment is assumed to occur in a layer
3654 ! of 60 hPa, determine top level IDDT of this layer
3655 ! ---------------------------------------------------------
3656 !
3657 zwork1(:) = 0.
3658 DO jk = ikb + 2, jkm
3659  zwork1(:) = zwork1(:) + pdpres(:,jk)
3660  WHERE ( jk > kdbl(:) .AND. zwork1(:) <= xzpbl )
3661  zddt(:) = zwork1(:)
3662  iddt(:) = jk
3663  END WHERE
3664 END DO
3665 !
3666 !
3667 !* 8. Enter loop for downdraft computations. Make a first guess
3668 ! of initial downdraft mass flux.
3669 ! In the downdraft computations we use theta_es instead of
3670 ! enthalpy as it allows to better take into account evaporation
3671 ! effects. As the downdraft detrainment rate is zero apart
3672 ! from the detrainment layer, we just compute enthalpy
3673 ! downdraft from theta_es in this layer.
3674 ! ----------------------------------------------------------
3675 !
3676 !
3677 zwork5(:) = 0.
3678 !
3679 DO jk = jkm - 1, ikb + 1, -1
3680  jkp = jk + 1
3681  DO ji = 1, iie
3682  IF ( jk < klfs(ji) .AND. jk >= iddt(ji) ) THEN
3683  pder(ji,jk) = - zwork2(ji) * xentr * pdpres(ji,jkp) / xcrad
3684  ! DER and DPRES are positive
3685  pdmf(ji,jk) = pdmf(ji,jkp) - pder(ji,jk)
3686  zpi(ji) = ( xp00 / ppres(ji,jk) ) ** zrdocp
3687  zdt(ji) = pth(ji,jk) / zpi(ji)
3688  zwork1(ji) = prw(ji,jk) - prc(ji,jk) - pri(ji,jk)
3689  zthe(ji) = zdt(ji) * zpi(ji) ** ( 1. - 0.28 * zwork1(ji) ) &
3690  * exp( ( 3374.6525 / zdt(ji) - 2.5403 ) &
3691  * zwork1(ji) * ( 1. + 0.81 * zwork1(ji) ) )
3692  ! PDTHL is here theta_es, later on in this routine this table is
3693  ! reskipped to enthalpy
3694  pdthl(ji,jk) = ( pdthl(ji,jkp) * pdmf(ji,jkp) - zthe(ji) * pder(ji,jk) &
3695  ) / ( pdmf(ji,jk) - 1.e-7 )
3696  pdrw(ji,jk) = ( pdrw(ji,jkp) * pdmf(ji,jkp) - prw(ji,jk) * pder(ji,jk) &
3697  ) / ( pdmf(ji,jk) - 1.e-7 )
3698  END IF
3699  IF ( jk < iddt(ji) .AND. jk >= kdbl(ji) ) THEN
3700  jl = iddt(ji)
3701  pddr(ji,jk) = - pdmf(ji,jl) * pdpres(ji,jkp) / zddt(ji)
3702  pdmf(ji,jk) = pdmf(ji,jkp) + pddr(ji,jk)
3703  pdthl(ji,jk) = pdthl(ji,jkp)
3704  pdrw(ji,jk) = pdrw(ji,jkp)
3705  END IF
3706  END DO
3707 END DO
3708 !
3709 !
3710 !* 9. Calculate total downdraft evaporation
3711 ! rate for given mass flux (between DBL and IDDT)
3712 ! -----------------------------------------------
3713 !
3714 pdtevrf(:,:) = 0.
3715 !
3716 jkt = maxval( iddt(:) )
3717 DO jk = ikb + 1, jkt
3718 !
3719  zpi(:) = ( xp00 / ppres(:,jk) ) ** zrdocp
3720  zdt(:) = pth(:,jk) / zpi(:)
3721 !
3722 !* 9.1 Determine wet bulb temperature at DBL from theta_e.
3723 ! The iteration algoritm is similar to that used in
3724 ! routine CONVECT_CONDENS
3725 ! --------------------------------------------------
3726 !
3727  DO jiter = 1, 4
3728  CALL convect_satmixratio( klon, ppres(:,jk), zdt, zwork1, zlv, zls, zcph )
3729  zdtp(:) = pdthl(:,jk) / ( zpi(:) ** ( 1. - 0.28 * zwork1(:) ) &
3730  * exp( ( 3374.6525 / zdt(:) - 2.5403 ) &
3731  * zwork1(:) * ( 1. + 0.81 * zwork1(:) ) ) )
3732  zdt(:) = 0.4 * zdtp(:) + 0.6 * zdt(:) ! force convergence
3733  END DO
3734 !
3735 !
3736 !* 9.2 Sum total downdraft evaporation rate. No evaporation
3737 ! if actual humidity is larger than specified one.
3738 ! -----------------------------------------------------
3739 !
3740  zwork2(:) = zwork1(:) / zdt(:) * ( xbetaw / zdt(:) - xgamw ) ! dr_sat/dT
3741  zwork2(:) = zlv(:) / zcph(:) * zwork1(:) * ( 1. - xrhdbc ) / &
3742  ( 1. + zlv(:) / zcph(:) * zwork2(:) ) ! temperature perturb ! due to evaporation
3743  zdt(:) = zdt(:) + zwork2(:)
3744 !
3745  CALL convect_satmixratio( klon, ppres(:,jk), zdt, zwork3, zlv, zls, zcph )
3746 !
3747  zwork3(:) = zwork3(:) * xrhdbc
3748  zwork1(:) = max( 0., zwork3(:) - pdrw(:,jk) )
3749  pdtevr(:) = pdtevr(:) + zwork1(:) * pddr(:,jk)
3750  pdtevrf(:,jk)= pdtevrf(:,jk) + zwork1(:) * pddr(:,jk)
3751  ! compute enthalpie and humidity in the detrainment layer
3752  pdrw(:,jk) = max( pdrw(:,jk), zwork3(:) )
3753  pdthl(:,jk) = ( ( xcpd + pdrw(:,jk) * xcpv ) * zdt(:) &
3754  + ( 1. + pdrw(:,jk) ) * xg * pz(:,jk) )
3755 !
3756 END DO
3757 !
3758 !
3759 !* 12. If downdraft does not evaporate any water for specified
3760 ! relative humidity, no downdraft is allowed
3761 ! ---------------------------------------------------------
3762 !
3763 zwork2(:) = 1.
3764 WHERE ( pdtevr(:) < 1. .OR. klfs(:) == ikb + 1 ) zwork2(:) = 0.
3765 DO jk = ikb, jkm
3766  kdbl(:) = kdbl(:) * int( zwork2(:) ) + ( 1 - int( zwork2(:) ) ) * ikb
3767  klfs(:) = klfs(:) * int( zwork2(:) ) + ( 1 - int( zwork2(:) ) ) * ikb
3768  pdmf(:,jk) = pdmf(:,jk) * zwork2(:)
3769  pder(:,jk) = pder(:,jk) * zwork2(:)
3770  pddr(:,jk) = pddr(:,jk) * zwork2(:)
3771  zwork1(:) = REAL( KLFS(:) - JK ) ! use this to reset thl_d
3772  zwork1(:) = max( 0.,min(1.,zwork1(:) ) ) ! and rv_d to zero above LFS
3773  pdthl(:,jk) = pdthl(:,jk) * zwork2(:) * zwork1(:)
3774  pdrw(:,jk) = pdrw(:,jk) * zwork2(:) * zwork1(:)
3775  pdtevr(:) = pdtevr(:) * zwork2(:)
3776  pdtevrf(:,jk)= pdtevrf(:,jk) * zwork2(:)
3777 END DO
3778 !
3779 END SUBROUTINE convect_downdraft
3780 ! ######spl
3781  SUBROUTINE convect_precip_adjust( KLON, KLEV, &
3782  ppres, pumf, puer, pudr, &
3783  pupr, putpr, purw, &
3784  pdmf, pder, pddr, pdthl, pdrw, &
3785  ppref, ptpr, pmixf, pdtevr, &
3786  klfs, kdbl, klcl, kctl, ketl, &
3787  pdtevrf )
3788 ! ######################################################################
3789 !
3790 !!**** Adjust up- and downdraft mass fluxes to be consistent with the
3791 !! mass transport at the LFS given by the precipitation efficiency
3792 !! relation.
3793 !!
3794 !!
3795 !! PURPOSE
3796 !! -------
3797 !! The purpose of this routine is to adjust up- and downdraft mass
3798 !! fluxes below the LFS to be consistent with the precipitation
3799 !! efficiency relation
3800 !!
3801 !!
3802 !!
3803 !!** METHOD
3804 !! ------
3805 !!
3806 !!
3807 !! EXTERNAL
3808 !! --------
3809 !! None
3810 !!
3811 !!
3812 !! IMPLICIT ARGUMENTS
3813 !! ------------------
3814 !!
3815 !! Module MODD_CONVPAREXT
3816 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
3817 !!
3818 !! Module MODD_CONVPAR
3819 !! XUSRDPTH ! pressure depth to compute updraft humidity
3820 !! ! supply rate for downdraft
3821 !!
3822 !! REFERENCE
3823 !! ---------
3824 !!
3825 !! Book1,2 of documentation ( routine CONVECT_PRECIP_ADJUST)
3826 !!
3827 !! AUTHOR
3828 !! ------
3829 !! P. BECHTOLD * Laboratoire d'Aerologie *
3830 !!
3831 !! MODIFICATIONS
3832 !! -------------
3833 !! Original 07/11/95
3834 !! Last modified 04/10/97
3835 !-------------------------------------------------------------------------------
3836 !
3837 !* 0. DECLARATIONS
3838 ! ------------
3839 !
3840 USE modd_convparext
3841 USE modd_convpar
3842 !
3843 IMPLICIT NONE
3844 !
3845 !* 0.1 Declarations of dummy arguments :
3846 !
3847 !
3848 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
3849 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
3850 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
3851 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
3852 REAL, DIMENSION(KLON), INTENT(IN) :: PUTPR ! updraft total precipit. (kg/s
3853 REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
3854 REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! critical mixed fraction at LCL
3855 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
3856 INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
3857 INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of equilibrium
3858  ! (zero buoyancy) level
3859 INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KLFS ! contains vert. index of LFS
3860 INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KDBL ! contains vert. index of DBL
3861 !
3862 REAL, DIMENSION(KLON), INTENT(INOUT) :: PDTEVR ! total downdraft evaporation
3863  ! rate at LFS
3864 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTEVRF! downdraft evaporation rate
3865 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
3866 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
3867 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
3868 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUPR ! updraft precipit. (kg/s)
3869 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
3870 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
3871 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
3872 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTHL ! downdraft enthalpy (J/kg)
3873 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDRW ! downdraft total water (kg/kg)
3874 !
3875 REAL, DIMENSION(KLON), INTENT(OUT) :: PTPR ! total precipitation (kg/s)
3876  ! = downdraft precipitation
3877 !
3878 !* 0.2 Declarations of local variables :
3879 !
3880 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
3881 INTEGER :: JK, JKT1, JKT2, JKT3 ! vertical loop index
3882 INTEGER :: JI ! horizontal loop index
3883 !
3884 INTEGER, DIMENSION(KLON) :: IPRL
3885 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, &
3886  ZWORK4, ZWORK5, ZWORK6 ! work arrays
3887 !
3888 !
3889 !-------------------------------------------------------------------------------
3890 !
3891 ! 0.3 Set loop bounds
3892 ! ---------------
3893 !
3894 ikb = 1 + jcvexb
3895 ike = klev - jcvext
3896 iie = klon
3897 jkt1 = maxval( klfs(:) )
3898 jkt2 = maxval( kctl(:) )
3899 jkt3 = minval( klcl(:) )
3900 !
3901 !
3902 ! 1. Set some output variables for columns where no downdraft
3903 ! exists. Exit if there is no downdraft at all.
3904 ! --------------------------------------------------------
3905 !
3906 iprl(:) = ikb
3907 ptpr(:) = 0.
3908 !
3909 WHERE ( pdtevr(:) == 0. )
3910  ptpr(:) = putpr(:) ! no downdraft evaporation => no downdraft, all
3911  ! precipitation occurs in updraft
3912 END WHERE
3913 IF ( count( pdtevr(:) > 0. ) == 0 ) RETURN ! exit routine if no downdraft exists
3914 !
3915 !* 2. The total mass transported from the updraft to the down-
3916 ! draft at the LFS must be consistent with the three water
3917 ! budget terms :
3918 ! ---------------------------------------------------------
3919 !
3920 !* 2.1 Downdraft evaporation rate at the DBL. The evaporation
3921 ! rate in downdraft must be consistent with precipitation
3922 ! efficiency relation.
3923 ! --------------------------------------------------------
3924 !
3925 !
3926 DO ji = 1, iie
3927  jk = klfs(ji)
3928  zwork1(ji) = pdtevr(ji) / min( -1.e-1, pdmf(ji,jk) )
3929  zwork6(ji) = pdmf(ji,jk)
3930 END DO
3931 !
3932 !* 2.2 Some preliminar computations for downdraft = total
3933 ! precipitation rate. The precipitation is evaluated in
3934 ! a layer thickness DP=XUSRDPTH=165 hPa above the LCL.
3935 ! The difference between updraft precipitation and downdraft
3936 ! precipitation (updraft supply rate) is used to drive the
3937 ! downdraft through evaporational cooling.
3938 ! --------------------------------------------------------
3939 !
3940 DO ji = 1, iie
3941  jk = klcl(ji)
3942  zwork5(ji) = ppres(ji,jk)
3943 END DO
3944 !
3945 ptpr(:) = 0.
3946 DO jk = jkt3, jkt2
3947  WHERE ( jk >= klcl(:) .AND. ppres(:,jk) >= zwork5(:) - xusrdpth )
3948  ptpr(:) = ptpr(:) + pupr(:,jk)
3949  iprl(:) = jk
3950  END WHERE
3951 END DO
3952 iprl(:) = min( ketl(:), iprl(:) )
3953 !
3954 DO ji = 1, iie
3955  jk = iprl(ji)
3956  ptpr(ji) = pumf(ji,jk+1) * purw(ji,jk+1) + ptpr(ji)
3957 END DO
3958 !
3959 ptpr(:) = ppref(:) * min( putpr(:), ptpr(:) )
3960 zwork4(:) = putpr(:) - ptpr(:)
3961 !
3962 !
3963 !* 2.3 Total amount of precipitation that falls out of the up-
3964 ! draft between the LCL and the LFS.
3965 ! Condensate transfer from up to downdraft at LFS
3966 ! ---------------------------------------------------------
3967 !
3968 zwork5(:) = 0.
3969 DO jk = jkt3, jkt1
3970  WHERE ( jk >= klcl(:) .AND. jk <= klfs(:) )
3971  zwork5(:) = zwork5(:) + pupr(:,jk)
3972  END WHERE
3973 END DO
3974 !
3975 DO ji = 1, iie
3976  jk = klfs(ji)
3977  zwork2(ji) = ( 1. - ppref(ji) ) * zwork5(ji) * &
3978  ( 1. - pmixf(ji) ) / max( 1.e-1, pumf(ji,jk) )
3979 END DO
3980 !
3981 !
3982 !* 2.4 Increase the first guess downdraft mass flux to satisfy
3983 ! precipitation efficiency relation.
3984 ! If downdraft does not evaporate any water at the DBL for
3985 ! the specified relative humidity, or if the corrected mass
3986 ! flux at the LFS is positive no downdraft is allowed
3987 ! ---------------------------------------------------------
3988 !
3989 !
3990 zwork1(:) = zwork4(:) / ( zwork1(:) + zwork2(:) + 1.e-8 )
3991 zwork2(:) = zwork1(:) / min( -1.e-1, zwork6(:) ) ! ratio of budget consistent to actual DMF
3992 !
3993 zwork3(:) = 1.
3994 zwork6(:) = 1.
3995 WHERE ( zwork1(:) > 0. .OR. pdtevr(:) < 1. )
3996  kdbl(:) = ikb
3997  klfs(:) = ikb
3998  pdtevr(:) = 0.
3999  zwork2(:) = 0.
4000  zwork3(:) = 0.
4001  zwork6(:) = 0.
4002 END WHERE
4003 !
4004 DO jk = ikb, jkt1
4005  pdmf(:,jk) = pdmf(:,jk) * zwork2(:)
4006  pder(:,jk) = pder(:,jk) * zwork2(:)
4007  pddr(:,jk) = pddr(:,jk) * zwork2(:)
4008  pdtevrf(:,jk) = pdtevrf(:,jk)* zwork2(:)
4009  pdrw(:,jk) = pdrw(:,jk) * zwork3(:)
4010  pdthl(:,jk) = pdthl(:,jk) * zwork3(:)
4011 END DO
4012 zwork4(:) = zwork2(:)
4013 !
4014 !
4015 !* 3. Increase updraft mass flux, mass detrainment rate, and water
4016 ! substance detrainment rates to be consistent with the transfer
4017 ! of the estimated mass from the up- to the downdraft at the LFS
4018 ! --------------------------------------------------------------
4019 !
4020 DO ji = 1, iie
4021  jk = klfs(ji)
4022  zwork2(ji) = ( 1. - zwork6(ji) ) + zwork6(ji) * &
4023  ( pumf(ji,jk) - ( 1. - pmixf(ji) ) * zwork1(ji) ) / &
4024  max( 1.e-1, pumf(ji,jk) )
4025 END DO
4026 !
4027 !
4028 jkt1 = maxval( klfs(:) ) ! value of KLFS might have been reset to IKB above
4029 DO jk = ikb, jkt1
4030  DO ji = 1, iie
4031  IF ( jk <= klfs(ji) ) THEN
4032  pumf(ji,jk) = pumf(ji,jk) * zwork2(ji)
4033  puer(ji,jk) = puer(ji,jk) * zwork2(ji)
4034  pudr(ji,jk) = pudr(ji,jk) * zwork2(ji)
4035  pupr(ji,jk) = pupr(ji,jk) * zwork2(ji)
4036  END IF
4037  END DO
4038 END DO
4039 !
4040 !
4041 !* 4. Increase total = downdraft precipitation and evaporation rate
4042 ! -------------------------------------------------------------
4043 !
4044 WHERE ( pdtevr(:) > 0. )
4045  pdtevr(:) = pdtevr(:) * zwork4(:)
4046  ptpr(:) = ptpr(:) + ppref(:) * zwork5(:) * ( zwork2(:) - 1. )
4047 ELSEWHERE
4048  ptpr(:) = putpr(:)
4049 END WHERE
4050 !
4051 !
4052 END SUBROUTINE convect_precip_adjust
4053 ! ######spl
4054  SUBROUTINE convect_closure( KLON, KLEV, &
4055  ppres, pdpres, pz, pdxdy, plmass, &
4056  pthl, pth, prw, prc, pri, otrig1, &
4057  pthc, prwc, prcc, pric, pwsub, &
4058  klcl, kdpl, kpbl, klfs, kctl, kml, &
4059  pumf, puer, pudr, puthl, purw, &
4060  purc, puri, pupr, &
4061  pdmf, pder, pddr, pdthl, pdrw, &
4062  ptpr, pspr, pdtevr, &
4063  pcape, ptimec, &
4064  kftsteps, &
4065  pdtevrf, pprlflx, pprsflx )
4066 ! #######################################################################
4067 !
4068 !!**** Uses modified Fritsch-Chappell closure
4069 !!
4070 !!
4071 !! PURPOSE
4072 !! -------
4073 !! The purpose of this routine is to determine the final adjusted
4074 !! (over a time step PTIMEC) environmental values of THETA_l, R_w, R_c, R_i
4075 !! The final convective tendencies can then be evaluated in the main
4076 !! routine DEEP_CONVECT by (PTHC-PTH)/PTIMEC
4077 !!
4078 !!
4079 !!** METHOD
4080 !! ------
4081 !! Computations are done at every model level starting from bottom.
4082 !! The use of masks allows to optimise the inner loops (horizontal loops).
4083 !!
4084 !!
4085 !!
4086 !! EXTERNAL
4087 !! --------
4088 !!
4089 !! CONVECT_CLOSURE_THRVLCL
4090 !! CONVECT_CLOSURE_ADJUST
4091 !!
4092 !! IMPLICIT ARGUMENTS
4093 !! ------------------
4094 !! Module MODD_CST
4095 !! XG ! gravity constant
4096 !! XP00 ! reference pressure
4097 !! XRD, XRV ! gaz constants for dry air and water vapor
4098 !! XCPD, XCPV ! specific heat for dry air and water vapor
4099 !! XCL, XCI ! specific heat for liquid water and ice
4100 !! XTT ! triple point temperature
4101 !! XLVTT, XLSTT ! vaporization, sublimation heat constant
4102 !!
4103 !! Module MODD_CONVPAR
4104 !! XA25 ! reference grid area
4105 !! XSTABT ! stability factor in time integration
4106 !! XSTABC ! stability factor in CAPE adjustment
4107 !! XMELDPTH ! allow melting over specific pressure depth
4108 !!
4109 !! Module MODD_CONVPAREXT
4110 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
4111 !!
4112 !!
4113 !! REFERENCE
4114 !! ---------
4115 !!
4116 !! Book1,2 of documentation ( routine CONVECT_CLOSURE)
4117 !! Fritsch and Chappell, 1980, J. Atmos. Sci.
4118 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
4119 !!
4120 !! AUTHOR
4121 !! ------
4122 !! P. BECHTOLD * Laboratoire d'Aerologie *
4123 !!
4124 !! MODIFICATIONS
4125 !! -------------
4126 !! Original 26/03/96
4127 !! Peter Bechtold 04/10/97 change for enthalpie, r_c + r_i tendencies
4128 !-------------------------------------------------------------------------------
4129 !
4130 !* 0. DECLARATIONS
4131 ! ------------
4132 !
4133 USE modd_cst
4134 USE modd_convpar
4135 USE modd_convparext
4136 !
4137 !
4138 IMPLICIT NONE
4139 !
4140 !* 0.1 Declarations of dummy arguments :
4141 !
4142 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
4143 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
4144 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
4145 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
4146 INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
4147 INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
4148 INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
4149 INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! index for melting level
4150 REAL, DIMENSION(KLON), INTENT(INOUT) :: PTIMEC ! convection time step
4151 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
4152 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
4153 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH ! grid scale theta
4154 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW ! grid scale total water
4155  ! mixing ratio
4156 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC ! grid scale r_c
4157 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI ! grid scale r_i
4158 LOGICAL, DIMENSION(KLON), INTENT(IN) :: OTRIG1 ! logical to keep trace of
4159  ! convective arrays modified in UPDRAFT
4160 !
4161 !
4162 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
4163 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
4164  ! bottom and top of layer (Pa)
4165 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
4166 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
4167 REAL, DIMENSION(KLON), INTENT(IN) :: PCAPE ! available potent. energy
4168 INTEGER, INTENT(OUT) :: KFTSTEPS! maximum of fract time steps
4169  ! only used for chemical tracers
4170 !
4171 !
4172 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s)
4173 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER ! updraft entrainment (kg/s)
4174 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR ! updraft detrainment (kg/s)
4175 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUPR ! updraft precipitation in
4176  ! flux units (kg water / s)
4177 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
4178 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
4179 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft cloud water (kg/kg)
4180 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft cloud ice (kg/kg)
4181 !
4182 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s)
4183 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDER ! downdraft entrainment (kg/s)
4184 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDDR ! downdraft detrainment (kg/s)
4185 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDTHL ! downdraft enthalpy (J/kg)
4186 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDRW ! downdraft total water (kg/kg)
4187 REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total surf precipitation (kg/s)
4188 REAL, DIMENSION(KLON), INTENT(OUT) :: PSPR ! solid surf precipitation (kg/s)
4189 REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR! donwndraft evapor. (kg/s)
4190 !
4191 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PTHC ! conv. adj. grid scale theta
4192 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRWC ! conv. adj. grid scale r_w
4193 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRCC ! conv. adj. grid scale r_c
4194 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRIC ! conv. adj. grid scale r_i
4195 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PWSUB ! envir. compensating subsidence(Pa/s)
4196 !
4197 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDTEVRF! downdraft evaporation rate
4198 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRLFLX! liquid precip flux
4199 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRSFLX! solid precip flux
4200 !
4201 !* 0.2 Declarations of local variables :
4202 !
4203 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
4204 INTEGER :: IKS ! vertical dimension
4205 INTEGER :: JK, JKP, JKMAX ! vertical loop index
4206 INTEGER :: JI ! horizontal loop index
4207 INTEGER :: JITER ! iteration loop index
4208 INTEGER :: JSTEP ! fractional time loop index
4209 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
4210 REAL :: ZCVOCD, ZEPSA ! C_pv / C_pd, R_v / R_d
4211 !
4212 REAL, DIMENSION(KLON,KLEV) :: ZTHLC ! convectively adjusted
4213  ! grid scale enthalpy
4214 REAL, DIMENSION(KLON,KLEV) :: ZOMG ! conv. environm. subsidence (Pa/s)
4215 REAL, DIMENSION(KLON,KLEV) :: ZUMF ! non-adjusted updraft mass flux
4216 REAL, DIMENSION(KLON,KLEV) :: ZUER ! " updraft entrainm. rate
4217 REAL, DIMENSION(KLON,KLEV) :: ZUDR ! " updraft detrainm. rate
4218 REAL, DIMENSION(KLON,KLEV) :: ZDMF ! " downdraft mass flux
4219 REAL, DIMENSION(KLON,KLEV) :: ZDER ! " downdraft entrainm. rate
4220 REAL, DIMENSION(KLON,KLEV) :: ZDDR ! " downdraft detrainm. rate
4221 REAL, DIMENSION(KLON) :: ZTPR ! " total precipitation
4222 REAL, DIMENSION(KLON) :: ZDTEVR ! " total downdraft evapor.
4223 REAL, DIMENSION(KLON,KLEV):: ZPRLFLX ! " liquid precip flux
4224 REAL, DIMENSION(KLON,KLEV):: ZPRSFLX ! " solid precip flux
4225 REAL, DIMENSION(KLON) :: ZPRMELT ! melting of precipitation
4226 REAL, DIMENSION(KLON) :: ZPRMELTO ! non-adjusted "
4227 REAL, DIMENSION(KLON) :: ZADJ ! mass adjustment factor
4228 REAL, DIMENSION(KLON) :: ZADJMAX ! limit value for ZADJ
4229 REAL, DIMENSION(KLON) :: ZCAPE ! new CAPE after adjustment
4230 REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
4231 REAL, DIMENSION(KLON,KLEV):: ZTIMC ! 2D work array for ZTIMEC
4232 !
4233 REAL, DIMENSION(KLON) :: ZTHLCL ! new theta at LCL
4234 REAL, DIMENSION(KLON) :: ZRVLCL ! new r_v at LCL
4235 REAL, DIMENSION(KLON) :: ZZLCL ! height of LCL
4236 REAL, DIMENSION(KLON) :: ZTLCL ! temperature at LCL
4237 REAL, DIMENSION(KLON) :: ZTELCL ! envir. temper. at LCL
4238 REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
4239 REAL, DIMENSION(KLON) :: ZTHES1, ZTHES2! saturation environm. theta_e
4240 REAL, DIMENSION(KLON,KLEV) :: ZTHMFIN, ZTHMFOUT, ZRWMFIN, ZRWMFOUT
4241 REAL, DIMENSION(KLON,KLEV) :: ZRCMFIN, ZRCMFOUT, ZRIMFIN, ZRIMFOUT
4242  ! work arrays for environm. compensat. mass flux
4243 REAL, DIMENSION(KLON) :: ZPI ! (P/P00)**R_d/C_pd
4244 REAL, DIMENSION(KLON) :: ZLV ! latent heat of vaporisation
4245 REAL, DIMENSION(KLON) :: ZLS ! latent heat of sublimation
4246 REAL, DIMENSION(KLON) :: ZLM ! latent heat of melting
4247 REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
4248 REAL, DIMENSION(KLON) :: ZMELDPTH ! actual depth of melting layer
4249 INTEGER, DIMENSION(KLON) :: ITSTEP ! fractional convective time step
4250 INTEGER, DIMENSION(KLON) :: ICOUNT ! timestep counter
4251 INTEGER, DIMENSION(KLON) :: ILCL ! index lifting condens. level
4252 INTEGER, DIMENSION(KLON) :: IWORK1 ! work array
4253 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
4254 REAL, DIMENSION(KLON,KLEV):: ZWORK6
4255 LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK3! work arrays
4256 LOGICAL, DIMENSION(KLON,KLEV) :: GWORK4 ! work array
4257 !
4258 !
4259 !-------------------------------------------------------------------------------
4260 !
4261 !* 0.2 Initialize local variables
4262 ! ----------------------------
4263 !
4264 !
4265 pspr(:) = 0.
4266 ztimc(:,:) = 0.
4267 zthes2(:) = 0.
4268 zwork1(:) = 0.
4269 zwork2(:) = 0.
4270 zwork3(:) = 0.
4271 zwork4(:) = 0.
4272 zwork5(:) = 0.
4273 gwork1(:) = .false.
4274 gwork3(:) = .false.
4275 gwork4(:,:) = .false.
4276 ilcl(:) = klcl(:)
4277 !
4278 zcpord = xcpd / xrd
4279 zrdocp = xrd / xcpd
4280 zcvocd = xcpv / xcpd
4281 zepsa = xrv / xrd
4282 !
4283 zadj(:) = 1.
4284 zwork5(:) = 1.
4285 WHERE( .NOT. otrig1(:) ) zwork5(:) = 0.
4286 !
4287 !
4288 !* 0.3 Compute loop bounds
4289 ! -------------------
4290 !
4291 iie = klon
4292 ikb = 1 + jcvexb
4293 iks = klev
4294 ike = klev - jcvext
4295 jkmax = maxval( kctl(:) )
4296 !
4297 !
4298 !* 2. Save initial mass flux values to be used in adjustment procedure
4299 ! ---------------------------------------------------------------
4300 !
4301 zumf(:,:) = pumf(:,:)
4302 zuer(:,:) = puer(:,:)
4303 zudr(:,:) = pudr(:,:)
4304 zdmf(:,:) = pdmf(:,:)
4305 zder(:,:) = pder(:,:)
4306 zddr(:,:) = pddr(:,:)
4307 ztpr(:) = ptpr(:)
4308 zdtevr(:) = pdtevr(:)
4309 zomg(:,:) = 0.
4310 pwsub(:,:) = 0.
4311 zprmelt(:) = 0.
4312 pprlflx(:,:) = 0.
4313 zprlflx(:,:) = 0.
4314 pprsflx(:,:) = 0.
4315 zprsflx(:,:) = 0.
4316 !
4317 !
4318 !* 2.1 Some preliminar computations for melting of precipitation
4319 ! used later in section 9 and computation of precip fluxes
4320 ! Precipitation fluxes are updated for melting and evaporation
4321 ! ---------------------------------------------------------
4322 !
4323 !
4324 zwork1(:) = 0.
4325 zmeldpth(:) = 0.
4326 zwork6(:,:) = 0.
4327 DO jk = jkmax + 1, ikb + 1, -1
4328  ! Nota: PUPR is total precipitation flux, but the solid, liquid
4329  ! precipitation is stored in units kg/kg; therefore we compute here
4330  ! the solid fraction of the total precipitation flux.
4331  DO ji = 1, iie
4332  zwork2(ji) = pupr(ji,jk) / ( purc(ji,jk) + puri(ji,jk) + 1.e-8 )
4333  zprmelt(ji) = zprmelt(ji) + puri(ji,jk) * zwork2(ji)
4334  zwork1(ji) = zwork1(ji) + purc(ji,jk) * zwork2(ji) - pdtevrf(ji,jk)
4335  zprlflx(ji,jk)= max( 0., zwork1(ji) )
4336  zprmelt(ji) = zprmelt(ji) + min( 0., zwork1(ji) )
4337  zprsflx(ji,jk)= zprmelt(ji)
4338  IF ( kml(ji) >= jk .AND. zmeldpth(ji) <= xmeldpth ) THEN
4339  zpi(ji) = ( ppres(ji,jk) / xp00 ) ** zrdocp
4340  zwork3(ji) = pth(ji,jk) * zpi(ji) ! temperature estimate
4341  zlm(ji) = xlstt + ( xcpv - xci ) * ( zwork3(ji) - xtt ) - &
4342  ( xlvtt + ( xcpv - xcl ) * ( zwork3(ji) - xtt ) ) ! L_s - L_v
4343  zcph(ji) = xcpd + xcpv * prw(ji,jk)
4344  zmeldpth(ji) = zmeldpth(ji) + pdpres(ji,jk)
4345  zwork6(ji,jk)= zlm(ji) * ptimec(ji) / plmass(ji,jk) * pdpres(ji,jk)
4346  zomg(ji,jk)= 1. ! at this place only used as work variable
4347  END IF
4348  END DO
4349 !
4350 END DO
4351 !
4352 zwork2(:) = 0.
4353 DO jk = jkmax, ikb + 1, -1
4354  zwork1(:) = zprmelt(:) * pdpres(:,jk) / max( xmeldpth, zmeldpth(:) )
4355  zwork2(:) = zwork2(:) + zwork1(:) * zomg(:,jk)
4356  zprlflx(:,jk) = zprlflx(:,jk) + zwork2(:)
4357  zprsflx(:,jk) = zprsflx(:,jk) - zwork2(:)
4358 END DO
4359 WHERE( zprsflx(:,:) < 1. ) zprsflx(:,:)=0.
4360 zprmelto(:) = zprmelt(:)
4361 !
4362 !
4363 !* 3. Compute limits on the closure adjustment factor so that the
4364 ! inflow in convective drafts from a given layer can't be larger
4365 ! than the mass contained in this layer initially.
4366 ! ---------------------------------------------------------------
4367 !
4368 zadjmax(:) = 1000.
4369 iwork1(:) = max( ilcl(:), klfs(:) )
4370 jkp = minval( kdpl(:) )
4371 DO jk = jkp, ike
4372  DO ji = 1, iie
4373  IF( jk > kdpl(ji) .AND. jk <= iwork1(ji) ) THEN
4374  zwork1(ji) = plmass(ji,jk) / &
4375  ( ( puer(ji,jk) + pder(ji,jk) + 1.e-5 ) * ptimec(ji) )
4376  zadjmax(ji) = min( zadjmax(ji), zwork1(ji) )
4377  END IF
4378  END DO
4379 END DO
4380 !
4381 !
4382 gwork1(:) = otrig1(:) ! logical array to limit adjustment to not definitively
4383  ! adjusted columns
4384 !
4385 DO jk = ikb, ike
4386  zthlc(:,:) = pthl(:,:) ! initialize adjusted envir. values
4387  prwc(:,:) = prw(:,:)
4388  prcc(:,:) = prc(:,:)
4389  pric(:,:) = pri(:,:)
4390  pthc(:,:) = pth(:,:)
4391 END DO
4392 !
4393 !
4394 !
4395 DO jiter = 1, 7 ! Enter adjustment loop to assure that all CAPE is
4396  ! removed within the advective time interval TIMEC
4397 !
4398  ztimec(:) = ptimec(:)
4399  gwork4(:,:) = spread( gwork1(:), dim=2, ncopies=iks )
4400  WHERE( gwork4(:,:) ) pwsub(:,:) = 0.
4401  zomg(:,:)=0.
4402 !
4403  DO jk = ikb + 1, jkmax
4404  jkp = max( ikb + 1, jk - 1 )
4405  WHERE ( gwork1(:) .AND. jk <= kctl(:) )
4406 !
4407 !
4408 !* 4. Determine vertical velocity at top and bottom of each layer
4409 ! to satisfy mass continuity.
4410 ! ---------------------------------------------------------------
4411  ! we compute here Domega/Dp = - g rho Dw/Dz = 1/Dt
4412 !
4413  zwork1(:) = - ( puer(:,jkp) + pder(:,jkp) - &
4414  pudr(:,jkp) - pddr(:,jkp) ) / plmass(:,jkp)
4415 !
4416  pwsub(:,jk) = pwsub(:,jkp) - pdpres(:,jk-1) * zwork1(:)
4417  ! we use PDPRES(JK-1) and not JKP in order to have zero subsidence
4418  ! at the first layer
4419 !
4420 !
4421 !* 5. Compute fractional time step. For stability or
4422 ! mass conservation reasons one must split full time step PTIMEC)
4423 ! ---------------------------------------------------------------
4424 !
4425  zwork1(:) = xstabt * pdpres(:,jkp) / ( abs( pwsub(:,jk) ) + 1.e-10 )
4426  ! the factor XSTABT is used for stability reasons
4427  ztimec(:) = min( ztimec(:), zwork1(:) )
4428 !
4429  ! transform vertical velocity in mass flux units
4430  zomg(:,jk) = pwsub(:,jk) * pdxdy(:) / xg
4431  END WHERE
4432  END DO
4433 !
4434 !
4435  WHERE( gwork4(:,:) )
4436  zthlc(:,:) = pthl(:,:) ! reinitialize adjusted envir. values
4437  prwc(:,:) = prw(:,:) ! when iteration criterium not attained
4438  prcc(:,:) = prc(:,:)
4439  pric(:,:) = pri(:,:)
4440  pthc(:,:) = pth(:,:)
4441  END WHERE
4442 !
4443 !
4444 ! 6. Check for mass conservation, i.e. ZWORK1 > 1.E-2
4445 ! If mass is not conserved, the convective tendencies
4446 ! automatically become zero.
4447 ! ----------------------------------------------------
4448 !
4449  DO ji = 1, iie
4450  jk=kctl(ji)
4451  zwork1(ji) = pudr(ji,jk) * pdpres(ji,jk) / ( plmass(ji,jk) + .1 ) &
4452  - pwsub(ji,jk)
4453  END DO
4454  WHERE( gwork1(:) .AND. abs( zwork1(:) ) - .01 > 0. )
4455  gwork1(:) = .false.
4456  ptimec(:) = 1.e-1
4457  ztpr(:) = 0.
4458  zwork5(:) = 0.
4459  END WHERE
4460  DO jk = ikb, ike
4461  pwsub(:,jk) = pwsub(:,jk) * zwork5(:)
4462  zprlflx(:,jk) = zprlflx(:,jk) * zwork5(:)
4463  zprsflx(:,jk) = zprsflx(:,jk) * zwork5(:)
4464  END DO
4465  gwork4(:,1:ikb) = .false.
4466  gwork4(:,iks) = .false.
4467 !
4468  itstep(:) = int( ptimec(:) / ztimec(:) ) + 1
4469  ztimec(:) = ptimec(:) / REAL( ITSTEP(:) ) ! adjust fractional time step
4470  ! to be an integer multiple of PTIMEC
4471  ztimc(:,:)= spread( ztimec(:), dim=2, ncopies=iks )
4472  icount(:) = 0
4473 !
4474 !
4475 !
4476  kftsteps = maxval( itstep(:) )
4477  DO jstep = 1, kftsteps ! Enter the fractional time step loop here
4478 !
4479  icount(:) = icount(:) + 1
4480 !
4481  gwork3(:) = itstep(:) >= icount(:) .AND. gwork1(:)
4482 !
4483 !
4484 !* 7. Assign enthalpy and r_w values at the top and bottom of each
4485 ! layer based on the sign of w
4486 ! ------------------------------------------------------------
4487 !
4488  zthmfin(:,:) = 0.
4489  zrwmfin(:,:) = 0.
4490  zrcmfin(:,:) = 0.
4491  zrimfin(:,:) = 0.
4492  zthmfout(:,:) = 0.
4493  zrwmfout(:,:) = 0.
4494  zrcmfout(:,:) = 0.
4495  zrimfout(:,:) = 0.
4496 !
4497  DO jk = ikb + 1, jkmax
4498  gwork4(:,jk) = gwork3(:) .AND. jk <= kctl(:)
4499  jkp = max( ikb + 1, jk - 1 )
4500  DO ji = 1, iie
4501  IF ( gwork3(ji) ) THEN
4502 !
4503  zwork1(ji) = sign( 1., zomg(ji,jk) )
4504  zwork2(ji) = 0.5 * ( 1. + zwork1(ji) )
4505  zwork1(ji) = 0.5 * ( 1. - zwork1(ji) )
4506  zthmfin(ji,jk) = - zomg(ji,jk) * zthlc(ji,jkp) * zwork1(ji)
4507  zthmfout(ji,jk) = zomg(ji,jk) * zthlc(ji,jk) * zwork2(ji)
4508  zthmfin(ji,jkp) = zthmfin(ji,jkp) + zthmfout(ji,jk) * zwork2(ji)
4509  zthmfout(ji,jkp) = zthmfout(ji,jkp) + zthmfin(ji,jk) * zwork1(ji)
4510  zrwmfin(ji,jk) = - zomg(ji,jk) * prwc(ji,jkp) * zwork1(ji)
4511  zrwmfout(ji,jk) = zomg(ji,jk) * prwc(ji,jk) * zwork2(ji)
4512  zrwmfin(ji,jkp) = zrwmfin(ji,jkp) + zrwmfout(ji,jk) * zwork2(ji)
4513  zrwmfout(ji,jkp) = zrwmfout(ji,jkp) + zrwmfin(ji,jk) * zwork1(ji)
4514  zrcmfin(ji,jk) = - zomg(ji,jk) * prcc(ji,jkp) * zwork1(ji)
4515  zrcmfout(ji,jk) = zomg(ji,jk) * prcc(ji,jk) * zwork2(ji)
4516  zrcmfin(ji,jkp) = zrcmfin(ji,jkp) + zrcmfout(ji,jk) * zwork2(ji)
4517  zrcmfout(ji,jkp) = zrcmfout(ji,jkp) + zrcmfin(ji,jk) * zwork1(ji)
4518  zrimfin(ji,jk) = - zomg(ji,jk) * pric(ji,jkp) * zwork1(ji)
4519  zrimfout(ji,jk) = zomg(ji,jk) * pric(ji,jk) * zwork2(ji)
4520  zrimfin(ji,jkp) = zrimfin(ji,jkp) + zrimfout(ji,jk) * zwork2(ji)
4521  zrimfout(ji,jkp) = zrimfout(ji,jkp) + zrimfin(ji,jk) * zwork1(ji)
4522 !
4523  END IF
4524  END DO
4525  END DO
4526 !
4527  WHERE ( gwork4(:,:) )
4528 !
4529 !******************************************************************************
4530 !
4531 !* 8. Update the environmental values of enthalpy and r_w at each level
4532 ! NOTA: These are the MAIN EQUATIONS of the scheme
4533 ! -----------------------------------------------------------------
4534 !
4535 !
4536  zthlc(:,:) = zthlc(:,:) + ztimc(:,:) / plmass(:,:) * ( &
4537  zthmfin(:,:) + pudr(:,:) * puthl(:,:) + &
4538  pddr(:,:) * pdthl(:,:) - zthmfout(:,:) - &
4539  ( puer(:,:) + pder(:,:) ) * pthl(:,:) )
4540  prwc(:,:) = prwc(:,:) + ztimc(:,:) / plmass(:,:) * ( &
4541  zrwmfin(:,:) + pudr(:,:) * purw(:,:) + &
4542  pddr(:,:) * pdrw(:,:) - zrwmfout(:,:) - &
4543  ( puer(:,:) + pder(:,:) ) * prw(:,:) )
4544  prcc(:,:) = prcc(:,:) + ztimc(:,:) / plmass(:,:) * ( &
4545  zrcmfin(:,:) + pudr(:,:) * purc(:,:) - zrcmfout(:,:) - &
4546  ( puer(:,:) + pder(:,:) ) * prc(:,:) )
4547  pric(:,:) = pric(:,:) + ztimc(:,:) / plmass(:,:) * ( &
4548  zrimfin(:,:) + pudr(:,:) * puri(:,:) - zrimfout(:,:) - &
4549  ( puer(:,:) + pder(:,:) ) * pri(:,:) )
4550 !
4551 !
4552 !******************************************************************************
4553 !
4554  END WHERE
4555 !
4556  END DO ! Exit the fractional time step loop
4557 !
4558 !
4559 !* 9. Allow frozen precipitation to melt over a 200 mb deep layer
4560 ! -----------------------------------------------------------
4561 !
4562  DO jk = jkmax, ikb + 1, -1
4563  zthlc(:,jk) = zthlc(:,jk) - &
4564  zprmelt(:) * zwork6(:,jk) / max( xmeldpth, zmeldpth(:) )
4565  END DO
4566 !
4567 !
4568 !* 10. Compute final linearized value of theta envir.
4569 ! ----------------------------------------------
4570 !
4571  DO jk = ikb + 1, jkmax
4572  DO ji = 1, iie
4573  IF( gwork1(ji) .AND. jk <= kctl(ji) ) THEN
4574  zpi(ji) = ( xp00 / ppres(ji,jk) ) ** zrdocp
4575  zcph(ji) = xcpd + prwc(ji,jk) * xcpv
4576  zwork2(ji) = pth(ji,jk) / zpi(ji) ! first temperature estimate
4577  zlv(ji) = xlvtt + ( xcpv - xcl ) * ( zwork2(ji) - xtt )
4578  zls(ji) = xlvtt + ( xcpv - xci ) * ( zwork2(ji) - xtt )
4579  ! final linearized temperature
4580  zwork2(ji) = ( zthlc(ji,jk) + zlv(ji) * prcc(ji,jk) + zls(ji) * pric(ji,jk) &
4581  - (1. + prwc(ji,jk) ) * xg * pz(ji,jk) ) / zcph(ji)
4582  zwork2(ji) = max( 180., min( 340., zwork2(ji) ) )
4583  pthc(ji,jk)= zwork2(ji) * zpi(ji) ! final adjusted envir. theta
4584  END IF
4585  END DO
4586  END DO
4587 !
4588 !
4589 !* 11. Compute new cloud ( properties at new LCL )
4590 ! NOTA: The computations are very close to
4591 ! that in routine TRIGGER_FUNCT
4592 ! ---------------------------------------------
4593 !
4594  CALL convect_closure_thrvlcl( klon, klev, &
4595  ppres, pthc, prwc, pz, gwork1, &
4596  zthlcl, zrvlcl, zzlcl, ztlcl, ztelcl, &
4597  ilcl, kdpl, kpbl )
4598 !
4599 !
4600  ztlcl(:) = max( 230., min( 335., ztlcl(:) ) ) ! set some overflow bounds
4601  ztelcl(:) = max( 230., min( 335., ztelcl(:) ) )
4602  zthlcl(:) = max( 230., min( 345., zthlcl(:) ) )
4603  zrvlcl(:) = max( 0., min( 1., zrvlcl(:) ) )
4604 !
4605 !
4606 !* 12. Compute adjusted CAPE
4607 ! ---------------------
4608 !
4609  zcape(:) = 0.
4610  zpi(:) = zthlcl(:) / ztlcl(:)
4611  zpi(:) = max( 0.95, min( 1.5, zpi(:) ) )
4612  zwork1(:) = xp00 / zpi(:) ** zcpord ! pressure at LCL
4613 !
4614  CALL convect_satmixratio( klon, zwork1, ztelcl, zwork3, zlv, zls, zcph )
4615  zwork3(:) = min( .1, max( 0., zwork3(:) ) )
4616 !
4617  ! compute theta_e updraft undilute
4618  ztheul(:) = ztlcl(:) * zpi(:) ** ( 1. - 0.28 * zrvlcl(:) ) &
4619  * exp( ( 3374.6525 / ztlcl(:) - 2.5403 ) &
4620  * zrvlcl(:) * ( 1. + 0.81 * zrvlcl(:) ) )
4621 !
4622  ! compute theta_e saturated environment at LCL
4623  zthes1(:) = ztelcl(:) * zpi(:) ** ( 1. - 0.28 * zwork3(:) ) &
4624  * exp( ( 3374.6525 / ztelcl(:) - 2.5403 ) &
4625  * zwork3(:) * ( 1. + 0.81 * zwork3(:) ) )
4626 !
4627  DO jk = minval( ilcl(:) ), jkmax
4628  jkp = jk - 1
4629  DO ji = 1, iie
4630  zwork4(ji) = 1.
4631  IF ( jk == ilcl(ji) ) zwork4(ji) = 0.
4632 !
4633  ! compute theta_e saturated environment and adjusted values
4634  ! of theta
4635 !
4636  gwork3(ji) = jk >= ilcl(ji) .AND. jk <= kctl(ji) .AND. gwork1(ji)
4637 !
4638  zpi(ji) = ( xp00 / ppres(ji,jk) ) ** zrdocp
4639  zwork2(ji) = pthc(ji,jk) / zpi(ji)
4640  END DO
4641 !
4642  CALL convect_satmixratio( klon, ppres(:,jk), zwork2, zwork3, zlv, zls, zcph )
4643 !
4644 !
4645  DO ji = 1, iie
4646  IF ( gwork3(ji) ) THEN
4647  zthes2(ji) = zwork2(ji) * zpi(ji) ** ( 1. - 0.28 * zwork3(ji) ) &
4648  * exp( ( 3374.6525 / zwork2(ji) - 2.5403 ) &
4649  * zwork3(ji) * ( 1. + 0.81 * zwork3(ji) ) )
4650 !
4651  zwork3(ji) = pz(ji,jk) - pz(ji,jkp) * zwork4(ji) - &
4652  ( 1. - zwork4(ji) ) * zzlcl(ji) ! level thickness
4653  zwork1(ji) = ( 2. * ztheul(ji) ) / ( zthes1(ji) + zthes2(ji) ) - 1.
4654  zcape(ji) = zcape(ji) + xg * zwork3(ji) * max( 0., zwork1(ji) )
4655  zthes1(ji) = zthes2(ji)
4656  END IF
4657  END DO
4658  END DO
4659 !
4660 !
4661 !* 13. Determine mass adjustment factor knowing how much
4662 ! CAPE has been removed.
4663 ! -------------------------------------------------
4664 !
4665  WHERE ( gwork1(:) )
4666  zwork1(:) = max( pcape(:) - zcape(:), 0.1 * pcape(:) )
4667  zwork2(:) = zcape(:) / ( pcape(:) + 1.e-8 )
4668 !
4669  gwork1(:) = zwork2(:) > 0.1 .OR. zcape(:) == 0. ! mask for adjustment
4670  END WHERE
4671 !
4672  WHERE ( zcape(:) == 0. .AND. gwork1(:) ) zadj(:) = zadj(:) * 0.5
4673  WHERE ( zcape(:) /= 0. .AND. gwork1(:) ) &
4674  zadj(:) = zadj(:) * xstabc * pcape(:) / ( zwork1(:) + 1.e-8 )
4675  zadj(:) = min( zadj(:), zadjmax(:) )
4676 !
4677 !
4678 !* 13. Adjust mass flux by the factor ZADJ to converge to
4679 ! specified degree of stabilization
4680 ! ----------------------------------------------------
4681 !
4682  CALL convect_closure_adjust( klon, klev, zadj, &
4683  pumf, zumf, puer, zuer, pudr, zudr, &
4684  pdmf, zdmf, pder, zder, pddr, zddr, &
4685  zprmelt, zprmelto, pdtevr, zdtevr, &
4686  ptpr, ztpr, &
4687  pprlflx, zprlflx, pprsflx, zprsflx )
4688 !
4689 !
4690  IF ( count( gwork1(:) ) == 0 ) EXIT ! exit big adjustment iteration loop
4691  ! when all columns have reached
4692  ! desired degree of stabilization.
4693 !
4694 END DO ! end of big adjustment iteration loop
4695 !
4696 !
4697  ! skip adj. total water array to water vapor
4698 DO jk = ikb, ike
4699  prwc(:,jk) = max( 0., prwc(:,jk) - prcc(:,jk) - pric(:,jk) )
4700 END DO
4701 !
4702  ! compute surface solid (ice) precipitation
4703 pspr(:) = zprmelt(:) * ( 1. - zmeldpth(:) / xmeldpth )
4704 pspr(:) = max( 0., pspr(:) )
4705 !
4706 !
4707 END SUBROUTINE convect_closure
4708 ! ######spl
4709  SUBROUTINE convect_closure_adjust( KLON, KLEV, PADJ, &
4710  pumf, pzumf, puer, pzuer, pudr, pzudr, &
4711  pdmf, pzdmf, pder, pzder, pddr, pzddr, &
4712  pprmelt, pzprmelt, pdtevr, pzdtevr, &
4713  ptpr, pztpr, &
4714  pprlflx, pzprlfl, pprsflx, pzprsfl )
4715 
4716 ! #########################################################################
4717 !
4718 !!**** Uses closure adjustment factor to adjust mass flux and to modify
4719 !! precipitation efficiency when necessary. The computations are
4720 !! similar to routine CONVECT_PRECIP_ADJUST.
4721 !!
4722 !!
4723 !! PURPOSE
4724 !! -------
4725 !! The purpose of this routine is to adjust the mass flux using the
4726 !! factor PADJ computed in CONVECT_CLOSURE
4727 !!
4728 !!
4729 !!** METHOD
4730 !! ------
4731 !! Computations are done at every model level starting from bottom.
4732 !! The use of masks allows to optimise the inner loops (horizontal loops).
4733 !!
4734 !!
4735 !! EXTERNAL
4736 !! --------
4737 !! Module MODD_CONVPAREXT
4738 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
4739 !!
4740 !! None
4741 !!
4742 !! IMPLICIT ARGUMENTS
4743 !! ------------------
4744 !!
4745 !! None
4746 !!
4747 !! REFERENCE
4748 !! ---------
4749 !!
4750 !! Book1,2 of documentation ( routine CONVECT_CLOSURE_ADJUST)
4751 !!
4752 !! AUTHOR
4753 !! ------
4754 !! P. BECHTOLD * Laboratoire d'Aerologie *
4755 !!
4756 !! MODIFICATIONS
4757 !! -------------
4758 !! Original 26/03/96
4759 !! Last modified 04/10/97
4760 !-------------------------------------------------------------------------------
4761 !
4762 !* 0. DECLARATIONS
4763 ! ------------
4764 !
4765 USE modd_convparext
4766 !
4767 IMPLICIT NONE
4768 !
4769 !* 0.1 Declarations of dummy arguments :
4770 !
4771 !
4772 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
4773 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
4774 REAL, DIMENSION(KLON), INTENT(IN) :: PADJ ! mass adjustment factor
4775 !
4776 !
4777 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
4778 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of "
4779 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
4780 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of "
4781 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
4782 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of "
4783 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
4784 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDMF ! initial value of "
4785 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
4786 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDER ! initial value of "
4787 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
4788 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDDR ! initial value of "
4789 REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total precipitation (kg/s)
4790 REAL, DIMENSION(KLON), INTENT(INOUT):: PZTPR ! initial value of "
4791 REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR ! donwndraft evapor. (kg/s)
4792 REAL, DIMENSION(KLON), INTENT(INOUT):: PZDTEVR ! initial value of "
4793 REAL, DIMENSION(KLON), INTENT(INOUT):: PPRMELT ! melting of precipitation
4794 REAL, DIMENSION(KLON), INTENT(INOUT):: PZPRMELT ! initial value of "
4795 REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRLFLX! liquid precip flux
4796 REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRLFL! initial value "
4797 REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRSFLX! solid precip flux
4798 REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRSFL! initial value "
4799 !
4800 !
4801 !* 0.2 Declarations of local variables :
4802 !
4803 INTEGER :: IIE, IKB, IKE ! horiz. + vert. loop bounds
4804 INTEGER :: JK ! vertical loop index
4805 !
4806 !
4807 !-------------------------------------------------------------------------------
4808 !
4809 !* 0.3 Compute loop bounds
4810 ! -------------------
4811 !
4812 iie = klon
4813 ikb = 1 + jcvexb
4814 ike = klev - jcvext
4815 !
4816 !
4817 !* 1. Adjust mass flux by the factor PADJ to converge to
4818 ! specified degree of stabilization
4819 ! ----------------------------------------------------
4820 !
4821  pprmelt(:) = pzprmelt(:) * padj(:)
4822  pdtevr(:) = pzdtevr(:) * padj(:)
4823  ptpr(:) = pztpr(:) * padj(:)
4824 !
4825  DO jk = ikb + 1, ike
4826  pumf(:,jk) = pzumf(:,jk) * padj(:)
4827  puer(:,jk) = pzuer(:,jk) * padj(:)
4828  pudr(:,jk) = pzudr(:,jk) * padj(:)
4829  pdmf(:,jk) = pzdmf(:,jk) * padj(:)
4830  pder(:,jk) = pzder(:,jk) * padj(:)
4831  pddr(:,jk) = pzddr(:,jk) * padj(:)
4832  pprlflx(:,jk) = pzprlfl(:,jk) * padj(:)
4833  pprsflx(:,jk) = pzprsfl(:,jk) * padj(:)
4834  END DO
4835 !
4836 END SUBROUTINE convect_closure_adjust
4837 ! ######spl
4838  SUBROUTINE convect_closure_thrvlcl( KLON, KLEV, &
4839  ppres, pth, prv, pz, owork1, &
4840  pthlcl, prvlcl, pzlcl, ptlcl, ptelcl,&
4841  klcl, kdpl, kpbl )
4842 ! ######################################################################
4843 !
4844 !!**** Determine thermodynamic properties at new LCL
4845 !!
4846 !! PURPOSE
4847 !! -------
4848 !! The purpose of this routine is to determine the thermodynamic
4849 !! properties at the new lifting condensation level LCL
4850 !!
4851 !!
4852 !!
4853 !!** METHOD
4854 !! ------
4855 !! see CONVECT_TRIGGER_FUNCT
4856 !!
4857 !!
4858 !!
4859 !! EXTERNAL
4860 !! --------
4861 !! Routine CONVECT_SATMIXRATIO
4862 !!
4863 !!
4864 !! IMPLICIT ARGUMENTS
4865 !! ------------------
4866 !! Module MODD_CST
4867 !! XG ! gravity constant
4868 !! XP00 ! Reference pressure
4869 !! XRD, XRV ! Gaz constants for dry air and water vapor
4870 !! XCPD ! Cpd (dry air)
4871 !! XTT ! triple point temperature
4872 !! XBETAW, XGAMW ! constants for vapor saturation pressure
4873 !!
4874 !! Module MODD_CONVPAR
4875 !! XA25 ! reference grid area
4876 !! XZLCL ! lowest allowed pressure difference between
4877 !! ! surface and LCL
4878 !! XZPBL ! minimum mixed layer depth to sustain convection
4879 !! XWTRIG ! constant in vertical velocity trigger
4880 !!
4881 !! Module MODD_CONVPAREXT
4882 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
4883 !!
4884 !! REFERENCE
4885 !! ---------
4886 !!
4887 !! Book2 of documentation ( routine TRIGGER_FUNCT)
4888 !! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
4889 !!
4890 !! AUTHOR
4891 !! ------
4892 !! P. BECHTOLD * Laboratoire d'Aerologie *
4893 !!
4894 !! MODIFICATIONS
4895 !! -------------
4896 !! Original 07/11/95
4897 !! Last modified 04/10/97
4898 !-------------------------------------------------------------------------------
4899 !
4900 !* 0. DECLARATIONS
4901 ! ------------
4902 !
4903 USE modd_cst
4904 USE modd_convpar
4905 USE modd_convparext
4906 !
4907 !
4908 IMPLICIT NONE
4909 !
4910 !* 0.1 Declarations of dummy arguments :
4911 !
4912 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
4913 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
4914 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! theta
4915 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRV ! vapor mixing ratio
4916 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure
4917 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of grid point (m)
4918 INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
4919 INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layer top
4920 LOGICAL, DIMENSION(KLON), INTENT(IN) :: OWORK1! logical mask
4921 !
4922 REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
4923 REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
4924 REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
4925 REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temperature at LCL (m)
4926 REAL, DIMENSION(KLON), INTENT(OUT):: PTELCL ! environm. temp. at LCL (K)
4927 INTEGER, DIMENSION(KLON), INTENT(OUT):: KLCL ! contains vert. index of LCL
4928 !
4929 !* 0.2 Declarations of local variables :
4930 !
4931 INTEGER :: JK, JKM, JKMIN, JKMAX ! vertical loop index
4932 INTEGER :: JI ! horizontal loop index
4933 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
4934 REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
4935 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
4936 !
4937 REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
4938 REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
4939 REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
4940 REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
4941 REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
4942 REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
4943 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2 ! work arrays
4944 !
4945 !
4946 !-------------------------------------------------------------------------------
4947 !
4948 !* 0.3 Compute array bounds
4949 ! --------------------
4950 !
4951 iie = klon
4952 ikb = 1 + jcvexb
4953 ike = klev - jcvext
4954 !
4955 !
4956 !* 1. Initialize local variables
4957 ! --------------------------
4958 !
4959 zeps = xrd / xrv
4960 zepsa = xrv / xrd
4961 zcpord = xcpd / xrd
4962 zrdocp = xrd / xcpd
4963 !
4964 zdpthmix(:) = 0.
4965 zpresmix(:) = 0.
4966 pthlcl(:) = 300.
4967 ptlcl(:) = 300.
4968 ptelcl(:) = 300.
4969 prvlcl(:) = 0.
4970 pzlcl(:) = pz(:,ikb)
4971 ztmix(:) = 230.
4972 zplcl(:) = 1.e4
4973 klcl(:) = ikb + 1
4974 !
4975 !
4976 !* 2. Construct a mixed layer as in TRIGGER_FUNCT
4977 ! -------------------------------------------
4978 !
4979  jkmax = maxval( kpbl(:) )
4980  jkmin = minval( kdpl(:) )
4981  DO jk = ikb + 1, jkmax
4982  jkm = jk + 1
4983  DO ji = 1, iie
4984  IF ( jk >= kdpl(ji) .AND. jk <= kpbl(ji) ) THEN
4985 !
4986  zwork1(ji) = ppres(ji,jk) - ppres(ji,jkm)
4987  zdpthmix(ji) = zdpthmix(ji) + zwork1(ji)
4988  zpresmix(ji) = zpresmix(ji) + ppres(ji,jk) * zwork1(ji)
4989  pthlcl(ji) = pthlcl(ji) + pth(ji,jk) * zwork1(ji)
4990  prvlcl(ji) = prvlcl(ji) + prv(ji,jk) * zwork1(ji)
4991 !
4992  END IF
4993  END DO
4994  END DO
4995 !
4996 !
4997 WHERE ( owork1(:) )
4998 !
4999  zpresmix(:) = zpresmix(:) / zdpthmix(:)
5000  pthlcl(:) = pthlcl(:) / zdpthmix(:)
5001  prvlcl(:) = prvlcl(:) / zdpthmix(:)
5002 !
5003 !* 3.1 Use an empirical direct solution ( Bolton formula )
5004 ! to determine temperature and pressure at LCL.
5005 ! Nota: the adiabatic saturation temperature is not
5006 ! equal to the dewpoint temperature
5007 ! --------------------------------------------------
5008 !
5009 !
5010  ztmix(:) = pthlcl(:) * ( zpresmix(:) / xp00 ) ** zrdocp
5011  zevmix(:) = prvlcl(:) * zpresmix(:) / ( prvlcl(:) + zeps )
5012  zevmix(:) = max( 1.e-8, zevmix(:) )
5013  zwork1(:) = log( zevmix(:) / 613.3 )
5014  ! dewpoint temperature
5015  zwork1(:) = ( 4780.8 - 32.19 * zwork1(:) ) / ( 17.502 - zwork1(:) )
5016  ! adiabatic saturation temperature
5017  ptlcl(:) = zwork1(:) - ( .212 + 1.571e-3 * ( zwork1(:) - xtt ) &
5018  - 4.36e-4 * ( ztmix(:) - xtt ) ) * ( ztmix(:) - zwork1(:) )
5019  ptlcl(:) = min( ptlcl(:), ztmix(:) )
5020  zplcl(:) = xp00 * ( ptlcl(:) / pthlcl(:) ) ** zcpord
5021 !
5022 END WHERE
5023 !
5024  zplcl(:) = min( 2.e5, max( 10., zplcl(:) ) ) ! bound to avoid overflow
5025 !
5026 !
5027 !* 3.2 Correct PTLCL in order to be completely consistent
5028 ! with MNH saturation formula
5029 ! --------------------------------------------------
5030 !
5031  CALL convect_satmixratio( klon, zplcl, ptlcl, zwork1, zlv, zwork2, zcph )
5032  WHERE( owork1(:) )
5033  zwork2(:) = zwork1(:) / ptlcl(:) * ( xbetaw / ptlcl(:) - xgamw ) ! dr_sat/dT
5034  zwork2(:) = ( zwork1(:) - prvlcl(:) ) / &
5035  ( 1. + zlv(:) / zcph(:) * zwork2(:) )
5036  ptlcl(:) = ptlcl(:) - zlv(:) / zcph(:) * zwork2(:)
5037 !
5038  END WHERE
5039 !
5040 !
5041 !* 3.3 If PRVLCL is oversaturated set humidity and temperature
5042 ! to saturation values.
5043 ! -------------------------------------------------------
5044 !
5045  CALL convect_satmixratio( klon, zpresmix, ztmix, zwork1, zlv, zwork2, zcph )
5046  WHERE( owork1(:) .AND. prvlcl(:) > zwork1(:) )
5047  zwork2(:) = zwork1(:) / ztmix(:) * ( xbetaw / ztmix(:) - xgamw ) ! dr_sat/dT
5048  zwork2(:) = ( zwork1(:) - prvlcl(:) ) / &
5049  ( 1. + zlv(:) / zcph(:) * zwork2(:) )
5050  ptlcl(:) = ztmix(:) + zlv(:) / zcph(:) * zwork2(:)
5051  prvlcl(:) = prvlcl(:) - zwork2(:)
5052  zplcl(:) = zpresmix(:)
5053  pthlcl(:) = ptlcl(:) * ( xp00 / zplcl(:) ) ** zrdocp
5054  END WHERE
5055 !
5056 !
5057 !* 4.1 Determine vertical loop index at the LCL
5058 ! -----------------------------------------
5059 !
5060  DO jk = jkmin, ike - 1
5061  DO ji = 1, iie
5062  IF ( zplcl(ji) <= ppres(ji,jk) .AND. owork1(ji) ) THEN
5063  klcl(ji) = jk + 1
5064  pzlcl(ji) = pz(ji,jk+1)
5065  END IF
5066  END DO
5067  END DO
5068 !
5069 !
5070 !* 4.2 Estimate height and environmental temperature at LCL
5071 ! ----------------------------------------------------
5072 !
5073  DO ji = 1, iie
5074  jk = klcl(ji)
5075  jkm = jk - 1
5076  zdp(ji) = log( zplcl(ji) / ppres(ji,jkm) ) / &
5077  log( ppres(ji,jk) / ppres(ji,jkm) )
5078  zwork1(ji) = pth(ji,jk) * ( ppres(ji,jk) / xp00 ) ** zrdocp
5079  zwork2(ji) = pth(ji,jkm) * ( ppres(ji,jkm) / xp00 ) ** zrdocp
5080  zwork1(ji) = zwork2(ji) + ( zwork1(ji) - zwork2(ji) ) * zdp(ji)
5081  ! we compute the precise value of the LCL
5082  ! The precise height is between the levels KLCL and KLCL-1.
5083  zwork2(ji) = pz(ji,jkm) + ( pz(ji,jk) - pz(ji,jkm) ) * zdp(ji)
5084  END DO
5085  WHERE( owork1(:) )
5086  ptelcl(:) = zwork1(:)
5087  pzlcl(:) = zwork2(:)
5088  END WHERE
5089 !
5090 !
5091 !
5092 END SUBROUTINE convect_closure_thrvlcl
5093 ! ######spl
5094  SUBROUTINE convect_chem_transport( KLON, KLEV, KCH, PCH1, PCH1C, &
5095  kdpl, kpbl, klcl, kctl, klfs, kdbl, &
5096  pumf, puer, pudr, pdmf, pder, pddr, &
5097  ptimec, pdxdy, pmixf, plmass, pwsub,&
5098  kftsteps )
5099 ! #######################################################################
5100 !
5101 !!**** Compute modified chemical tracer values due to convective event
5102 !!
5103 !!
5104 !! PURPOSE
5105 !! -------
5106 !! The purpose of this routine is to determine the final adjusted
5107 !! environmental values of the chemical tracers
5108 !! The final convective tendencies can then be evaluated in the main
5109 !! routine DEEP_CONVECT by (PCH1C-PCH1)/PTIMEC
5110 !!
5111 !!
5112 !!** METHOD
5113 !! ------
5114 !! Identical to the computation of the conservative variables in the
5115 !! main deep convection code
5116 !!
5117 !! EXTERNAL
5118 !! --------
5119 !!
5120 !! IMPLICIT ARGUMENTS
5121 !! ------------------
5122 !! Module MODD_CST
5123 !! XG ! gravity constant
5124 !!
5125 !! Module MODD_CONVPAREXT
5126 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
5127 !!
5128 !! AUTHOR
5129 !! ------
5130 !! P. BECHTOLD * Laboratoire d'Aerologie *
5131 !!
5132 !! MODIFICATIONS
5133 !! -------------
5134 !!
5135 !! Original 11/12/97
5136 !!
5137 !-------------------------------------------------------------------------------
5138 !
5139 !* 0. DECLARATIONS
5140 ! ------------
5141 !
5142 USE modd_cst
5143 USE modd_convparext
5144 !
5145 IMPLICIT NONE
5146 !
5147 !* 0.1 Declarations of dummy arguments :
5148 !
5149 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
5150 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
5151 INTEGER, INTENT(IN) :: KCH ! number of passive tracers
5152 !
5153 REAL,DIMENSION(KLON,KLEV,KCH),INTENT(IN) :: PCH1 ! grid scale tracer concentr.
5154 REAL,DIMENSION(KLON,KLEV,KCH),INTENT(OUT):: PCH1C! conv adjusted tracer concntr.
5155 !
5156 INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
5157 INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
5158 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
5159 INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
5160 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
5161 INTEGER, DIMENSION(KLON), INTENT(IN) :: KDBL ! index for downdraft base level
5162 !
5163 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUMF ! updraft mass flux (kg/s)
5164 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUER ! updraft entrainment (kg/s)
5165 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUDR ! updraft detrainment (kg/s)
5166 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDMF ! downdraft mass flux (kg/s)
5167 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDER ! downdraft entrainment (kg/s)
5168 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDDR ! downdraft detrainment (kg/s)
5169 !
5170 REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC! convection time step
5171 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
5172 REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! mixed fraction at LFS
5173 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PLMASS! mass of model layer (kg)
5174 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PWSUB ! envir. compensating subsidence(Pa/s)
5175 INTEGER, INTENT(IN) :: KFTSTEPS ! maximum fractional time steps
5176 !
5177 !
5178 !* 0.2 Declarations of local variables :
5179 !
5180 INTEGER :: INCH1 ! number of chemical tracers
5181 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
5182 INTEGER :: IKS ! vertical dimension
5183 INTEGER :: JI ! horizontal loop index
5184 INTEGER :: JK, JKP ! vertical loop index
5185 INTEGER :: JN ! chemical tracer loop index
5186 INTEGER :: JSTEP ! fractional time loop index
5187 INTEGER :: JKLC, JKLD, JKLP, JKMAX ! loop index for levels
5188 !
5189 REAL, DIMENSION(KLON,KLEV) :: ZOMG ! compensat. subsidence (Pa/s)
5190 REAL, DIMENSION(KLON,KLEV,KCH) :: ZUCH1, ZDCH1 ! updraft/downdraft values
5191 REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
5192 REAL, DIMENSION(KLON,KLEV) :: ZTIMC! 2D work array for ZTIMEC
5193 REAL, DIMENSION(KLON,KLEV,KCH) :: ZCH1MFIN, ZCH1MFOUT
5194  ! work arrays for environm. compensat. mass
5195 REAL, DIMENSION(KLON,KCH) :: ZWORK1, ZWORK2, ZWORK3
5196 !
5197 !-------------------------------------------------------------------------------
5198 !
5199 !* 0.3 Compute loop bounds
5200 ! -------------------
5201 !
5202 inch1 = kch
5203 iie = klon
5204 ikb = 1 + jcvexb
5205 iks = klev
5206 ike = klev - jcvext
5207 jkmax = maxval( kctl(:) )
5208 !
5209 !
5210 !* 2. Updraft computations
5211 ! --------------------
5212 !
5213 zuch1(:,:,:) = 0.
5214 !
5215 !* 2.1 Initialization at LCL
5216 ! ----------------------------------
5217 !
5218 DO ji = 1, iie
5219  jklc = klcl(ji)
5220  jkld = kdpl(ji)
5221  jklp = kpbl(ji)
5222  zwork1(ji,:) = .5 * ( pch1(ji,jkld,:) + pch1(ji,jklp,:) )
5223 END DO
5224 !
5225 !* 2.2 Final updraft loop
5226 ! ------------------
5227 !
5228 DO jk = minval( kdpl(:) ), jkmax
5229 jkp = jk + 1
5230 !
5231  DO jn = 1, inch1
5232  DO ji = 1, iie
5233  IF ( kdpl(ji) <= jk .AND. klcl(ji) > jk ) &
5234  zuch1(ji,jk,jn) = zwork1(ji,jn)
5235 !
5236  IF ( klcl(ji) - 1 <= jk .AND. kctl(ji) > jk ) THEN
5237  !if you have reactive i.e. non-passive tracers
5238  !add the corresponding sink term in the following equation
5239  zuch1(ji,jkp,jn) = ( pumf(ji,jk) * zuch1(ji,jk,jn) + &
5240  puer(ji,jkp) * pch1(ji,jk,jn) ) / &
5241  ( pumf(ji,jkp) + pudr(ji,jkp) + 1.e-7 )
5242  END IF
5243  END DO
5244  END DO
5245 !
5246 END DO
5247 !
5248 !* 3. Downdraft computations
5249 ! ----------------------
5250 !
5251 zdch1(:,:,:) = 0.
5252 !
5253 !* 3.1 Initialization at the LFS
5254 ! -------------------------
5255 !
5256 zwork1(:,:) = spread( pmixf(:), dim=2, ncopies=inch1 )
5257 DO ji = 1, iie
5258  jk = klfs(ji)
5259  zdch1(ji,jk,:) = zwork1(ji,:) * pch1(ji,jk,:) + &
5260  ( 1. - zwork1(ji,:) ) * zuch1(ji,jk,:)
5261 END DO
5262 !
5263 !* 3.2 Final downdraft loop
5264 ! --------------------
5265 !
5266 DO jk = maxval( klfs(:) ), ikb + 1, -1
5267 jkp = jk - 1
5268  DO jn = 1, inch1
5269  DO ji = 1, iie
5270  IF ( jk <= klfs(ji) .AND. jkp >= kdbl(ji) ) THEN
5271  zdch1(ji,jkp,jn) = ( zdch1(ji,jk,jn) * pdmf(ji,jk) - &
5272  pch1(ji,jk,jn) * pder(ji,jkp) ) / &
5273  ( pdmf(ji,jkp) - pddr(ji,jkp) - 1.e-7 )
5274  END IF
5275  END DO
5276  END DO
5277 END DO
5278 !
5279 !
5280 !* 4. Final closure (environmental) computations
5281 ! ------------------------------------------
5282 !
5283 pch1c(:,ikb:ike,:) = pch1(:,ikb:ike,:) ! initialize adjusted envir. values
5284 !
5285 DO jk = ikb, ike
5286  zomg(:,jk) = pwsub(:,jk) * pdxdy(:) / xg ! environmental subsidence
5287 END DO
5288 !
5289 ztimec(:) = ptimec(:) / REAL( KFTSTEPS ) ! adjust fractional time step
5290  ! to be an integer multiple of PTIMEC
5291 WHERE ( ptimec(:) < 1. ) ztimec(:) = 0.
5292 ztimc(:,:)= spread( ztimec(:), dim=2, ncopies=iks )
5293 !
5294 zch1mfin(:,:,:) = 0.
5295 zch1mfout(:,:,:) = 0.
5296 !
5297 DO jstep = 1, kftsteps ! Enter the fractional time step loop
5298 !
5299  DO jk = ikb + 1, jkmax
5300  jkp = max( ikb + 1, jk - 1 )
5301  zwork3(:,:) = spread( zomg(:,jk), dim=2, ncopies=inch1 )
5302  zwork1(:,:) = sign( 1., zwork3(:,:) )
5303  zwork2(:,:) = 0.5 * ( 1. + zwork1(:,:) )
5304  zwork1(:,:) = 0.5 * ( 1. - zwork1(:,:) )
5305  zch1mfin(:,jk,:) = - zwork3(:,:) * pch1c(:,jkp,:) * zwork1(:,:)
5306  zch1mfout(:,jk,:) = zwork3(:,:) * pch1c(:,jk,:) * zwork2(:,:)
5307  zch1mfin(:,jkp,:) = zch1mfin(:,jkp,:) + zch1mfout(:,jk,:) * zwork2(:,:)
5308  zch1mfout(:,jkp,:)= zch1mfout(:,jkp,:) + zch1mfin(:,jk,:) * zwork1(:,:)
5309  END DO
5310 !
5311  DO jn = 1, inch1
5312  DO jk = ikb + 1, jkmax
5313  pch1c(:,jk,jn) = pch1c(:,jk,jn) + ztimc(:,jk) / plmass(:,jk) * ( &
5314  zch1mfin(:,jk,jn) + pudr(:,jk) * zuch1(:,jk,jn) + &
5315  pddr(:,jk) * zdch1(:,jk,jn) - zch1mfout(:,jk,jn) - &
5316  ( puer(:,jk) + pder(:,jk) ) * pch1(:,jk,jn) )
5317  pch1c(:,jk,jn) = max( 0., pch1c(:,jk,jn) )
5318  END DO
5319  END DO
5320 !
5321 END DO ! Exit the fractional time step loop
5322 !
5323 !
5324 END SUBROUTINE convect_chem_transport
5325 ! ######spl
5326  MODULE modd_convpar_shal
5327 ! ########################
5328 !
5329 !!**** *MODD_CONVPAR_SHAL* - Declaration of convection constants
5330 !!
5331 !! PURPOSE
5332 !! -------
5333 !! The purpose of this declarative module is to declare the
5334 !! constants in the deep convection parameterization.
5335 !!
5336 !!
5337 !!** IMPLICIT ARGUMENTS
5338 !! ------------------
5339 !! None
5340 !!
5341 !! REFERENCE
5342 !! ---------
5343 !! Book2 of documentation of Meso-NH (MODD_CONVPAR_SHAL)
5344 !!
5345 !! AUTHOR
5346 !! ------
5347 !! P. Bechtold *Laboratoire d'Aerologie*
5348 !!
5349 !! MODIFICATIONS
5350 !! -------------
5351 !! Original 26/03/96
5352 !! Last modified 04/10/98
5353 !-------------------------------------------------------------------------------
5354 !
5355 !* 0. DECLARATIONS
5356 ! ------------
5357 !
5358 IMPLICIT NONE
5359 !
5360 REAL, SAVE :: xa25 ! 25 km x 25 km reference grid area
5361 !
5362 REAL, SAVE :: xcrad ! cloud radius
5363 REAL, SAVE :: xctime_shal ! convective adjustment time
5364 REAL, SAVE :: xcdepth ! minimum necessary cloud depth
5365 REAL, SAVE :: xcdepth_d ! maximum allowed cloud thickness
5366 REAL, SAVE :: xdtpert ! add small Temp perturb. at LCL
5367 REAL, SAVE :: xentr ! entrainment constant (m/Pa) = 0.2 (m)
5368 !
5369 REAL, SAVE :: xzlcl ! maximum allowed allowed height
5370  ! difference between departure level and surface
5371 REAL, SAVE :: xzpbl ! minimum mixed layer depth to sustain convection
5372 REAL, SAVE :: xwtrig ! constant in vertical velocity trigger
5373 !
5374 !
5375 REAL, SAVE :: xnhgam ! accounts for non-hydrost. pressure
5376  ! in buoyancy term of w equation
5377  ! = 2 / (1+gamma)
5378 REAL, SAVE :: xtfrz1 ! begin of freezing interval
5379 REAL, SAVE :: xtfrz2 ! end of freezing interval
5380 !
5381 !
5382 REAL, SAVE :: xstabt ! factor to assure stability in fractional time
5383  ! integration, routine CONVECT_CLOSURE
5384 REAL, SAVE :: xstabc ! factor to assure stability in CAPE adjustment,
5385  ! routine CONVECT_CLOSURE
5386 !
5387 END MODULE modd_convpar_shal
5388 ! ######spl
5389  SUBROUTINE ini_convpar_shal
5390 ! ###########################
5391 !
5392 !!**** *INI_CONVPAR * - routine to initialize the constants modules
5393 !!
5394 !! PURPOSE
5395 !! -------
5396 !! The purpose of this routine is to initialize the constants
5397 !! stored in modules MODD_CONVPAR_SHAL
5398 !!
5399 !!
5400 !!** METHOD
5401 !! ------
5402 !! The shallow convection constants are set to their numerical values
5403 !!
5404 !!
5405 !! EXTERNAL
5406 !! --------
5407 !!
5408 !! IMPLICIT ARGUMENTS
5409 !! ------------------
5410 !! Module MODD_CONVPAR_SHAL : contains deep convection constants
5411 !!
5412 !! REFERENCE
5413 !! ---------
5414 !! Book2 of the documentation (module MODD_CONVPAR_SHAL, routine INI_CONVPAR)
5415 !!
5416 !!
5417 !! AUTHOR
5418 !! ------
5419 !! P. BECHTOLD * Laboratoire d'Aerologie *
5420 !!
5421 !! MODIFICATIONS
5422 !! -------------
5423 !! Original 26/03/96
5424 !! Last modified 15/04/98 adapted for ARPEGE
5425 !-------------------------------------------------------------------------------
5426 !
5427 !* 0. DECLARATIONS
5428 ! ------------
5429 !
5430 USE modd_convpar_shal
5431 !
5432 IMPLICIT NONE
5433 !
5434 !-------------------------------------------------------------------------------
5435 !
5436 !* 1. Set the thermodynamical and numerical constants for
5437 ! the deep convection parameterization
5438 ! ---------------------------------------------------
5439 !
5440 !
5441 xa25 = 625.e6 ! 25 km x 25 km reference grid area
5442 !
5443 xcrad = 50. ! cloud radius
5444 xctime_shal = 10800. ! convective adjustment time
5445 xcdepth = 0.5e3 ! minimum necessary shallow cloud depth
5446 xcdepth_d = 3.0e3 ! maximum allowed shallow cloud depth
5447 xdtpert = .2 ! add small Temp perturbation at LCL
5448 !
5449 xentr = 0.02 ! entrainment constant (m/Pa) = 0.2 (m)
5450 !
5451 xzlcl = 1.5e3 ! maximum allowed allowed height
5452  ! difference between the DPL and the LCL
5453 xzpbl = 50.e2 ! minimum mixed layer depth to sustain convection
5454 !
5455 !
5456 xnhgam = 1.3333 ! accounts for non-hydrost. pressure
5457  ! in buoyancy term of w equation
5458  ! = 2 / (1+gamma)
5459 xtfrz1 = 268.16 ! begin of freezing interval
5460 xtfrz2 = 248.16 ! end of freezing interval
5461 !
5462 
5463 xstabt = 0.75 ! factor to assure stability in fractional time
5464  ! integration, routine CONVECT_CLOSURE
5465 xstabc = 0.95 ! factor to assure stability in CAPE adjustment,
5466  ! routine CONVECT_CLOSURE
5467 !
5468 !
5469 END SUBROUTINE ini_convpar_shal
5470 ! ######spl
5471  SUBROUTINE convect_shallow( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, &
5472  pdtconv, kice, osettadj, ptadjs, &
5473  ppabst, pzz, &
5474  ptt, prvt, prct, prit, pwt, &
5475  ptten, prvten, prcten, priten, &
5476  kcltop, kclbas, pumf, &
5477  och1conv, kch1, pch1, pch1ten )
5478 ! ############################################################################
5479 !
5480 !!**** Monitor routine to compute all convective tendencies by calls
5481 !! of several subroutines.
5482 !!
5483 !!
5484 !! PURPOSE
5485 !! -------
5486 !! The purpose of this routine is to determine the convective
5487 !! tendencies. The routine first prepares all necessary grid-scale
5488 !! variables. The final convective tendencies are then computed by
5489 !! calls of different subroutines.
5490 !!
5491 !!
5492 !!** METHOD
5493 !! ------
5494 !! We start by selecting convective columns in the model domain through
5495 !! the call of routine TRIGGER_FUNCT. Then, we allocate memory for the
5496 !! convection updraft and downdraft variables and gather the grid scale
5497 !! variables in convective arrays.
5498 !! The updraft and downdraft computations are done level by level starting
5499 !! at the bottom and top of the domain, respectively.
5500 !! All computations are done on MNH thermodynamic levels. The depth
5501 !! of the current model layer k is defined by DP(k)=P(k-1)-P(k)
5502 !!
5503 !!
5504 !!
5505 !! EXTERNAL
5506 !! --------
5507 !! CONVECT_TRIGGER_SHAL
5508 !! CONVECT_SATMIXRATIO
5509 !! CONVECT_UPDRAFT_SHAL
5510 !! CONVECT_CONDENS
5511 !! CONVECT_MIXING_FUNCT
5512 !! CONVECT_CLOSURE_SHAL
5513 !! CONVECT_CLOSURE_THRVLCL
5514 !! CONVECT_CLOSURE_ADJUST_SHAL
5515 !!
5516 !! IMPLICIT ARGUMENTS
5517 !! ------------------
5518 !! Module MODD_CST
5519 !! XG ! gravity constant
5520 !! XPI ! number Pi
5521 !! XP00 ! reference pressure
5522 !! XRD, XRV ! gaz constants for dry air and water vapor
5523 !! XCPD, XCPV ! specific heat for dry air and water vapor
5524 !! XRHOLW ! density of liquid water
5525 !! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
5526 !! XTT ! triple point temperature
5527 !! XLVTT, XLSTT ! vaporization, sublimation heat constant
5528 !! XCL, XCI ! specific heat for liquid water and ice
5529 !!
5530 !! Module MODD_CONVPAREXT
5531 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
5532 !!
5533 !! Module MODD_CONVPAR
5534 !! XA25 ! reference grid area
5535 !! XCRAD ! cloud radius
5536 !!
5537 !!
5538 !! REFERENCE
5539 !! ---------
5540 !!
5541 !! Bechtold, 1997 : Meso-NH scientific documentation (31 pp)
5542 !! Fritsch and Chappell, 1980, J. Atmos. Sci., Vol. 37, 1722-1761.
5543 !! Kain and Fritsch, 1990, J. Atmos. Sci., Vol. 47, 2784-2801.
5544 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol. 24, 165-170.
5545 !!
5546 !! AUTHOR
5547 !! ------
5548 !! P. BECHTOLD * Laboratoire d'Aerologie *
5549 !!
5550 !! MODIFICATIONS
5551 !! -------------
5552 !! Original 26/03/96
5553 !! Peter Bechtold 15/11/96 replace theta_il by enthalpy
5554 !! " 10/12/98 changes for ARPEGE
5555 !-------------------------------------------------------------------------------
5556 !
5557 !* 0. DECLARATIONS
5558 ! ------------
5559 !
5560 USE modd_cst
5561 USE modd_convparext
5562 USE modd_convpar_shal
5563 !
5564 !
5565 IMPLICIT NONE
5566 !
5567 !* 0.1 Declarations of dummy arguments :
5568 !
5569 !
5570 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
5571 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
5572 INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
5573 INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
5574 INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
5575 ! ! KBDIA that is at least 1
5576 INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
5577  ! limited to KLEV + 1 - KTDIA
5578  ! default=1
5579 REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
5580  ! calls of the deep convection
5581  ! scheme
5582 INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
5583  ! 0 = no ice )
5584 LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
5585  ! adjustment time by user
5586 REAL, INTENT(IN) :: PTADJS ! user defined adjustment time
5587 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT ! grid scale temperature at t
5588 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT ! grid scale water vapor "
5589 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT ! grid scale r_c "
5590 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT ! grid scale r_i "
5591 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical
5592  ! velocity (m/s)
5593 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t
5594 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
5595 !
5596 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperature
5597  ! tendency (K/s)
5598 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
5599 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
5600 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
5601 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLTOP ! cloud top level
5602 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCLBAS ! cloud base level
5603  ! they are given a value of
5604  ! 0 if no convection
5605 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s m2)
5606 !
5607 LOGICAL, INTENT(IN) :: OCH1CONV ! include tracer transport
5608 INTEGER, INTENT(IN) :: KCH1 ! number of species
5609 REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
5610 REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
5611 !
5612 !
5613 !* 0.2 Declarations of local fixed memory variables :
5614 !
5615 INTEGER :: ITEST, ICONV, ICONV1 ! number of convective columns
5616 INTEGER :: IIB, IIE ! horizontal loop bounds
5617 INTEGER :: IKB, IKE ! vertical loop bounds
5618 INTEGER :: IKS ! vertical dimension
5619 INTEGER :: JI, JL ! horizontal loop index
5620 INTEGER :: JN ! number of tracers
5621 INTEGER :: JK, JKP, JKM ! vertical loop index
5622 INTEGER :: IFTSTEPS ! only used for chemical tracers
5623 REAL :: ZEPS, ZEPSA, ZEPSB ! R_d / R_v, R_v / R_d, XCPV / XCPD - ZEPSA
5624 REAL :: ZCPORD, ZRDOCP ! C_p/R_d, R_d/C_p
5625 !
5626 LOGICAL, DIMENSION(KLON, KLEV) :: GTRIG3 ! 3D logical mask for convection
5627 LOGICAL, DIMENSION(KLON) :: GTRIG ! 2D logical mask for trigger test
5628 REAL, DIMENSION(KLON,KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta, theta_v
5629 REAL, DIMENSION(KLON) :: ZTIME ! convective time period
5630 REAL, DIMENSION(KLON) :: ZWORK2, ZWORK2B ! work array
5631 !
5632 !
5633 !* 0.2 Declarations of local allocatable variables :
5634 !
5635 INTEGER, DIMENSION(:),ALLOCATABLE :: IDPL ! index for parcel departure level
5636 INTEGER, DIMENSION(:),ALLOCATABLE :: IPBL ! index for source layer top
5637 INTEGER, DIMENSION(:),ALLOCATABLE :: ILCL ! index for lifting condensation level
5638 INTEGER, DIMENSION(:),ALLOCATABLE :: IETL ! index for zero buoyancy level
5639 INTEGER, DIMENSION(:),ALLOCATABLE :: ICTL ! index for cloud top level
5640 INTEGER, DIMENSION(:),ALLOCATABLE :: ILFS ! index for level of free sink
5641 !
5642 INTEGER, DIMENSION(:), ALLOCATABLE :: ISDPL ! index for parcel departure level
5643 INTEGER, DIMENSION(:),ALLOCATABLE :: ISPBL ! index for source layer top
5644 INTEGER, DIMENSION(:), ALLOCATABLE :: ISLCL ! index for lifting condensation level
5645 REAL, DIMENSION(:), ALLOCATABLE :: ZSTHLCL ! updraft theta at LCL
5646 REAL, DIMENSION(:), ALLOCATABLE :: ZSTLCL ! updraft temp. at LCL
5647 REAL, DIMENSION(:), ALLOCATABLE :: ZSRVLCL ! updraft rv at LCL
5648 REAL, DIMENSION(:), ALLOCATABLE :: ZSWLCL ! updraft w at LCL
5649 REAL, DIMENSION(:), ALLOCATABLE :: ZSZLCL ! LCL height
5650 REAL, DIMENSION(:), ALLOCATABLE :: ZSTHVELCL! envir. theta_v at LCL
5651 REAL, DIMENSION(:), ALLOCATABLE :: ZSDXDY ! grid area (m^2)
5652 !
5653 ! grid scale variables
5654 REAL, DIMENSION(:,:), ALLOCATABLE :: ZZ ! height of model layer (m)
5655 REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES ! grid scale pressure
5656 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! pressure difference between
5657  ! bottom and top of layer (Pa)
5658 REAL, DIMENSION(:,:), ALLOCATABLE :: ZW ! grid scale vertical velocity on theta grid
5659 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTT ! temperature
5660 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH ! grid scale theta
5661 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHV ! grid scale theta_v
5662 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHL ! grid scale enthalpy (J/kg)
5663 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHES, ZTHEST ! grid scale saturated theta_e
5664 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRW ! grid scale total water (kg/kg)
5665 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRV ! grid scale water vapor (kg/kg)
5666 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRC ! grid scale cloud water (kg/kg)
5667 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRI ! grid scale cloud ice (kg/kg)
5668 REAL, DIMENSION(:), ALLOCATABLE :: ZDXDY ! grid area (m^2)
5669 !
5670 ! updraft variables
5671 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUMF ! updraft mass flux (kg/s)
5672 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUER ! updraft entrainment (kg/s)
5673 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUDR ! updraft detrainment (kg/s)
5674 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHL ! updraft enthalpy (J/kg)
5675 REAL, DIMENSION(:,:), ALLOCATABLE :: ZUTHV ! updraft theta_v (K)
5676 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURW ! updraft total water (kg/kg)
5677 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURC ! updraft cloud water (kg/kg)
5678 REAL, DIMENSION(:,:), ALLOCATABLE :: ZURI ! updraft cloud ice (kg/kg)
5679 REAL, DIMENSION(:), ALLOCATABLE :: ZMFLCL ! cloud base unit mass flux(kg/s)
5680 REAL, DIMENSION(:), ALLOCATABLE :: ZCAPE ! available potent. energy
5681 REAL, DIMENSION(:), ALLOCATABLE :: ZTHLCL ! updraft theta at LCL
5682 REAL, DIMENSION(:), ALLOCATABLE :: ZTLCL ! updraft temp. at LCL
5683 REAL, DIMENSION(:), ALLOCATABLE :: ZRVLCL ! updraft rv at LCL
5684 REAL, DIMENSION(:), ALLOCATABLE :: ZWLCL ! updraft w at LCL
5685 REAL, DIMENSION(:), ALLOCATABLE :: ZZLCL ! LCL height
5686 REAL, DIMENSION(:), ALLOCATABLE :: ZTHVELCL! envir. theta_v at LCL
5687 !
5688 ! downdraft variables
5689 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDMF ! downdraft mass flux (kg/s)
5690 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDER ! downdraft entrainment (kg/s)
5691 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDDR ! downdraft detrainment (kg/s)
5692 !
5693 ! closure variables
5694 REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMASS ! mass of model layer (kg)
5695 REAL, DIMENSION(:), ALLOCATABLE :: ZTIMEC ! advective time period
5696 !
5697 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHC ! conv. adj. grid scale theta
5698 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRVC ! conv. adj. grid scale r_w
5699 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c
5700 REAL, DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i
5701 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s)
5702 !
5703 LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection
5704 LOGICAL, DIMENSION(:),ALLOCATABLE :: GWORK ! logical work array
5705 INTEGER, DIMENSION(:),ALLOCATABLE :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX!hor.index
5706 REAL, DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph
5707 REAL, DIMENSION(:), ALLOCATABLE :: ZLV, ZLS! latent heat of vaporis., sublim.
5708 REAL :: ZES ! saturation vapor mixng ratio
5709 REAl :: ZW1 ! work variable
5710 !
5711 ! Chemical Tracers:
5712 REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg)
5713 REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1
5714 REAL, DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! conv. adjust. chemical specy 1
5715 LOGICAL, DIMENSION(:,:,:),ALLOCATABLE::GTRIG4 ! logical mask
5716 !
5717 !-------------------------------------------------------------------------------
5718 !
5719 !
5720 !* 0.3 Compute loop bounds
5721 ! -------------------
5722 !
5723 iib = kidia
5724 iie = kfdia
5725 jcvexb = max( 0, kbdia - 1 )
5726 ikb = 1 + jcvexb
5727 iks = klev
5728 jcvext = max( 0, ktdia - 1)
5729 ike = iks - jcvext
5730 !
5731 !
5732 !* 0.5 Update convective counter ( where KCOUNT > 0
5733 ! convection is still active ).
5734 ! ---------------------------------------------
5735 !
5736 gtrig(:) = .false.
5737 gtrig(iib:iie) = .true.
5738 itest = count( gtrig(:) )
5739 IF ( itest == 0 ) RETURN
5740 
5741 !
5742 !
5743 !* 0.7 Reset convective tendencies to zero if convective
5744 ! counter becomes negative
5745 ! -------------------------------------------------
5746 !
5747 gtrig3(:,:) = spread( gtrig(:), dim=2, ncopies=iks )
5748 WHERE ( gtrig3(:,:) )
5749  ptten(:,:) = 0.
5750  prvten(:,:) = 0.
5751  prcten(:,:) = 0.
5752  priten(:,:) = 0.
5753 ! PUTEN(:,:) = 0.
5754 ! PVTEN(:,:) = 0.
5755  pumf(:,:) = 0.
5756 END WHERE
5757 WHERE ( gtrig(:) )
5758  ! KCLTOP(:) = 0 ! already initialized in CONVECTION
5759  ! KCLBAS(:) = 0
5760 END WHERE
5761 IF ( och1conv ) THEN
5762  ALLOCATE( gtrig4(klon,klev,kch1) )
5763  gtrig4(:,:,:) = spread( gtrig3(:,:), dim=3, ncopies=kch1 )
5764  WHERE( gtrig4(:,:,:) ) pch1ten(:,:,:) = 0.
5765  DEALLOCATE( gtrig4 )
5766 END IF
5767 !
5768 !
5769 !* 1. Initialize local variables
5770 ! ----------------------------
5771 !
5772 zeps = xrd / xrv
5773 zepsa = xrv / xrd
5774 zepsb = xcpv / xcpd - zepsa
5775 zcpord = xcpd / xrd
5776 zrdocp = xrd / xcpd
5777 !
5778 !
5779 !* 1.1 Set up grid scale theta, theta_v, theta_es
5780 ! ------------------------------------------
5781 !
5782 ztht(:,:) = 300.
5783 zsthv(:,:)= 300.
5784 zsthes(:,:) = 400.
5785 DO jk = ikb, ike
5786 DO ji = iib, iie
5787  IF ( ppabst(ji,jk) > 40.e2 ) THEN
5788  ztht(ji,jk) = ptt(ji,jk) * ( xp00 / ppabst(ji,jk) ) ** zrdocp
5789  zsthv(ji,jk) = ztht(ji,jk) * ( 1. + zepsa * prvt(ji,jk) ) / &
5790  ( 1. + prvt(ji,jk) + prct(ji,jk) + prit(ji,jk) )
5791 !
5792  ! use conservative Bolton (1980) formula for theta_e
5793  ! it is used to compute CAPE for undilute parcel ascent
5794  ! For economical reasons we do not use routine CONVECT_SATMIXRATIO here
5795 !
5796  zes = exp( xalpw - xbetaw / ptt(ji,jk) - xgamw * log( ptt(ji,jk) ) )
5797  zes = min( 1., zeps * zes / ( ppabst(ji,jk) - zes ) )
5798  zsthes(ji,jk) = ptt(ji,jk) * ( ztht(ji,jk) / ptt(ji,jk) ) ** &
5799  ( 1. - 0.28 * zes ) * exp( min(500., &
5800  ( 3374.6525 / ptt(ji,jk) - 2.5403 ) &
5801  * zes * ( 1. + 0.81 * zes ) ) )
5802  END IF
5803 END DO
5804 END DO
5805 !
5806 !
5807 !
5808 !* 2. Test for convective columns and determine properties at the LCL
5809 ! --------------------------------------------------------------
5810 !
5811 !* 2.1 Allocate arrays depending on number of model columns that need
5812 ! to be tested for convection (i.e. where no convection is present
5813 ! at the moment.
5814 ! --------------------------------------------------------------
5815 !
5816  ALLOCATE( zpres(itest,iks) )
5817  ALLOCATE( zz(itest,iks) )
5818  ALLOCATE( zw(itest,iks) )
5819  ALLOCATE( zth(itest,iks) )
5820  ALLOCATE( zthv(itest,iks) )
5821  ALLOCATE( zthest(itest,iks) )
5822  ALLOCATE( zrv(itest,iks) )
5823  ALLOCATE( zsthlcl(itest) )
5824  ALLOCATE( zstlcl(itest) )
5825  ALLOCATE( zsrvlcl(itest) )
5826  ALLOCATE( zswlcl(itest) )
5827  ALLOCATE( zszlcl(itest) )
5828  ALLOCATE( zsthvelcl(itest) )
5829  ALLOCATE( isdpl(itest) )
5830  ALLOCATE( ispbl(itest) )
5831  ALLOCATE( islcl(itest) )
5832  ALLOCATE( zsdxdy(itest) )
5833  ALLOCATE( gtrig1(itest) )
5834  ALLOCATE( iindex(klon) )
5835  ALLOCATE( ijsindex(itest) )
5836  DO ji = 1, klon
5837  iindex(ji) = ji
5838  END DO
5839  ijsindex(:) = pack( iindex(:), mask=gtrig(:) )
5840 !
5841  DO jk = ikb, ike
5842  DO ji = 1, itest
5843  jl = ijsindex(ji)
5844  zpres(ji,jk) = ppabst(jl,jk)
5845  zz(ji,jk) = pzz(jl,jk)
5846  zth(ji,jk) = ztht(jl,jk)
5847  zthv(ji,jk) = zsthv(jl,jk)
5848  zthest(ji,jk) = zsthes(jl,jk)
5849  zrv(ji,jk) = max( 0., prvt(jl,jk) )
5850  zw(ji,jk) = pwt(jl,jk)
5851  END DO
5852  END DO
5853  DO ji = 1, itest
5854  jl = ijsindex(ji)
5855  zsdxdy(ji) = xa25
5856  END DO
5857 !
5858 !* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c
5859 ! and envir. saturation theta_e
5860 ! ------------------------------------------------------------
5861 !
5862 !
5863 !* 2.3 Test for convective columns and determine properties at the LCL
5864 ! --------------------------------------------------------------
5865 !
5866  islcl(:) = max( ikb, 2 ) ! initialize DPL PBL and LCL
5867  isdpl(:) = ikb
5868  ispbl(:) = ikb
5869 !
5870  CALL convect_trigger_shal( itest, klev, &
5871  zpres, zth, zthv, zthest, &
5872  zrv, zw, zz, zsdxdy, &
5873  zsthlcl, zstlcl, zsrvlcl, zswlcl, zszlcl, &
5874  zsthvelcl, islcl, isdpl, ispbl, gtrig1 )
5875 !
5876  DEALLOCATE( zpres )
5877  DEALLOCATE( zz )
5878  DEALLOCATE( zth )
5879  DEALLOCATE( zthv )
5880  DEALLOCATE( zthest )
5881  DEALLOCATE( zrv )
5882  DEALLOCATE( zw )
5883 !
5884 !
5885 !* 3. After the call of TRIGGER_FUNCT we allocate all the dynamic
5886 ! arrays used in the convection scheme using the mask GTRIG, i.e.
5887 ! we do calculus only in convective columns. This corresponds to
5888 ! a GATHER operation.
5889 ! --------------------------------------------------------------
5890 !
5891  iconv = count( gtrig1(:) )
5892  IF ( iconv == 0 ) THEN
5893  DEALLOCATE( zsthlcl )
5894  DEALLOCATE( zstlcl )
5895  DEALLOCATE( zsrvlcl )
5896  DEALLOCATE( zswlcl )
5897  DEALLOCATE( zszlcl )
5898  DEALLOCATE( zsthvelcl )
5899  DEALLOCATE( zsdxdy )
5900  DEALLOCATE( islcl )
5901  DEALLOCATE( isdpl )
5902  DEALLOCATE( ispbl )
5903  DEALLOCATE( gtrig1 )
5904  DEALLOCATE( iindex )
5905  DEALLOCATE( ijsindex )
5906  RETURN ! no convective column has been found, exit CONVECT_SHALLOW
5907  ENDIF
5908 !
5909  ! vertical index variables
5910 !
5911  ALLOCATE( idpl(iconv) )
5912  ALLOCATE( ipbl(iconv) )
5913  ALLOCATE( ilcl(iconv) )
5914  ALLOCATE( ictl(iconv) )
5915  ALLOCATE( ietl(iconv) )
5916 !
5917  ! grid scale variables
5918 !
5919  ALLOCATE( zz(iconv,iks) )
5920  ALLOCATE( zpres(iconv,iks) )
5921  ALLOCATE( zdpres(iconv,iks) )
5922  ALLOCATE( ztt(iconv, iks) )
5923  ALLOCATE( zth(iconv,iks) )
5924  ALLOCATE( zthv(iconv,iks) )
5925  ALLOCATE( zthl(iconv,iks) )
5926  ALLOCATE( zthes(iconv,iks) )
5927  ALLOCATE( zrv(iconv,iks) )
5928  ALLOCATE( zrc(iconv,iks) )
5929  ALLOCATE( zri(iconv,iks) )
5930  ALLOCATE( zrw(iconv,iks) )
5931  ALLOCATE( zdxdy(iconv) )
5932 !
5933  ! updraft variables
5934 !
5935  ALLOCATE( zumf(iconv,iks) )
5936  ALLOCATE( zuer(iconv,iks) )
5937  ALLOCATE( zudr(iconv,iks) )
5938  ALLOCATE( zuthl(iconv,iks) )
5939  ALLOCATE( zuthv(iconv,iks) )
5940  ALLOCATE( zurw(iconv,iks) )
5941  ALLOCATE( zurc(iconv,iks) )
5942  ALLOCATE( zuri(iconv,iks) )
5943  ALLOCATE( zthlcl(iconv) )
5944  ALLOCATE( ztlcl(iconv) )
5945  ALLOCATE( zrvlcl(iconv) )
5946  ALLOCATE( zwlcl(iconv) )
5947  ALLOCATE( zmflcl(iconv) )
5948  ALLOCATE( zzlcl(iconv) )
5949  ALLOCATE( zthvelcl(iconv) )
5950  ALLOCATE( zcape(iconv) )
5951 !
5952  ! work variables
5953 !
5954  ALLOCATE( ijindex(iconv) )
5955  ALLOCATE( ijpindex(iconv) )
5956  ALLOCATE( zcph(iconv) )
5957  ALLOCATE( zlv(iconv) )
5958  ALLOCATE( zls(iconv) )
5959 !
5960 !
5961 !* 3.1 Gather grid scale and updraft base variables in
5962 ! arrays using mask GTRIG
5963 ! ---------------------------------------------------
5964 !
5965  gtrig(:) = unpack( gtrig1(:), mask=gtrig(:), field=.false. )
5966  ijindex(:) = pack( iindex(:), mask=gtrig(:) )
5967 !
5968  DO jk = ikb, ike
5969  DO ji = 1, iconv
5970  jl = ijindex(ji)
5971  zz(ji,jk) = pzz(jl,jk)
5972  zpres(ji,jk) = ppabst(jl,jk)
5973  ztt(ji,jk) = ptt(jl,jk)
5974  zth(ji,jk) = ztht(jl,jk)
5975  zthes(ji,jk) = zsthes(jl,jk)
5976  zrv(ji,jk) = max( 0., prvt(jl,jk) )
5977  zrc(ji,jk) = max( 0., prct(jl,jk) )
5978  zri(ji,jk) = max( 0., prit(jl,jk) )
5979  zthv(ji,jk) = zsthv(jl,jk)
5980  END DO
5981  END DO
5982 !
5983  DO ji = 1, itest
5984  ijsindex(ji) = ji
5985  END DO
5986  ijpindex(:) = pack( ijsindex(:), mask=gtrig1(:) )
5987  DO ji = 1, iconv
5988  jl = ijpindex(ji)
5989  idpl(ji) = isdpl(jl)
5990  ipbl(ji) = ispbl(jl)
5991  ilcl(ji) = islcl(jl)
5992  zthlcl(ji) = zsthlcl(jl)
5993  ztlcl(ji) = zstlcl(jl)
5994  zrvlcl(ji) = zsrvlcl(jl)
5995  zwlcl(ji) = zswlcl(jl)
5996  zzlcl(ji) = zszlcl(jl)
5997  zthvelcl(ji) = zsthvelcl(jl)
5998  zdxdy(ji) = zsdxdy(jl)
5999  END DO
6000  ALLOCATE( gwork(iconv) )
6001  gwork(:) = pack( gtrig1(:), mask=gtrig1(:) )
6002  DEALLOCATE( gtrig1 )
6003  ALLOCATE( gtrig1(iconv) )
6004  gtrig1(:) = gwork(:)
6005 !
6006  DEALLOCATE( gwork )
6007  DEALLOCATE( ijpindex )
6008  DEALLOCATE( isdpl )
6009  DEALLOCATE( ispbl )
6010  DEALLOCATE( islcl )
6011  DEALLOCATE( zsthlcl )
6012  DEALLOCATE( zstlcl )
6013  DEALLOCATE( zsrvlcl )
6014  DEALLOCATE( zswlcl )
6015  DEALLOCATE( zszlcl )
6016  DEALLOCATE( zsthvelcl )
6017  DEALLOCATE( zsdxdy )
6018 !
6019 !
6020 !* 3.2 Compute pressure difference
6021 ! ---------------------------------------------------
6022 !
6023  zdpres(:,ikb) = 0.
6024  DO jk = ikb + 1, ike
6025  zdpres(:,jk) = zpres(:,jk-1) - zpres(:,jk)
6026  END DO
6027 !
6028 !* 3.3 Compute environm. enthalpy and total water = r_v + r_i + r_c
6029 ! ----------------------------------------------------------
6030 !
6031  DO jk = ikb, ike, 1
6032  zrw(:,jk) = zrv(:,jk) + zrc(:,jk) + zri(:,jk)
6033  zcph(:) = xcpd + xcpv * zrw(:,jk)
6034  zlv(:) = xlvtt + ( xcpv - xcl ) * ( ztt(:,jk) - xtt ) ! compute L_v
6035  zls(:) = xlstt + ( xcpv - xci ) * ( ztt(:,jk) - xtt ) ! compute L_i
6036  zthl(:,jk) = zcph(:) * ztt(:,jk) + ( 1. + zrw(:,jk) ) * xg * zz(:,jk) &
6037  - zlv(:) * zrc(:,jk) - zls(:) * zri(:,jk)
6038  END DO
6039 !
6040  DEALLOCATE( zcph )
6041  DEALLOCATE( zlv )
6042  DEALLOCATE( zls )
6043 !
6044 !
6045 !* 4. Compute updraft properties
6046 ! ----------------------------
6047 !
6048 !* 4.1 Set mass flux at LCL ( here a unit mass flux with w = 1 m/s )
6049 ! -------------------------------------------------------------
6050 !
6051  zdxdy(:) = xa25
6052  zmflcl(:) = xa25 * 1.e-3
6053 !
6054 !
6055  CALL convect_updraft_shal( iconv, klev, &
6056  kice, zpres, zdpres, zz, zthl, zthv, zthes, zrw, &
6057  zthlcl, ztlcl, zrvlcl, zwlcl, zzlcl, zthvelcl, &
6058  zmflcl, gtrig1, ilcl, idpl, ipbl, &
6059  zumf, zuer, zudr, zuthl, zuthv, zurw, &
6060  zurc, zuri, zcape, ictl, ietl )
6061 !
6062 !
6063 !
6064 !* 4.2 In routine UPDRAFT GTRIG1 has been set to false when cloud
6065 ! thickness is smaller than 3 km
6066 ! -----------------------------------------------------------
6067 !
6068 !
6069  iconv1 = count(gtrig1)
6070 !
6071  IF ( iconv1 > 0 ) THEN
6072 !
6073 !* 4.3 Allocate memory for downdraft variables
6074 ! ---------------------------------------
6075 !
6076 ! downdraft variables
6077 !
6078  ALLOCATE( zdmf(iconv,iks) )
6079  ALLOCATE( zder(iconv,iks) )
6080  ALLOCATE( zddr(iconv,iks) )
6081  ALLOCATE( ilfs(iconv) )
6082  ALLOCATE( zlmass(iconv,iks) )
6083  zdmf(:,:) = 0.
6084  zder(:,:) = 0.
6085  zddr(:,:) = 0.
6086  ilfs(:) = ikb
6087  DO jk = ikb, ike
6088  zlmass(:,jk) = zdxdy(:) * zdpres(:,jk) / xg ! mass of model layer
6089  END DO
6090  zlmass(:,ikb) = zlmass(:,ikb+1)
6091 !
6092 ! closure variables
6093 !
6094  ALLOCATE( ztimec(iconv) )
6095  ALLOCATE( zthc(iconv,iks) )
6096  ALLOCATE( zrvc(iconv,iks) )
6097  ALLOCATE( zrcc(iconv,iks) )
6098  ALLOCATE( zric(iconv,iks) )
6099  ALLOCATE( zwsub(iconv,iks) )
6100 !
6101 !
6102 !* 5. Compute downdraft properties
6103 ! ----------------------------
6104 !
6105  ztimec(:) = xctime_shal
6106  IF ( osettadj ) ztimec(:) = ptadjs
6107 !
6108 !* 7. Determine adjusted environmental values assuming
6109 ! that all available buoyant energy must be removed
6110 ! within an advective time step ZTIMEC.
6111 ! ---------------------------------------------------
6112 !
6113  CALL convect_closure_shal( iconv, klev, &
6114  zpres, zdpres, zz, zdxdy, zlmass, &
6115  zthl, zth, zrw, zrc, zri, gtrig1, &
6116  zthc, zrvc, zrcc, zric, zwsub, &
6117  ilcl, idpl, ipbl, ictl, &
6118  zumf, zuer, zudr, zuthl, zurw, &
6119  zurc, zuri, zcape, ztimec, iftsteps )
6120 
6121 !
6122 !
6123 !
6124 !* 8. Determine the final grid-scale (environmental) convective
6125 ! tendencies and set convective counter
6126 ! --------------------------------------------------------
6127 !
6128 !
6129 !* 8.1 Grid scale tendencies
6130 ! ---------------------
6131 !
6132  ! in order to save memory, the tendencies are temporarily stored
6133  ! in the tables for the adjusted grid-scale values
6134 !
6135  DO jk = ikb, ike
6136  zthc(:,jk) = ( zthc(:,jk) - zth(:,jk) ) / ztimec(:) &
6137  * ( zpres(:,jk) / xp00 ) ** zrdocp ! change theta in temperature
6138  zrvc(:,jk) = ( zrvc(:,jk) - zrw(:,jk) + zrc(:,jk) + zri(:,jk) ) &
6139  / ztimec(:)
6140 
6141  zrcc(:,jk) = ( zrcc(:,jk) - zrc(:,jk) ) / ztimec(:)
6142  zric(:,jk) = ( zric(:,jk) - zri(:,jk) ) / ztimec(:)
6143 !
6144  END DO
6145 !
6146 !
6147 !* 8.2 Apply conservation correction
6148 ! -----------------------------
6149 !
6150  ! Compute vertical integrals
6151 !
6152  jkm = maxval( ictl(:) )
6153  zwork2(:) = 0.
6154  zwork2b(:) = 0.
6155  DO jk = jkm, ikb+1, -1
6156  jkp = jk + 1
6157  DO ji = 1, iconv
6158  zw1 = zrvc(ji,jk) + zrcc(ji,jk) + zric(ji,jk)
6159  zwork2(ji) = zwork2(ji) + zw1 * & ! moisture
6160  (zpres(ji,jk) - zpres(ji,jkp)) / xg
6161  zw1 = ( xcpd + xcpv * zrw(ji,jk) )* zthc(ji,jk) - &
6162  ( xlvtt + ( xcpv - xcl ) * ( ztt(ji,jk) - xtt ) ) * zrcc(ji,jk) - &
6163  ( xlstt + ( xcpv - xcl ) * ( ztt(ji,jk) - xtt ) ) * zric(ji,jk)
6164  zwork2b(ji) = zwork2b(ji) + zw1 * & ! energy
6165  (zpres(ji,jk) - zpres(ji,jkp)) / xg
6166  END DO
6167  END DO
6168 !
6169  ! Budget error (integral must be zero)
6170 !
6171  DO ji = 1, iconv
6172  IF ( ictl(ji) > 2 ) THEN
6173  jkp = ictl(ji) + 1
6174  zwork2(ji) = zwork2(ji) * xg / ( zpres(ji,ikb+1) - zpres(ji,jkp) )
6175  zwork2b(ji) = zwork2b(ji) * xg / ( zpres(ji,ikb+1) - zpres(ji,jkp) )
6176  END IF
6177  END DO
6178 !
6179  ! Apply uniform correction
6180 !
6181  DO jk = jkm, ikb+1, -1
6182  DO ji = 1, iconv
6183  IF ( ictl(ji) > 2 .AND. jk <= ictl(ji) ) THEN
6184  zrvc(ji,jk) = zrvc(ji,jk) - zwork2(ji) ! moisture
6185  zthc(ji,jk) = zthc(ji,jk) - zwork2b(ji) / ( xcpd + xcpv * zrw(ji,jk) )! energy
6186  END IF
6187  END DO
6188  END DO
6189 !
6190  ! execute a "scatter"= pack command to store the tendencies in
6191  ! the final 2D tables
6192 !
6193  DO jk = ikb, ike
6194  DO ji = 1, iconv
6195  jl = ijindex(ji)
6196  ptten(jl,jk) = zthc(ji,jk)
6197  prvten(jl,jk) = zrvc(ji,jk)
6198  prcten(jl,jk) = zrcc(ji,jk)
6199  priten(jl,jk) = zric(ji,jk)
6200  END DO
6201  END DO
6202 !
6203 !
6204 ! Cloud base and top levels
6205 ! -------------------------
6206 !
6207  ilcl(:) = min( ilcl(:), ictl(:) )
6208  DO ji = 1, iconv
6209  jl = ijindex(ji)
6210  kcltop(jl) = ictl(ji)
6211  kclbas(jl) = ilcl(ji)
6212  END DO
6213 !
6214 !
6215 !* 8.7 Compute convective tendencies for Tracers
6216 ! ------------------------------------------
6217 !
6218  IF ( och1conv ) THEN
6219 !
6220  ALLOCATE( zch1(iconv,iks,kch1) )
6221  ALLOCATE( zch1c(iconv,iks,kch1) )
6222  ALLOCATE( zwork3(iconv,kch1) )
6223 !
6224  DO jk = ikb, ike
6225  DO ji = 1, iconv
6226  jl = ijindex(ji)
6227  zch1(ji,jk,:) = pch1(jl,jk,:)
6228  END DO
6229  END DO
6230 !
6231  CALL convect_chem_transport( iconv, klev, kch1, zch1, zch1c, &
6232  idpl, ipbl, ilcl, ictl, ilfs, ilfs, &
6233  zumf, zuer, zudr, zdmf, zder, zddr, &
6234  ztimec, zdxdy, zdmf(:,1), zlmass, zwsub, &
6235  iftsteps )
6236 !
6237  DO jk = ikb, ike
6238  DO jn = 1, kch1
6239  zch1c(:,jk,jn) = ( zch1c(:,jk,jn)- zch1(:,jk,jn) ) / ztimec(:)
6240  END DO
6241  END DO
6242 !
6243 !
6244 !* 8.8 Apply conservation correction
6245 ! -----------------------------
6246 !
6247  ! Compute vertical integrals
6248 !
6249  jkm = maxval( ictl(:) )
6250  zwork3(:,:) = 0.
6251  DO jk = jkm, ikb+1, -1
6252  jkp = jk + 1
6253  DO ji = 1, iconv
6254  zwork3(ji,:) = zwork3(ji,:) + zch1c(ji,jk,:) * &
6255  (zpres(ji,jk) - zpres(ji,jkp)) / xg
6256  END DO
6257  END DO
6258 !
6259  ! Mass error (integral must be zero)
6260 !
6261  DO ji = 1, iconv
6262  jkp = ictl(ji) + 1
6263  zwork3(ji,:) = zwork3(ji,:) * &
6264  xg / ( zpres(ji,ikb+1) - zpres(ji,jkp) )
6265  END DO
6266 !
6267  ! Apply uniform correction but assure positive mass at each level
6268 !
6269  DO jk = jkm, ikb+1, -1
6270  DO ji = 1, iconv
6271  IF ( jk <= ictl(ji) ) THEN
6272  zch1c(ji,jk,:) = zch1c(ji,jk,:) - zwork3(ji,:)
6273  ! ZCH1C(JI,JK,:) = MAX( ZCH1C(JI,JK,:), -ZCH1(JI,JK,:)/ZTIMEC(JI) )
6274  END IF
6275  END DO
6276  END DO
6277 !
6278  DO jk = ikb, ike
6279  DO ji = 1, iconv
6280  jl = ijindex(ji)
6281  pch1ten(jl,jk,:) = zch1c(ji,jk,:)
6282  END DO
6283  END DO
6284  END IF
6285 !
6286 !
6287 !* 9. Write up- and downdraft mass fluxes
6288 ! ------------------------------------
6289 !
6290  DO jk = ikb, ike
6291  zumf(:,jk) = zumf(:,jk) / zdxdy(:) ! Mass flux per unit area
6292  END DO
6293  zwork2(:) = 1.
6294  DO jk = ikb, ike
6295  DO ji = 1, iconv
6296  jl = ijindex(ji)
6297  pumf(jl,jk) = zumf(ji,jk) * zwork2(jl)
6298  END DO
6299  END DO
6300 !
6301 !
6302 !* 10. Deallocate all local arrays
6303 ! ---------------------------
6304 !
6305 ! downdraft variables
6306 !
6307  DEALLOCATE( zdmf )
6308  DEALLOCATE( zder )
6309  DEALLOCATE( zddr )
6310  DEALLOCATE( ilfs )
6311  DEALLOCATE( zlmass )
6312 !
6313 ! closure variables
6314 !
6315  DEALLOCATE( ztimec )
6316  DEALLOCATE( zthc )
6317  DEALLOCATE( zrvc )
6318  DEALLOCATE( zrcc )
6319  DEALLOCATE( zric )
6320  DEALLOCATE( zwsub )
6321 !
6322  IF ( och1conv ) THEN
6323  DEALLOCATE( zch1 )
6324  DEALLOCATE( zch1c )
6325  DEALLOCATE( zwork3 )
6326  END IF
6327 !
6328  ENDIF
6329 !
6330 ! vertical index
6331 !
6332  DEALLOCATE( idpl )
6333  DEALLOCATE( ipbl )
6334  DEALLOCATE( ilcl )
6335  DEALLOCATE( ictl )
6336  DEALLOCATE( ietl )
6337 !
6338 ! grid scale variables
6339 !
6340  DEALLOCATE( zz )
6341  DEALLOCATE( zpres )
6342  DEALLOCATE( zdpres )
6343  DEALLOCATE( ztt )
6344  DEALLOCATE( zth )
6345  DEALLOCATE( zthv )
6346  DEALLOCATE( zthl )
6347  DEALLOCATE( zthes )
6348  DEALLOCATE( zrw )
6349  DEALLOCATE( zrv )
6350  DEALLOCATE( zrc )
6351  DEALLOCATE( zri )
6352  DEALLOCATE( zdxdy )
6353 !
6354 ! updraft variables
6355 !
6356  DEALLOCATE( zumf )
6357  DEALLOCATE( zuer )
6358  DEALLOCATE( zudr )
6359  DEALLOCATE( zuthl )
6360  DEALLOCATE( zuthv )
6361  DEALLOCATE( zurw )
6362  DEALLOCATE( zurc )
6363  DEALLOCATE( zuri )
6364  DEALLOCATE( zthlcl )
6365  DEALLOCATE( ztlcl )
6366  DEALLOCATE( zrvlcl )
6367  DEALLOCATE( zwlcl )
6368  DEALLOCATE( zzlcl )
6369  DEALLOCATE( zthvelcl )
6370  DEALLOCATE( zmflcl )
6371  DEALLOCATE( zcape )
6372 !
6373 ! work arrays
6374 !
6375  DEALLOCATE( iindex )
6376  DEALLOCATE( ijindex )
6377  DEALLOCATE( ijsindex )
6378  DEALLOCATE( gtrig1 )
6379 !
6380 !
6381 END SUBROUTINE convect_shallow
6382 ! ######spl
6383  SUBROUTINE convect_trigger_shal( KLON, KLEV, &
6384  ppres, pth, pthv, pthes, &
6385  prv, pw, pz, pdxdy, &
6386  pthlcl, ptlcl, prvlcl, pwlcl, pzlcl, &
6387  pthvelcl, klcl, kdpl, kpbl, otrig )
6388 ! ######################################################################
6389 !
6390 !!**** Determine convective columns as well as the cloudy values of theta,
6391 !! and qv at the lifting condensation level (LCL)
6392 !!
6393 !! PURPOSE
6394 !! -------
6395 !! The purpose of this routine is to determine convective columns
6396 !!
6397 !!
6398 !!
6399 !!** METHOD
6400 !! ------
6401 !! Computations are done at every model level starting from bottom.
6402 !! The use of masks allows to optimise the inner loops (horizontal loops).
6403 !! What we look for is the undermost unstable level at each grid point.
6404 !!
6405 !!
6406 !!
6407 !! EXTERNAL
6408 !! --------
6409 !! Routine CONVECT_SATMIXRATIO
6410 !!
6411 !!
6412 !! IMPLICIT ARGUMENTS
6413 !! ------------------
6414 !! Module MODD_CST
6415 !! XG ! gravity constant
6416 !! XP00 ! Reference pressure
6417 !! XRD, XRV ! Gaz constants for dry air and water vapor
6418 !! XCPD ! Cpd (dry air)
6419 !! XTT ! triple point temperature
6420 !! XBETAW, XGAMW ! constants for vapor saturation pressure
6421 !!
6422 !! Module MODD_CONVPAR
6423 !! XA25 ! reference grid area
6424 !! XZLCL ! maximum height difference between
6425 !! ! the surface and the DPL
6426 !! XZPBL ! minimum mixed layer depth to sustain convection
6427 !! XCDEPTH ! minimum necessary cloud depth
6428 !! XCDEPTH_D ! maximum allowed cloud depth
6429 !! XDTPERT ! add small Temp peturbation
6430 !! XNHGAM ! coefficient for buoyancy term in w eq.
6431 !! ! accounting for nh-pressure
6432 !!
6433 !! Module MODD_CONVPAREXT
6434 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
6435 !!
6436 !! REFERENCE
6437 !! ---------
6438 !!
6439 !! Book2 of documentation ( routine TRIGGER_FUNCT)
6440 !! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
6441 !!
6442 !! AUTHOR
6443 !! ------
6444 !! P. BECHTOLD * Laboratoire d'Aerologie *
6445 !!
6446 !! MODIFICATIONS
6447 !! -------------
6448 !! Original 07/11/95
6449 !! Last modified 20/03/97 Select first departure level
6450 !! that produces a cloud thicker than XCDEPTH
6451 !-------------------------------------------------------------------------------
6452 !
6453 !* 0. DECLARATIONS
6454 ! ------------
6455 !
6456 USE modd_cst
6457 USE modd_convpar_shal
6458 USE modd_convparext
6459 !
6460 !
6461 IMPLICIT NONE
6462 !
6463 !* 0.1 Declarations of dummy arguments :
6464 !
6465 INTEGER, INTENT(IN) :: KLON ! horizontal loop index
6466 INTEGER, INTENT(IN) :: KLEV ! vertical loop index
6467 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area
6468 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
6469 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES ! envir. satur. theta_e
6470 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV ! vapor mixing ratio
6471 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES ! pressure
6472 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ ! height of grid point (m)
6473 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW ! vertical velocity
6474 !
6475 REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
6476 REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temp. at LCL
6477 REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
6478 REAL, DIMENSION(KLON), INTENT(OUT):: PWLCL ! parcel velocity at LCL
6479 REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
6480 REAL, DIMENSION(KLON), INTENT(OUT):: PTHVELCL ! environm. theta_v at LCL (K)
6481 LOGICAL, DIMENSION(KLON), INTENT(OUT):: OTRIG ! logical mask for convection
6482 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KLCL ! contains vert. index of LCL
6483 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KDPL ! contains vert. index of DPL
6484 INTEGER, DIMENSION(KLON), INTENT(INOUT):: KPBL ! contains index of source layer top
6485 !
6486 !* 0.2 Declarations of local variables :
6487 !
6488 INTEGER :: JKK, JK, JKP, JKM, JL, JKT, JT ! vertical loop index
6489 INTEGER :: JI ! horizontal loop index
6490 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
6491 REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
6492 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
6493 !
6494 REAL, DIMENSION(KLON) :: ZTHLCL, ZTLCL, ZRVLCL, & ! locals for PTHLCL,PTLCL
6495  ZWLCL, ZZLCL, ZTHVELCL ! PRVLCL, ....
6496 INTEGER, DIMENSION(KLON) :: IDPL, IPBL, ILCL ! locals for KDPL, ...
6497 REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
6498 REAL, DIMENSION(KLON) :: ZZDPL ! height of DPL
6499 REAL, DIMENSION(KLON) :: ZTHVLCL ! theta_v at LCL = mixed layer value
6500 REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
6501 REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
6502 REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
6503 REAL, DIMENSION(KLON) :: ZCAPE ! convective available energy (m^2/s^2/g)
6504 REAL, DIMENSION(KLON) :: ZTHEUL ! updraft equiv. pot. temperature (K)
6505 REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
6506 REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
6507 REAL, DIMENSION(KLON) :: ZTOP ! estimated cloud top (m)
6508 !INTEGER, DIMENSION(KLON) :: ITOP ! work array to store highest test layer
6509 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
6510 LOGICAL, DIMENSION(KLON) :: GTRIG, GTRIG2 ! local arrays for OTRIG
6511 LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
6512 !
6513 !
6514 !-------------------------------------------------------------------------------
6515 !
6516 !* 0.3 Compute array bounds
6517 ! --------------------
6518 !
6519 iie = klon
6520 ikb = 1 + jcvexb
6521 ike = klev - jcvext
6522 !
6523 !
6524 !* 1. Initialize local variables
6525 ! --------------------------
6526 !
6527 zeps = xrd / xrv
6528 zepsa = xrv / xrd
6529 zcpord = xcpd / xrd
6530 zrdocp = xrd / xcpd
6531 otrig(:) = .false.
6532 idpl(:) = kdpl(:)
6533 ipbl(:) = kpbl(:)
6534 ilcl(:) = klcl(:)
6535 !ITOP(:) = IKB
6536 pwlcl(:) = 0.
6537 zwlcl(:) = 0.
6538 pthlcl(:) = 1.
6539 pthvelcl(:)= 1.
6540 ptlcl(:) = 1.
6541 prvlcl(:) = 0.
6542 pwlcl(:) = 0.
6543 pzlcl(:) = pz(:,ikb)
6544 zzdpl(:) = pz(:,ikb)
6545 gtrig2(:) = .true.
6546 !
6547 !
6548 !
6549 ! 1. Determine highest necessary loop test layer
6550 ! -------------------------------------------
6551 !
6552 jt = ike - 2
6553 DO jk = ikb + 1, ike - 2
6554  ! DO JI = 1, IIE
6555  ! IF ( PZ(JI,JK) - PZ(JI,IKB) <= XZLCL ) ITOP(JI) = JK
6556  ! END DO
6557  IF ( pz(1,jk) - pz(1,ikb) < 5.e3 ) jt = jk
6558 END DO
6559 !
6560 !
6561 !* 2. Enter loop for convection test
6562 ! ------------------------------
6563 !
6564 jkp = minval( idpl(:) ) + 1
6565 !JKT = MAXVAL( ITOP(:) )
6566 jkt = jt
6567 DO jkk = jkp, jkt
6568 !
6569  gwork1(:) = zzdpl(:) - pz(:,ikb) < xzlcl
6570  ! we exit the trigger test when the center of the mixed layer is more
6571  ! than 1500 m above soil level.
6572  WHERE ( gwork1(:) )
6573  zdpthmix(:) = 0.
6574  zpresmix(:) = 0.
6575  zthlcl(:) = 0.
6576  zrvlcl(:) = 0.
6577  zzdpl(:) = pz(:,jkk)
6578  idpl(:) = jkk
6579  END WHERE
6580 !
6581 !
6582 !* 3. Construct a mixed layer of at least 50 hPa (XZPBL)
6583 ! ------------------------------------------
6584 !
6585  DO jk = jkk, ike - 1
6586  jkm = jk + 1
6587  DO ji = 1, iie
6588  IF ( gwork1(ji) .AND. zdpthmix(ji) < xzpbl ) THEN
6589  ipbl(ji) = jk
6590  zwork1(ji) = ppres(ji,jk) - ppres(ji,jkm)
6591  zdpthmix(ji) = zdpthmix(ji) + zwork1(ji)
6592  zpresmix(ji) = zpresmix(ji) + ppres(ji,jk) * zwork1(ji)
6593  zthlcl(ji) = zthlcl(ji) + pth(ji,jk) * zwork1(ji)
6594  zrvlcl(ji) = zrvlcl(ji) + prv(ji,jk) * zwork1(ji)
6595  END IF
6596  END DO
6597  IF ( minval( zdpthmix(:) ) >= xzpbl ) EXIT
6598  END DO
6599 !
6600 !
6601  WHERE ( gwork1(:) )
6602 !
6603  zpresmix(:) = zpresmix(:) / zdpthmix(:)
6604  zthlcl(:) = zthlcl(:) / zdpthmix(:) + xdtpert ! add small Temp Perturb.
6605  zrvlcl(:) = zrvlcl(:) / zdpthmix(:)
6606  zthvlcl(:) = zthlcl(:) * ( 1. + zepsa * zrvlcl(:) ) &
6607  / ( 1. + zrvlcl(:) )
6608 !
6609 !* 4.1 Use an empirical direct solution ( Bolton formula )
6610 ! to determine temperature and pressure at LCL.
6611 ! Nota: the adiabatic saturation temperature is not
6612 ! equal to the dewpoint temperature
6613 ! ----------------------------------------------------
6614 !
6615 !
6616  ztmix(:) = zthlcl(:) * ( zpresmix(:) / xp00 ) ** zrdocp
6617  zevmix(:) = zrvlcl(:) * zpresmix(:) / ( zrvlcl(:) + zeps )
6618  zevmix(:) = max( 1.e-8, zevmix(:) )
6619  zwork1(:) = log( zevmix(:) / 613.3 )
6620  ! dewpoint temperature
6621  zwork1(:) = ( 4780.8 - 32.19 * zwork1(:) ) / ( 17.502 - zwork1(:) )
6622  ! adiabatic saturation temperature
6623  ztlcl(:) = zwork1(:) - ( .212 + 1.571e-3 * ( zwork1(:) - xtt ) &
6624  - 4.36e-4 * ( ztmix(:) - xtt ) ) * ( ztmix(:) - zwork1(:) )
6625  ztlcl(:) = min( ztlcl(:), ztmix(:) )
6626  zplcl(:) = xp00 * ( ztlcl(:) / zthlcl(:) ) ** zcpord
6627 !
6628  END WHERE
6629 !
6630 !
6631 !* 4.2 Correct ZTLCL in order to be completely consistent
6632 ! with MNH saturation formula
6633 ! ---------------------------------------------
6634 !
6635  CALL convect_satmixratio( klon, zplcl, ztlcl, zwork1, zlv, zwork2, zcph )
6636  WHERE( gwork1(:) )
6637  zwork2(:) = zwork1(:) / ztlcl(:) * ( xbetaw / ztlcl(:) - xgamw ) ! dr_sat/dT
6638  zwork2(:) = ( zwork1(:) - zrvlcl(:) ) / &
6639  ( 1. + zlv(:) / zcph(:) * zwork2(:) )
6640  ztlcl(:) = ztlcl(:) - zlv(:) / zcph(:) * zwork2(:)
6641 !
6642  END WHERE
6643 !
6644 !
6645 !* 4.3 If ZRVLCL = PRVMIX is oversaturated set humidity
6646 ! and temperature to saturation values.
6647 ! ---------------------------------------------
6648 !
6649  CALL convect_satmixratio( klon, zpresmix, ztmix, zwork1, zlv, zwork2, zcph )
6650  WHERE( gwork1(:) .AND. zrvlcl(:) > zwork1(:) )
6651  zwork2(:) = zwork1(:) / ztmix(:) * ( xbetaw / ztmix(:) - xgamw ) ! dr_sat/dT
6652  zwork2(:) = ( zwork1(:) - zrvlcl(:) ) / &
6653  ( 1. + zlv(:) / zcph(:) * zwork2(:) )
6654  ztlcl(:) = ztmix(:) - zlv(:) / zcph(:) * zwork2(:)
6655  zrvlcl(:) = zrvlcl(:) - zwork2(:)
6656  zplcl(:) = zpresmix(:)
6657  zthlcl(:) = ztlcl(:) * ( xp00 / zplcl(:) ) ** zrdocp
6658  zthvlcl(:)= zthlcl(:) * ( 1. + zepsa * zrvlcl(:) ) &
6659  / ( 1. + zrvlcl(:) )
6660  END WHERE
6661 !
6662 !
6663 !* 5.1 Determine vertical loop index at the LCL and DPL
6664 ! --------------------------------------------------
6665 !
6666  DO jk = jkk, ike - 1
6667  DO ji = 1, iie
6668  IF ( zplcl(ji) <= ppres(ji,jk) .AND. gwork1(ji) ) ilcl(ji) = jk + 1
6669  END DO
6670  END DO
6671 !
6672 !
6673 !* 5.2 Estimate height and environm. theta_v at LCL
6674 ! --------------------------------------------------
6675 !
6676  DO ji = 1, iie
6677  jk = ilcl(ji)
6678  jkm = jk - 1
6679  zdp(ji) = log( zplcl(ji) / ppres(ji,jkm) ) / &
6680  log( ppres(ji,jk) / ppres(ji,jkm) )
6681  zwork1(ji) = pthv(ji,jkm) + ( pthv(ji,jk) - pthv(ji,jkm) ) * zdp(ji)
6682  ! we compute the precise value of the LCL
6683  ! The precise height is between the levels ILCL and ILCL-1.
6684  zwork2(ji) = pz(ji,jkm) + ( pz(ji,jk) - pz(ji,jkm) ) * zdp(ji)
6685  END DO
6686  WHERE( gwork1(:) )
6687  zthvelcl(:) = zwork1(:)
6688  zzlcl(:) = zwork2(:)
6689  END WHERE
6690 !
6691 !
6692 !* 6. Check to see if cloud is bouyant
6693 ! --------------------------------
6694 !
6695 !* 6.1 Compute grid scale vertical velocity perturbation term ZWORK1
6696 ! -------------------------------------------------------------
6697 !
6698 ! ! normalize w grid scale to a 25 km refer. grid
6699 ! DO JI = 1, IIE
6700 ! JK = ILCL(JI)
6701 ! JKM = JK - 1
6702 ! ZWORK1(JI) = ( PW(JI,JKM) + ( PW(JI,JK) - PW(JI,JKM) ) * ZDP(JI) ) &
6703 ! * SQRT( PDXDY(JI) / XA25 )
6704 ! - 0.02 * ZZLCL(JI) / XZLCL ! avoid spurious convection
6705 ! END DO
6706 ! ! compute sign of normalized grid scale w
6707 ! ZWORK2(:) = SIGN( 1., ZWORK1(:) )
6708 ! ZWORK1(:) = XWTRIG * ZWORK2(:) * ABS( ZWORK1(:) ) ** 0.333 &
6709 ! * ( XP00 / ZPLCL(:) ) ** ZRDOCP
6710 !
6711 !* 6.2 Compute parcel vertical velocity at LCL
6712 ! ---------------------------------------
6713 !
6714 ! DO JI = 1, IIE
6715 ! JKDL = IDPL(JI)
6716 ! ZWORK3(JI) = XG * ZWORK1(JI) * ( ZZLCL(JI) - PZ(JI,JKDL) ) &
6717 ! / ( PTHV(JI,JKDL) + ZTHVELCL(JI) )
6718 ! END DO
6719 ! WHERE( GWORK1(:) )
6720 ! ZWLCL(:) = 1. + .5 * ZWORK2(:) * SQRT( ABS( ZWORK3(:) ) )
6721 ! GTRIG(:) = ZTHVLCL(:) - ZTHVELCL(:) + ZWORK1(:) > 0. .AND. &
6722 ! ZWLCL(:) > 0.
6723 ! END WHERE
6724  zwlcl(:) = 1.
6725 !
6726 !
6727 !* 6.3 Look for parcel that produces sufficient cloud depth.
6728 ! The cloud top is estimated as the level where the CAPE
6729 ! is smaller than a given value (based on vertical velocity eq.)
6730 ! --------------------------------------------------------------
6731 !
6732  ztheul(:) = ztlcl(:) * ( zthlcl(:) / ztlcl(:) ) &
6733  ** ( 1. - 0.28 * zrvlcl(:) ) &
6734  * exp( ( 3374.6525 / ztlcl(:) - 2.5403 ) * &
6735  zrvlcl(:) * ( 1. + 0.81 * zrvlcl(:) ) )
6736 !
6737  zcape(:) = 0.
6738  ztop(:) = 0.
6739  zwork3(:)= 0.
6740  jkm = minval( ilcl(:) )
6741  DO jl = jkm, jt
6742  jk = jl + 1
6743  DO ji = 1, iie
6744  zwork1(ji) = ( 2. * ztheul(ji) / &
6745  ( pthes(ji,jk) + pthes(ji,jl) ) - 1. ) * ( pz(ji,jk) - pz(ji,jl) )
6746  IF ( jl < ilcl(ji) ) zwork1(ji) = 0.
6747  zcape(ji) = zcape(ji) + zwork1(ji)
6748  zwork2(ji) = xnhgam * xg * zcape(ji) + 1.05 * zwlcl(ji) * zwlcl(ji)
6749  ! the factor 1.05 takes entrainment into account
6750  zwork2(ji) = sign( 1., zwork2(ji) )
6751  zwork3(ji) = zwork3(ji) + min(0., zwork2(ji) )
6752  zwork3(ji) = max( -1., zwork3(ji) )
6753  ! Nota, the factors ZWORK2 and ZWORK3 are only used to avoid
6754  ! if and goto statements, the difficulty is to extract only
6755  ! the level where the criterium is first fullfilled
6756  ztop(ji) = pz(ji,jl) * .5 * ( 1. + zwork2(ji) ) * ( 1. + zwork3(ji) ) + &
6757  ztop(ji) * .5 * ( 1. - zwork2(ji) )
6758  END DO
6759  END DO
6760 !
6761 !
6762  zwork2(:) = ztop(:) - zzlcl(:)
6763  WHERE( zwork2(:) .GE. xcdepth .AND. zwork2(:) < xcdepth_d .AND. gtrig2(:) )
6764  gtrig2(:) = .false.
6765  otrig(:) = .true.
6766  ! OTRIG(:) = GTRIG(:) ! we select the first departure level
6767  pthlcl(:) = zthlcl(:) ! that gives sufficient cloud depth
6768  prvlcl(:) = zrvlcl(:)
6769  ptlcl(:) = ztlcl(:)
6770  pwlcl(:) = zwlcl(:)
6771  pzlcl(:) = zzlcl(:)
6772  pthvelcl(:) = zthvelcl(:)
6773  kdpl(:) = idpl(:)
6774  kpbl(:) = ipbl(:)
6775  klcl(:) = ilcl(:)
6776  END WHERE
6777 !
6778 END DO
6779 !
6780 !
6781 END SUBROUTINE convect_trigger_shal
6782 ! ######spl
6783  SUBROUTINE convect_updraft_shal( KLON, KLEV, &
6784  kice, ppres, pdpres, pz, pthl, pthv, pthes, prw,&
6785  pthlcl, ptlcl, prvlcl, pwlcl, pzlcl, pthvelcl, &
6786  pmflcl, otrig, klcl, kdpl, kpbl, &
6787  pumf, puer, pudr, puthl, puthv, purw, &
6788  purc, puri, pcape, kctl, ketl )
6789 ! ###############################################################################
6790 !
6791 !!**** Compute updraft properties from DPL to CTL.
6792 !!
6793 !!
6794 !! PURPOSE
6795 !! -------
6796 !! The purpose of this routine is to determine updraft properties
6797 !! ( mass flux, thermodynamics, precipitation )
6798 !!
6799 !!
6800 !!** METHOD
6801 !! ------
6802 !! Computations are done at every model level starting from bottom.
6803 !! The use of masks allows to optimise the inner loops (horizontal loops).
6804 !!
6805 !!
6806 !!
6807 !! EXTERNAL
6808 !! --------
6809 !! Routine CONVECT_MIXING_FUNCT
6810 !! Routine CONVECT_CONDENS
6811 !!
6812 !!
6813 !! IMPLICIT ARGUMENTS
6814 !! ------------------
6815 !! Module MODD_CST
6816 !! XG ! gravity constant
6817 !! XP00 ! reference pressure
6818 !! XRD, XRV ! gaz constants for dry air and water vapor
6819 !! XCPD, XCPV, XCL ! Cp of dry air, water vapor and liquid water
6820 !! XTT ! triple point temperature
6821 !! XLVTT ! vaporisation heat at XTT
6822 !!
6823 !!
6824 !! Module MODD_CONVPAR_SHAL
6825 !! XA25 ! reference grid area
6826 !! XCRAD ! cloud radius
6827 !! XCDEPTH ! minimum necessary cloud depth
6828 !! XENTR ! entrainment constant
6829 !! XNHGAM ! coefficient for buoyancy term in w eq.
6830 !! ! accounting for nh-pressure
6831 !! XTFRZ1 ! begin of freezing interval
6832 !! XTFRZ2 ! begin of freezing interval
6833 !!
6834 !! Module MODD_CONVPAREXT
6835 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
6836 !!
6837 !! REFERENCE
6838 !! ---------
6839 !!
6840 !! Book1,2 of documentation ( routine CONVECT_UPDRAFT)
6841 !! Kain and Fritsch, 1990, J. Atmos. Sci., Vol.
6842 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
6843 !!
6844 !! AUTHOR
6845 !! ------
6846 !! P. BECHTOLD * Laboratoire d'Aerologie *
6847 !!
6848 !! MODIFICATIONS
6849 !! -------------
6850 !! Original 07/11/95
6851 !! Last modified 10/12/97
6852 !-------------------------------------------------------------------------------
6853 !
6854 !* 0. DECLARATIONS
6855 ! ------------
6856 !
6857 USE modd_cst
6858 USE modd_convpar_shal
6859 USE modd_convparext
6860 !
6861 !
6862 IMPLICIT NONE
6863 !
6864 !* 0.1 Declarations of dummy arguments :
6865 !
6866 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
6867 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
6868 INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
6869  ! 0 = no ice )
6870 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
6871 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV ! grid scale theta_v
6872 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
6873 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
6874  ! mixing ratio
6875 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
6876 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
6877  ! bottom and top of layer (Pa)
6878 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
6879 REAL, DIMENSION(KLON), INTENT(IN) :: PTHLCL ! theta at LCL
6880 REAL, DIMENSION(KLON), INTENT(IN) :: PTLCL ! temp. at LCL
6881 REAL, DIMENSION(KLON), INTENT(IN) :: PRVLCL ! vapor mixing ratio at LCL
6882 REAL, DIMENSION(KLON), INTENT(IN) :: PWLCL ! parcel velocity at LCL (m/s)
6883 REAL, DIMENSION(KLON), INTENT(IN) :: PMFLCL ! cloud base unit mass flux
6884  ! (kg/s)
6885 REAL, DIMENSION(KLON), INTENT(IN) :: PZLCL ! height at LCL (m)
6886 REAL, DIMENSION(KLON), INTENT(IN) :: PTHVELCL ! environm. theta_v at LCL (K)
6887 LOGICAL, DIMENSION(KLON), INTENT(INOUT):: OTRIG! logical mask for convection
6888 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
6889 INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
6890 INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layertop
6891 !
6892 !
6893 INTEGER, DIMENSION(KLON), INTENT(OUT):: KCTL ! contains vert. index of CTL
6894 INTEGER, DIMENSION(KLON), INTENT(OUT):: KETL ! contains vert. index of &
6895  !equilibrium (zero buoyancy) level
6896 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF ! updraft mass flux (kg/s)
6897 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER ! updraft entrainment (kg/s)
6898 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR ! updraft detrainment (kg/s)
6899 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
6900 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
6901 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW ! updraft total water (kg/kg)
6902 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC ! updraft cloud water (kg/kg)
6903 REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI ! updraft cloud ice (kg/kg)
6904 REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! available potent. energy
6905 !
6906 !* 0.2 Declarations of local variables :
6907 !
6908 INTEGER :: IIE, IKB, IKE ! horizontal and vertical loop bounds
6909 INTEGER :: JI ! horizontal loop index
6910 INTEGER :: JK, JKP, JKM, JK1, JK2, JKMIN ! vertical loop index
6911 REAL :: ZEPSA, ZCVOCD ! R_v / R_d, C_pv / C_pd
6912 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
6913 !
6914 REAL, DIMENSION(KLON) :: ZUT ! updraft temperature (K)
6915 REAL, DIMENSION(KLON) :: ZUW1, ZUW2 ! square of updraft vert.
6916  ! velocity at levels k and k+1
6917 REAL, DIMENSION(KLON) :: ZE1,ZE2,ZD1,ZD2 ! fractional entrainm./detrain
6918  ! rates at levels k and k+1
6919 REAL, DIMENSION(KLON) :: ZMIXF ! critical mixed fraction
6920 REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
6921 REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
6922 REAL, DIMENSION(KLON) :: ZURV ! updraft water vapor at level k+1
6923 REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
6924 REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
6925 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, &
6926  ZWORK6 ! work arrays
6927 INTEGER, DIMENSION(KLON) :: IWORK ! wok array
6928 LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK2, GWORK4, GWORK5
6929  ! work arrays
6930 LOGICAL, DIMENSION(KLON,KLEV) :: GWORK6 ! work array
6931 !
6932 !
6933 !-------------------------------------------------------------------------------
6934 !
6935 ! 0.3 Set loop bounds
6936 ! ---------------
6937 !
6938 ikb = 1 + jcvexb
6939 ike = klev - jcvext
6940 iie = klon
6941 !
6942 !
6943 !* 1. Initialize updraft properties and local variables
6944 ! -------------------------------------------------
6945 !
6946 zepsa = xrv / xrd
6947 zcvocd = xcpv / xcpd
6948 zcpord = xcpd / xrd
6949 zrdocp = xrd / xcpd
6950 !
6951 pumf(:,:) = 0.
6952 puer(:,:) = 0.
6953 pudr(:,:) = 0.
6954 puthl(:,:) = 0.
6955 puthv(:,:) = 0.
6956 purw(:,:) = 0.
6957 purc(:,:) = 0.
6958 puri(:,:) = 0.
6959 zuw1(:) = pwlcl(:) * pwlcl(:)
6960 zuw2(:) = 0.
6961 ze1(:) = 0.
6962 zd1(:) = 0.
6963 pcape(:) = 0.
6964 kctl(:) = ikb
6965 ketl(:) = klcl(:)
6966 gwork2(:) = .true.
6967 gwork5(:) = .true.
6968 zpi(:) = 1.
6969 zwork3(:) = 0.
6970 zwork4(:) = 0.
6971 zwork5(:) = 0.
6972 zwork6(:) = 0.
6973 gwork1(:) = .false.
6974 gwork4(:) = .false.
6975 !
6976 !
6977 !* 1.1 Compute undilute updraft theta_e for CAPE computations
6978 ! Bolton (1980) formula.
6979 ! Define accurate enthalpy for updraft
6980 ! -----------------------------------------------------
6981 !
6982 ztheul(:) = ptlcl(:) * ( pthlcl(:) / ptlcl(:) ) ** ( 1. - 0.28 * prvlcl(:) ) &
6983  * exp( ( 3374.6525 / ptlcl(:) - 2.5403 ) * &
6984  prvlcl(:) * ( 1. + 0.81 * prvlcl(:) ) )
6985 !
6986 !
6987 zwork1(:) = ( xcpd + prvlcl(:) * xcpv ) * ptlcl(:) &
6988  + ( 1. + prvlcl(:) ) * xg * pzlcl(:)
6989 !
6990 !
6991 !* 2. Set updraft properties between DPL and LCL
6992 ! ------------------------------------------
6993 !
6994 jkp = maxval( klcl(:) )
6995 jkm = minval( kdpl(:) )
6996 DO jk = jkm, jkp
6997  DO ji = 1, iie
6998  IF ( jk >= kdpl(ji) .AND. jk < klcl(ji) ) THEN
6999  pumf(ji,jk) = pmflcl(ji)
7000  puthl(ji,jk) = zwork1(ji)
7001  puthv(ji,jk) = pthlcl(ji) * ( 1. + zepsa * prvlcl(ji) ) / &
7002  ( 1. + prvlcl(ji) )
7003  purw(ji,jk) = prvlcl(ji)
7004  END IF
7005  END DO
7006 END DO
7007 !
7008 !
7009 !* 3. Enter loop for updraft computations
7010 ! ------------------------------------
7011 !
7012 jkmin = minval( klcl(:) - 1 )
7013 DO jk = max( ikb + 1, jkmin ), ike - 1
7014  zwork6(:) = 1.
7015  jkp = jk + 1
7016 !
7017  gwork4(:) = jk >= klcl(:) - 1
7018  gwork1(:) = gwork4(:) .AND. gwork2(:) ! this mask is used to confine
7019  ! updraft computations between the LCL and the CTL
7020 !
7021  WHERE( jk == klcl(:) - 1 ) zwork6(:) = 0. ! factor that is used in buoyancy
7022  ! computation at first level above LCL
7023 !
7024 !
7025 !* 4. Estimate condensate, L_v L_i, Cph and theta_v at level k+1
7026 ! ----------------------------------------------------------
7027 !
7028  zwork1(:) = purc(:,jk)
7029  zwork2(:) = puri(:,jk)
7030  CALL convect_condens( klon, kice, ppres(:,jkp), puthl(:,jk), purw(:,jk),&
7031  zwork1, zwork2, pz(:,jkp), gwork1, zut, zurv, &
7032  purc(:,jkp), puri(:,jkp), zlv, zls, zcph )
7033 !
7034 !
7035  zpi(:) = ( xp00 / ppres(:,jkp) ) ** zrdocp
7036  WHERE ( gwork1(:) )
7037 !
7038  puthv(:,jkp) = zpi(:) * zut(:) * ( 1. + zepsa * zurv(:) ) &
7039  / ( 1. + purw(:,jk) )
7040 !
7041 !
7042 !* 5. Compute square of vertical velocity using entrainment
7043 ! at level k
7044 ! -----------------------------------------------------
7045 !
7046  zwork3(:) = pz(:,jkp) - pz(:,jk) * zwork6(:) - &
7047  ( 1. - zwork6(:) ) * pzlcl(:) ! level thickness
7048  zwork4(:) = pthv(:,jk) * zwork6(:) + &
7049  ( 1. - zwork6(:) ) * pthvelcl(:)
7050  zwork5(:) = 2. * zuw1(:) * puer(:,jk) / max( .1, pumf(:,jk) )
7051  zuw2(:) = zuw1(:) + zwork3(:) * xnhgam * xg * &
7052  ( ( puthv(:,jk) + puthv(:,jkp) ) / &
7053  ( zwork4(:) + pthv(:,jkp) ) - 1. ) & ! buoyancy term
7054  - zwork5(:) ! entrainment term
7055 !
7056 !
7057 !* 6. Update total precipitation: dr_r=(r_c+r_i)*exp(-rate*dz)
7058 ! --------------------------------------------------------
7059 !
7060 ! compute level mean vertical velocity
7061  zwork2(:) = 0.5 * &
7062  ( sqrt( max( 1.e-2, zuw2(:) ) ) + &
7063  sqrt( max( 1.e-2, zuw1(:) ) ) )
7064 !
7065 !
7066 !* 7. Update r_c, r_i, enthalpy, r_w for precipitation
7067 ! -------------------------------------------------------
7068 !
7069  purw(:,jkp) = purw(:,jk)
7070  purc(:,jkp) = purc(:,jkp)
7071  puri(:,jkp) = puri(:,jkp)
7072  puthl(:,jkp) = puthl(:,jk)
7073 !
7074  zuw1(:) = zuw2(:)
7075 !
7076  END WHERE
7077 !
7078 !
7079 !* 8. Compute entrainment and detrainment using conservative
7080 ! variables adjusted for precipitation ( not for entrainment)
7081 ! -----------------------------------------------------------
7082 !
7083 !* 8.1 Compute critical mixed fraction by estimating unknown
7084 ! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
7085 ! We determine the zero crossing of the linear curve
7086 ! evaluating the derivative using ZMIXF=0.1.
7087 ! -----------------------------------------------------
7088 !
7089  zmixf(:) = 0.1 ! starting value for critical mixed fraction
7090  zwork1(:) = zmixf(:) * pthl(:,jkp) &
7091  + ( 1. - zmixf(:) ) * puthl(:,jkp) ! mixed enthalpy
7092  zwork2(:) = zmixf(:) * prw(:,jkp) &
7093  + ( 1. - zmixf(:) ) * purw(:,jkp) ! mixed r_w
7094 !
7095  CALL convect_condens( klon, kice, ppres(:,jkp), zwork1, zwork2, &
7096  purc(:,jkp), puri(:,jkp), pz(:,jkp), gwork1, zut,&
7097  zwork3, zwork4, zwork5, zlv, zls, zcph )
7098 ! put in enthalpy and r_w and get T r_c, r_i (ZUT, ZWORK4-5)
7099 !
7100  ! compute theta_v of mixture
7101  zwork3(:) = zut(:) * zpi(:) * ( 1. + zepsa * ( &
7102  zwork2(:) - zwork4(:) - zwork5(:) ) ) / ( 1. + zwork2(:) )
7103  ! compute final value of critical mixed fraction using theta_v
7104  ! of mixture, grid-scale and updraft
7105  zmixf(:) = max( 0., puthv(:,jkp) - pthv(:,jkp) ) * zmixf(:) / &
7106  ( puthv(:,jkp) - zwork3(:) + 1.e-10 )
7107  zmixf(:) = max( 0., min( 1., zmixf(:) ) )
7108 !
7109 !
7110 !* 8.2 Compute final midlevel values for entr. and detrainment
7111 ! after call of distribution function
7112 ! -------------------------------------------------------
7113 !
7114 !
7115  CALL convect_mixing_funct ( klon, zmixf, 1, ze2, zd2 )
7116 ! Note: routine MIXING_FUNCT returns fractional entrainm/detrainm. rates
7117 !
7118 ! ZWORK1(:) = XENTR * PMFLCL(:) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
7119 !*MOD
7120  zwork1(:) = xentr * xg / xcrad * pumf(:,jk) * ( pz(:,jkp) - pz(:,jk) )
7121 ! ZWORK1(:) = XENTR * pumf(:,jk) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
7122 !*MOD
7123  zwork2(:) = 0.
7124  WHERE ( gwork1(:) ) zwork2(:) = 1.
7125  WHERE ( puthv(:,jkp) > pthv(:,jkp) )
7126  puer(:,jkp) = 0.5 * zwork1(:) * ( ze1(:) + ze2(:) ) * zwork2(:)
7127  pudr(:,jkp) = 0.5 * zwork1(:) * ( zd1(:) + zd2(:) ) * zwork2(:)
7128  ELSEWHERE
7129  puer(:,jkp) = 0.
7130  pudr(:,jkp) = zwork1(:) * zwork2(:)
7131  END WHERE
7132 !
7133 !* 8.3 Determine equilibrium temperature level
7134 ! --------------------------------------
7135 !
7136  WHERE ( puthv(:,jkp) > pthv(:,jkp) .AND. jk > klcl(:) + 1 &
7137  .AND. gwork1(:) )
7138  ketl(:) = jkp ! equilibrium temperature level
7139  END WHERE
7140 !
7141 !* 8.4 If the calculated detrained mass flux is greater than
7142 ! the total updraft mass flux, or vertical velocity is
7143 ! negative, all cloud mass detrains at previous model level,
7144 ! exit updraft calculations - CTL is attained
7145 ! -------------------------------------------------------
7146 !
7147  WHERE( gwork1(:) ) &
7148  gwork2(:) = pumf(:,jk) - pudr(:,jkp) > 10. .AND. zuw2(:) > 0.
7149  WHERE ( gwork2(:) ) kctl(:) = jkp ! cloud top level
7150  gwork1(:) = gwork2(:) .AND. gwork4(:)
7151 !
7152  IF ( count( gwork2(:) ) == 0 ) EXIT
7153 !
7154 !
7155 !* 9. Compute CAPE for undilute ascent using theta_e and
7156 ! theta_es instead of theta_v. This estimation produces
7157 ! a significantly larger value for CAPE than the actual one.
7158 ! ----------------------------------------------------------
7159 !
7160  WHERE ( gwork1(:) )
7161 !
7162  zwork3(:) = pz(:,jkp) - pz(:,jk) * zwork6(:) - &
7163  ( 1. - zwork6(:) ) * pzlcl(:) ! level thickness
7164  zwork2(:) = pthes(:,jk) + ( 1. - zwork6(:) ) * &
7165  ( pthes(:,jkp) - pthes(:,jk) ) / ( pz(:,jkp) - pz(:,jk) ) * &
7166  ( pzlcl(:) - pz(:,jk) ) ! linear interpolation for theta_es at LCL
7167  ! ( this is only done for model level just above LCL
7168 !
7169  zwork1(:) = ( 2. * ztheul(:) ) / ( zwork2(:) + pthes(:,jkp) ) - 1.
7170  pcape(:) = pcape(:) + xg * zwork3(:) * max( 0., zwork1(:) )
7171 !
7172 !
7173 !* 10. Compute final values of updraft mass flux, enthalpy, r_w
7174 ! at level k+1
7175 ! --------------------------------------------------------
7176 !
7177  pumf(:,jkp) = pumf(:,jk) - pudr(:,jkp) + puer(:,jkp)
7178  pumf(:,jkp) = max( pumf(:,jkp), 0.1 )
7179  puthl(:,jkp) = ( pumf(:,jk) * puthl(:,jk) + &
7180  puer(:,jkp) * pthl(:,jk) - pudr(:,jkp) * puthl(:,jk) ) &
7181  / pumf(:,jkp)
7182  purw(:,jkp) = ( pumf(:,jk) * purw(:,jk) + &
7183  puer(:,jkp) * prw(:,jk) - pudr(:,jkp) * purw(:,jk) ) &
7184  / pumf(:,jkp)
7185 !
7186 !
7187  ze1(:) = ze2(:) ! update fractional entrainment/detrainment
7188  zd1(:) = zd2(:)
7189 !
7190  END WHERE
7191 !
7192 END DO
7193 !
7194 !* 12.1 Set OTRIG to False if cloud thickness < 0.5km
7195 ! or > 3km (deep convection) or CAPE < 1
7196 ! ------------------------------------------------
7197 !
7198  DO ji = 1, iie
7199  jk = kctl(ji)
7200  zwork1(ji) = pz(ji,jk) - pzlcl(ji)
7201  otrig(ji) = zwork1(ji) >= xcdepth .AND. zwork1(ji) < 3.e3 &
7202  .AND. pcape(ji) > 1.
7203  END DO
7204  WHERE( .NOT. otrig(:) )
7205  kctl(:) = ikb
7206  END WHERE
7207 ketl(:) = max( ketl(:), klcl(:) + 2 )
7208 ketl(:) = min( ketl(:), kctl(:) )
7209 !
7210 !
7211 !* 12.2 If the ETL and CTL are the same detrain updraft mass
7212 ! flux at this level
7213 ! -------------------------------------------------------
7214 !
7215 zwork1(:) = 0.
7216 WHERE ( ketl(:) == kctl(:) ) zwork1(:) = 1.
7217 !
7218 DO ji = 1, iie
7219  jk = ketl(ji)
7220  pudr(ji,jk) = pudr(ji,jk) + &
7221  ( pumf(ji,jk) - puer(ji,jk) ) * zwork1(ji)
7222  puer(ji,jk) = puer(ji,jk) * ( 1. - zwork1(ji) )
7223  pumf(ji,jk) = pumf(ji,jk) * ( 1. - zwork1(ji) )
7224  jkp = kctl(ji) + 1
7225  puer(ji,jkp) = 0. ! entrainm/detr rates have been already computed
7226  pudr(ji,jkp) = 0. ! at level KCTL+1, set them to zero
7227 END DO
7228 !
7229 !* 12.3 Adjust mass flux profiles, detrainment rates, and
7230 ! precipitation fallout rates to reflect linear decrease
7231 ! in mass flux between the ETL and CTL
7232 ! -------------------------------------------------------
7233 !
7234 zwork1(:) = 0.
7235 jk1 = minval( ketl(:) )
7236 jk2 = maxval( kctl(:) )
7237 
7238 DO jk = jk1, jk2
7239  DO ji = 1, iie
7240  IF( jk > ketl(ji) .AND. jk <= kctl(ji) ) THEN
7241  zwork1(ji) = zwork1(ji) + pdpres(ji,jk)
7242  END IF
7243  END DO
7244 END DO
7245 !
7246 DO ji = 1, iie
7247  jk = ketl(ji)
7248  zwork1(ji) = pumf(ji,jk) / max( 1., zwork1(ji) )
7249 END DO
7250 !
7251 DO jk = jk1 + 1, jk2
7252  jkp = jk - 1
7253  DO ji = 1, iie
7254  IF ( jk > ketl(ji) .AND. jk <= kctl(ji) ) THEN
7255  pudr(ji,jk) = pdpres(ji,jk) * zwork1(ji)
7256  pumf(ji,jk) = pumf(ji,jkp) - pudr(ji,jk)
7257  END IF
7258  END DO
7259 END DO
7260 !
7261 ! 12.4 Set mass flux and entrainment in the source layer.
7262 ! Linear increase throughout the source layer.
7263 ! -------------------------------------------------------
7264 !
7265 !IWORK(:) = MIN( KPBL(:), KLCL(:) - 1 )
7266 iwork(:) = kpbl(:)
7267 DO ji = 1, iie
7268  jk = kdpl(ji)
7269  jkp = iwork(ji)
7270 ! mixed layer depth
7271  zwork2(ji) = ppres(ji,jk) - ppres(ji,jkp) + pdpres(ji,jk)
7272 END DO
7273 !
7274 jkp = maxval( iwork(:) )
7275 DO jk = jkm, jkp
7276  DO ji = 1, iie
7277  IF ( jk >= kdpl(ji) .AND. jk <= iwork(ji) ) THEN
7278  puer(ji,jk) = puer(ji,jk) + pmflcl(ji) * pdpres(ji,jk) / ( zwork2(ji) + 0.1 )
7279  pumf(ji,jk) = pumf(ji,jk-1) + puer(ji,jk)
7280  END IF
7281  END DO
7282 END DO
7283 !
7284 !
7285 !* 13. If cloud thickness is smaller than .5 km or > 3 km
7286 ! no shallow convection is allowed
7287 ! Nota: For technical reasons, we stop the convection
7288 ! computations in this case and do not go back to
7289 ! TRIGGER_FUNCT to look for the next unstable LCL
7290 ! which could produce a thicker cloud.
7291 ! ---------------------------------------------------
7292 !
7293 gwork6(:,:) = spread( otrig(:), dim=2, ncopies=klev )
7294 WHERE ( .NOT. gwork6(:,:) )
7295  pumf(:,:) = 0.
7296  pudr(:,:) = 0.
7297  puer(:,:) = 0.
7298  puthl(:,:) = pthl(:,:)
7299  purw(:,:) = prw(:,:)
7300  purc(:,:) = 0.
7301  puri(:,:) = 0.
7302 END WHERE
7303 !
7304 END SUBROUTINE convect_updraft_shal
7305 ! ######spl
7306  SUBROUTINE convect_closure_shal( KLON, KLEV, &
7307  ppres, pdpres, pz, pdxdy, plmass, &
7308  pthl, pth, prw, prc, pri, otrig1, &
7309  pthc, prwc, prcc, pric, pwsub, &
7310  klcl, kdpl, kpbl, kctl, &
7311  pumf, puer, pudr, puthl, purw, &
7312  purc, puri, pcape, ptimec, kftsteps )
7313 ! #######################################################################
7314 !
7315 !!**** Uses modified Fritsch-Chappell closure
7316 !!
7317 !!
7318 !! PURPOSE
7319 !! -------
7320 !! The purpose of this routine is to determine the final adjusted
7321 !! (over a time step PTIMEC) environmental values of THETA_l, R_w, R_c, R_i
7322 !! The final convective tendencies can then be evaluated in the main
7323 !! routine DEEP_CONVECT by (PTHC-PTH)/PTIMEC
7324 !!
7325 !!
7326 !!** METHOD
7327 !! ------
7328 !! Computations are done at every model level starting from bottom.
7329 !! The use of masks allows to optimise the inner loops (horizontal loops).
7330 !!
7331 !!
7332 !!
7333 !! EXTERNAL
7334 !! --------
7335 !!
7336 !! CONVECT_CLOSURE_THRVLCL
7337 !! CONVECT_CLOSURE_ADJUST_SHAL
7338 !!
7339 !! IMPLICIT ARGUMENTS
7340 !! ------------------
7341 !! Module MODD_CST
7342 !! XG ! gravity constant
7343 !! XP00 ! reference pressure
7344 !! XRD, XRV ! gaz constants for dry air and water vapor
7345 !! XCPD, XCPV ! specific heat for dry air and water vapor
7346 !! XCL, XCI ! specific heat for liquid water and ice
7347 !! XTT ! triple point temperature
7348 !! XLVTT, XLSTT ! vaporization, sublimation heat constant
7349 !!
7350 !! Module MODD_CONVPAR_SHAL
7351 !! XA25 ! reference grid area
7352 !! XSTABT ! stability factor in time integration
7353 !! XSTABC ! stability factor in CAPE adjustment
7354 !!
7355 !! Module MODD_CONVPAREXT
7356 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
7357 !!
7358 !!
7359 !! REFERENCE
7360 !! ---------
7361 !!
7362 !! Book1,2 of documentation ( routine CONVECT_CLOSURE)
7363 !! Fritsch and Chappell, 1980, J. Atmos. Sci.
7364 !! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
7365 !!
7366 !! AUTHOR
7367 !! ------
7368 !! P. BECHTOLD * Laboratoire d'Aerologie *
7369 !!
7370 !! MODIFICATIONS
7371 !! -------------
7372 !! Original 26/03/96
7373 !! Peter Bechtold 15/11/96 change for enthalpie, r_c + r_i tendencies
7374 !! Tony Dore 14/10/96 Initialise local variables
7375 !-------------------------------------------------------------------------------
7376 !
7377 !* 0. DECLARATIONS
7378 ! ------------
7379 !
7380 USE modd_cst
7381 USE modd_convpar_shal
7382 USE modd_convparext
7383 !
7384 !
7385 IMPLICIT NONE
7386 !
7387 !* 0.1 Declarations of dummy arguments :
7388 !
7389 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
7390 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
7391 INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
7392 INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
7393 INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
7394 INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
7395 REAL, DIMENSION(KLON), INTENT(INOUT) :: PTIMEC ! convection time step
7396 REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
7397 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
7398 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH ! grid scale theta
7399 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW ! grid scale total water
7400  ! mixing ratio
7401 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC ! grid scale r_c
7402 REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI ! grid scale r_i
7403 LOGICAL, DIMENSION(KLON), INTENT(IN) :: OTRIG1 ! logical to keep trace of
7404  ! convective arrays modified in UPDRAFT
7405 !
7406 !
7407 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
7408 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
7409  ! bottom and top of layer (Pa)
7410 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
7411 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
7412 REAL, DIMENSION(KLON), INTENT(IN) :: PCAPE ! available potent. energy
7413 INTEGER, INTENT(OUT) :: KFTSTEPS! maximum of fract time steps
7414  ! only used for chemical tracers
7415 !
7416 !
7417 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s)
7418 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER ! updraft entrainment (kg/s)
7419 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR ! updraft detrainment (kg/s)
7420 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
7421 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
7422 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft cloud water (kg/kg)
7423 REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft cloud ice (kg/kg)
7424 !
7425 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PTHC ! conv. adj. grid scale theta
7426 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRWC ! conv. adj. grid scale r_w
7427 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRCC ! conv. adj. grid scale r_c
7428 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRIC ! conv. adj. grid scale r_i
7429 REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PWSUB ! envir. compensating subsidence(Pa/s)
7430 !
7431 !* 0.2 Declarations of local variables :
7432 !
7433 INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
7434 INTEGER :: IKS ! vertical dimension
7435 INTEGER :: JK, JKP, JKMAX ! vertical loop index
7436 INTEGER :: JI ! horizontal loop index
7437 INTEGER :: JITER ! iteration loop index
7438 INTEGER :: JSTEP ! fractional time loop index
7439 REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
7440 REAL :: ZCVOCD, ZEPSA ! C_pv / C_pd, R_v / R_d
7441 !
7442 REAL, DIMENSION(KLON,KLEV) :: ZTHLC ! convectively adjusted
7443  ! grid scale enthalpy
7444 REAL, DIMENSION(KLON,KLEV) :: ZOMG ! conv. environm. subsidence (Pa/s)
7445 REAL, DIMENSION(KLON,KLEV) :: ZUMF ! non-adjusted updraft mass flux
7446 REAL, DIMENSION(KLON,KLEV) :: ZUER ! " updraft entrainm. rate
7447 REAL, DIMENSION(KLON,KLEV) :: ZUDR ! " updraft detrainm. rate
7448 REAL, DIMENSION(KLON) :: ZADJ ! mass adjustment factor
7449 REAL, DIMENSION(KLON) :: ZADJMAX ! limit value for ZADJ
7450 REAL, DIMENSION(KLON) :: ZCAPE ! new CAPE after adjustment
7451 REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
7452 REAL, DIMENSION(KLON,KLEV):: ZTIMC ! 2D work array for ZTIMEC
7453 !
7454 REAL, DIMENSION(KLON) :: ZTHLCL ! new theta at LCL
7455 REAL, DIMENSION(KLON) :: ZRVLCL ! new r_v at LCL
7456 REAL, DIMENSION(KLON) :: ZZLCL ! height of LCL
7457 REAL, DIMENSION(KLON) :: ZTLCL ! temperature at LCL
7458 REAL, DIMENSION(KLON) :: ZTELCL ! envir. temper. at LCL
7459 REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
7460 REAL, DIMENSION(KLON) :: ZTHES1, ZTHES2! saturation environm. theta_e
7461 REAL, DIMENSION(KLON,KLEV) :: ZTHMFIN, ZTHMFOUT, ZRWMFIN, ZRWMFOUT
7462 REAL, DIMENSION(KLON,KLEV) :: ZRCMFIN, ZRCMFOUT, ZRIMFIN, ZRIMFOUT
7463  ! work arrays for environm. compensat. mass flux
7464 REAL, DIMENSION(KLON) :: ZPI ! (P/P00)**R_d/C_pd
7465 REAL, DIMENSION(KLON) :: ZLV ! latent heat of vaporisation
7466 REAL, DIMENSION(KLON) :: ZLS ! latent heat of sublimation
7467 REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
7468 INTEGER, DIMENSION(KLON) :: ITSTEP ! fractional convective time step
7469 INTEGER, DIMENSION(KLON) :: ICOUNT ! timestep counter
7470 INTEGER, DIMENSION(KLON) :: ILCL ! index lifting condens. level
7471 INTEGER, DIMENSION(KLON) :: IWORK1 ! work array
7472 REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
7473 LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK3! work arrays
7474 LOGICAL, DIMENSION(KLON,KLEV) :: GWORK4 ! work array
7475 !
7476 !
7477 !-------------------------------------------------------------------------------
7478 !
7479 !* 0.2 Initialize local variables
7480 ! ----------------------------
7481 !
7482 !
7483 ztimc(:,:) = 0.
7484 zthes2(:) = 0.
7485 zwork1(:) = 0.
7486 zwork2(:) = 0.
7487 zwork3(:) = 0.
7488 zwork4(:) = 0.
7489 zwork5(:) = 0.
7490 gwork1(:) = .false.
7491 gwork3(:) = .false.
7492 gwork4(:,:) = .false.
7493 ilcl(:) = klcl(:)
7494 !
7495 zcpord = xcpd / xrd
7496 zrdocp = xrd / xcpd
7497 zcvocd = xcpv / xcpd
7498 zepsa = xrv / xrd
7499 !
7500 zadj(:) = 1.
7501 zwork5(:) = 1.
7502 WHERE( .NOT. otrig1(:) ) zwork5(:) = 0.
7503 !
7504 !
7505 !* 0.3 Compute loop bounds
7506 ! -------------------
7507 !
7508 iie = klon
7509 ikb = 1 + jcvexb
7510 iks = klev
7511 ike = klev - jcvext
7512 jkmax = maxval( kctl(:) )
7513 !
7514 !
7515 !* 2. Save initial mass flux values to be used in adjustment procedure
7516 ! ---------------------------------------------------------------
7517 !
7518 zumf(:,:) = pumf(:,:)
7519 zuer(:,:) = puer(:,:)
7520 zudr(:,:) = pudr(:,:)
7521 zomg(:,:) = 0.
7522 pwsub(:,:) = 0.
7523 !
7524 !
7525 !* 3. Compute limits on the closure adjustment factor so that the
7526 ! inflow in convective drafts from a given layer can't be larger
7527 ! than the mass contained in this layer initially.
7528 ! ---------------------------------------------------------------
7529 !
7530 zadjmax(:) = 1000.
7531 iwork1(:) = ilcl(:)
7532 jkp = minval( kdpl(:) )
7533 DO jk = jkp, ike
7534  DO ji = 1, iie
7535  IF( jk > kdpl(ji) .AND. jk <= iwork1(ji) ) THEN
7536  zwork1(ji) = plmass(ji,jk) / ( ( puer(ji,jk) + 1.e-5 ) * ptimec(ji) )
7537  zadjmax(ji) = min( zadjmax(ji), zwork1(ji) )
7538  END IF
7539  END DO
7540 END DO
7541 !
7542 !
7543 gwork1(:) = otrig1(:) ! logical array to limit adjustment to not definitively
7544  ! adjusted columns
7545 !
7546 DO jk = ikb, ike
7547  zthlc(:,jk) = pthl(:,jk) ! initialize adjusted envir. values
7548  prwc(:,jk) = prw(:,jk)
7549  prcc(:,jk) = prc(:,jk)
7550  pric(:,jk) = pri(:,jk)
7551  pthc(:,jk) = pth(:,jk)
7552 END DO
7553 !
7554 !
7555 !
7556 DO jiter = 1, 7 ! Enter adjustment loop to assure that all CAPE is
7557  ! removed within the advective time interval TIMEC
7558 !
7559  ztimec(:) = ptimec(:)
7560  gwork4(:,:) = spread( gwork1(:), dim=2, ncopies=iks )
7561  WHERE( gwork4(:,:) ) pwsub(:,:) = 0.
7562  zomg(:,:)=0.
7563 !
7564  DO jk = ikb + 1, jkmax
7565  jkp = max( ikb + 1, jk - 1 )
7566  WHERE ( gwork1(:) .AND. jk <= kctl(:) )
7567 !
7568 !
7569 !* 4. Determine vertical velocity at top and bottom of each layer
7570 ! to satisfy mass continuity.
7571 ! ---------------------------------------------------------------
7572  ! we compute here Domega/Dp = - g rho Dw/Dz = 1/Dt
7573 !
7574  zwork1(:) = - ( puer(:,jkp) - pudr(:,jkp) ) / plmass(:,jkp)
7575 !
7576  pwsub(:,jk) = pwsub(:,jkp) - pdpres(:,jk-1) * zwork1(:)
7577  ! we use PDPRES(JK-1) and not JKP in order to have zero subsidence
7578  ! at the first layer
7579 !
7580 !
7581 !* 5. Compute fractional time step. For stability or
7582 ! mass conservation reasons one must split full time step PTIMEC)
7583 ! ---------------------------------------------------------------
7584 !
7585  zwork1(:) = xstabt * pdpres(:,jkp) / ( abs( pwsub(:,jk) ) + 1.e-10 )
7586  ! the factor XSTABT is used for stability reasons
7587  ztimec(:) = min( ztimec(:), zwork1(:) )
7588 !
7589  ! transform vertical velocity in mass flux units
7590  zomg(:,jk) = pwsub(:,jk) * pdxdy(:) / xg
7591  END WHERE
7592  END DO
7593 !
7594 !
7595  WHERE( gwork4(:,:) )
7596  zthlc(:,:) = pthl(:,:) ! reinitialize adjusted envir. values
7597  prwc(:,:) = prw(:,:) ! when iteration criterium not attained
7598  prcc(:,:) = prc(:,:)
7599  pric(:,:) = pri(:,:)
7600  pthc(:,:) = pth(:,:)
7601  END WHERE
7602 !
7603 !
7604 ! 6. Check for mass conservation, i.e. ZWORK1 > 1.E-2
7605 ! If mass is not conserved, the convective tendencies
7606 ! automatically become zero.
7607 ! ----------------------------------------------------
7608 !
7609  DO ji = 1, iie
7610  jk=kctl(ji)
7611  zwork1(ji) = pudr(ji,jk) * pdpres(ji,jk) / ( plmass(ji,jk) + .1 ) &
7612  - pwsub(ji,jk)
7613  END DO
7614  WHERE( gwork1(:) .AND. abs( zwork1(:) ) - .01 > 0. )
7615  gwork1(:) = .false.
7616  ptimec(:) = 1.e-1
7617  zwork5(:) = 0.
7618  END WHERE
7619  DO jk = ikb, ike
7620  pwsub(:,jk) = pwsub(:,jk) * zwork5(:)
7621  END DO
7622  gwork4(:,1:ikb) = .false.
7623  gwork4(:,iks) = .false.
7624 !
7625  itstep(:) = int( ptimec(:) / ztimec(:) ) + 1
7626  ztimec(:) = ptimec(:) / REAL( ITSTEP(:) ) ! adjust fractional time step
7627  ! to be an integer multiple of PTIMEC
7628  ztimc(:,:)= spread( ztimec(:), dim=2, ncopies=iks )
7629  icount(:) = 0
7630 !
7631 !
7632 !
7633  kftsteps = maxval( itstep(:) )
7634  DO jstep = 1, kftsteps ! Enter the fractional time step loop here
7635 !
7636  icount(:) = icount(:) + 1
7637 !
7638  gwork3(:) = itstep(:) >= icount(:) .AND. gwork1(:)
7639 !
7640 !
7641 !* 7. Assign enthalpy and r_w values at the top and bottom of each
7642 ! layer based on the sign of w
7643 ! ------------------------------------------------------------
7644 !
7645  zthmfin(:,:) = 0.
7646  zrwmfin(:,:) = 0.
7647  zrcmfin(:,:) = 0.
7648  zrimfin(:,:) = 0.
7649  zthmfout(:,:) = 0.
7650  zrwmfout(:,:) = 0.
7651  zrcmfout(:,:) = 0.
7652  zrimfout(:,:) = 0.
7653 !
7654  DO jk = ikb + 1, jkmax
7655  gwork4(:,jk) = gwork3(:) .AND. jk <= kctl(:)
7656  jkp = max( ikb + 1, jk - 1 )
7657  DO ji = 1, iie
7658  IF ( gwork3(ji) ) THEN
7659 !
7660  zwork1(ji) = sign( 1., zomg(ji,jk) )
7661  zwork2(ji) = 0.5 * ( 1. + zwork1(ji) )
7662  zwork1(ji) = 0.5 * ( 1. - zwork1(ji) )
7663  zthmfin(ji,jk) = - zomg(ji,jk) * zthlc(ji,jkp) * zwork1(ji)
7664  zthmfout(ji,jk) = zomg(ji,jk) * zthlc(ji,jk) * zwork2(ji)
7665  zthmfin(ji,jkp) = zthmfin(ji,jkp) + zthmfout(ji,jk) * zwork2(ji)
7666  zthmfout(ji,jkp) = zthmfout(ji,jkp) + zthmfin(ji,jk) * zwork1(ji)
7667  zrwmfin(ji,jk) = - zomg(ji,jk) * prwc(ji,jkp) * zwork1(ji)
7668  zrwmfout(ji,jk) = zomg(ji,jk) * prwc(ji,jk) * zwork2(ji)
7669  zrwmfin(ji,jkp) = zrwmfin(ji,jkp) + zrwmfout(ji,jk) * zwork2(ji)
7670  zrwmfout(ji,jkp) = zrwmfout(ji,jkp) + zrwmfin(ji,jk) * zwork1(ji)
7671  zrcmfin(ji,jk) = - zomg(ji,jk) * prcc(ji,jkp) * zwork1(ji)
7672  zrcmfout(ji,jk) = zomg(ji,jk) * prcc(ji,jk) * zwork2(ji)
7673  zrcmfin(ji,jkp) = zrcmfin(ji,jkp) + zrcmfout(ji,jk) * zwork2(ji)
7674  zrcmfout(ji,jkp) = zrcmfout(ji,jkp) + zrcmfin(ji,jk) * zwork1(ji)
7675  zrimfin(ji,jk) = - zomg(ji,jk) * pric(ji,jkp) * zwork1(ji)
7676  zrimfout(ji,jk) = zomg(ji,jk) * pric(ji,jk) * zwork2(ji)
7677  zrimfin(ji,jkp) = zrimfin(ji,jkp) + zrimfout(ji,jk) * zwork2(ji)
7678  zrimfout(ji,jkp) = zrimfout(ji,jkp) + zrimfin(ji,jk) * zwork1(ji)
7679 !
7680  END IF
7681  END DO
7682  END DO
7683 !
7684  WHERE ( gwork4(:,:) )
7685 !
7686 !******************************************************************************
7687 !
7688 !* 8. Update the environmental values of enthalpy and r_w at each level
7689 ! NOTA: These are the MAIN EQUATIONS of the scheme
7690 ! -----------------------------------------------------------------
7691 !
7692 !
7693  zthlc(:,:) = zthlc(:,:) + ztimc(:,:) / plmass(:,:) * ( &
7694  zthmfin(:,:) + pudr(:,:) * puthl(:,:) &
7695  - zthmfout(:,:) - puer(:,:) * pthl(:,:) )
7696  prwc(:,:) = prwc(:,:) + ztimc(:,:) / plmass(:,:) * ( &
7697  zrwmfin(:,:) + pudr(:,:) * purw(:,:) &
7698  - zrwmfout(:,:) - puer(:,:) * prw(:,:) )
7699  prcc(:,:) = prcc(:,:) + ztimc(:,:) / plmass(:,:) * ( &
7700  zrcmfin(:,:) + pudr(:,:) * purc(:,:) - zrcmfout(:,:) - &
7701  puer(:,:) * prc(:,:) )
7702  pric(:,:) = pric(:,:) + ztimc(:,:) / plmass(:,:) * ( &
7703  zrimfin(:,:) + pudr(:,:) * puri(:,:) - zrimfout(:,:) - &
7704  puer(:,:) * pri(:,:) )
7705 !
7706 !
7707 !******************************************************************************
7708 !
7709  END WHERE
7710 !
7711  END DO ! Exit the fractional time step loop
7712 !
7713 !
7714 !* 10. Compute final linearized value of theta envir.
7715 ! ----------------------------------------------
7716 !
7717  DO jk = ikb + 1, jkmax
7718  DO ji = 1, iie
7719  IF( gwork1(ji) .AND. jk <= kctl(ji) ) THEN
7720  zpi(ji) = ( xp00 / ppres(ji,jk) ) ** zrdocp
7721  zcph(ji) = xcpd + prwc(ji,jk) * xcpv
7722  zwork2(ji) = pth(ji,jk) / zpi(ji) ! first temperature estimate
7723  zlv(ji) = xlvtt + ( xcpv - xcl ) * ( zwork2(ji) - xtt )
7724  zls(ji) = xlvtt + ( xcpv - xci ) * ( zwork2(ji) - xtt )
7725  ! final linearized temperature
7726  zwork2(ji) = ( zthlc(ji,jk) + zlv(ji) * prcc(ji,jk) + zls(ji) * pric(ji,jk) &
7727  - (1. + prwc(ji,jk) ) * xg * pz(ji,jk) ) / zcph(ji)
7728  zwork2(ji) = max( 180., min( 340., zwork2(ji) ) )
7729  pthc(ji,jk)= zwork2(ji) * zpi(ji) ! final adjusted envir. theta
7730  END IF
7731  END DO
7732  END DO
7733 !
7734 !
7735 !* 11. Compute new cloud ( properties at new LCL )
7736 ! NOTA: The computations are very close to
7737 ! that in routine TRIGGER_FUNCT
7738 ! ---------------------------------------------
7739 !
7740  CALL convect_closure_thrvlcl( klon, klev, &
7741  ppres, pthc, prwc, pz, gwork1, &
7742  zthlcl, zrvlcl, zzlcl, ztlcl, ztelcl, &
7743  ilcl, kdpl, kpbl )
7744 !
7745 !
7746  ztlcl(:) = max( 230., min( 335., ztlcl(:) ) ) ! set some overflow bounds
7747  ztelcl(:) = max( 230., min( 335., ztelcl(:) ) )
7748  zthlcl(:) = max( 230., min( 345., zthlcl(:) ) )
7749  zrvlcl(:) = max( 0., min( 1., zrvlcl(:) ) )
7750 !
7751 !
7752 !* 12. Compute adjusted CAPE
7753 ! ---------------------
7754 !
7755  zcape(:) = 0.
7756  zpi(:) = zthlcl(:) / ztlcl(:)
7757  zpi(:) = max( 0.95, min( 1.5, zpi(:) ) )
7758  zwork1(:) = xp00 / zpi(:) ** zcpord ! pressure at LCL
7759 !
7760  CALL convect_satmixratio( klon, zwork1, ztelcl, zwork3, zlv, zls, zcph )
7761  zwork3(:) = min( .1, max( 0., zwork3(:) ) )
7762 !
7763  ! compute theta_e updraft undilute
7764  ztheul(:) = ztlcl(:) * zpi(:) ** ( 1. - 0.28 * zrvlcl(:) ) &
7765  * exp( ( 3374.6525 / ztlcl(:) - 2.5403 ) &
7766  * zrvlcl(:) * ( 1. + 0.81 * zrvlcl(:) ) )
7767 !
7768  ! compute theta_e saturated environment at LCL
7769  zthes1(:) = ztelcl(:) * zpi(:) ** ( 1. - 0.28 * zwork3(:) ) &
7770  * exp( ( 3374.6525 / ztelcl(:) - 2.5403 ) &
7771  * zwork3(:) * ( 1. + 0.81 * zwork3(:) ) )
7772 !
7773  DO jk = minval( ilcl(:) ), jkmax
7774  jkp = jk - 1
7775  DO ji = 1, iie
7776  zwork4(ji) = 1.
7777  IF ( jk == ilcl(ji) ) zwork4(ji) = 0.
7778 !
7779  ! compute theta_e saturated environment and adjusted values
7780  ! of theta
7781 !
7782  gwork3(ji) = jk >= ilcl(ji) .AND. jk <= kctl(ji) .AND. gwork1(ji)
7783 !
7784  zpi(ji) = ( xp00 / ppres(ji,jk) ) ** zrdocp
7785  zwork2(ji) = pthc(ji,jk) / zpi(ji)
7786  END DO
7787 !
7788  CALL convect_satmixratio( klon, ppres(:,jk), zwork2, zwork3, zlv, zls, zcph )
7789 !
7790 !
7791  DO ji = 1, iie
7792  IF ( gwork3(ji) ) THEN
7793  zthes2(ji) = zwork2(ji) * zpi(ji) ** ( 1. - 0.28 * zwork3(ji) ) &
7794  * exp( ( 3374.6525 / zwork2(ji) - 2.5403 ) &
7795  * zwork3(ji) * ( 1. + 0.81 * zwork3(ji) ) )
7796 !
7797  zwork3(ji) = pz(ji,jk) - pz(ji,jkp) * zwork4(ji) - &
7798  ( 1. - zwork4(ji) ) * zzlcl(ji) ! level thickness
7799  zwork1(ji) = ( 2. * ztheul(ji) ) / ( zthes1(ji) + zthes2(ji) ) - 1.
7800  zcape(ji) = zcape(ji) + xg * zwork3(ji) * max( 0., zwork1(ji) )
7801  zthes1(ji) = zthes2(ji)
7802  END IF
7803  END DO
7804  END DO
7805 !
7806 !
7807 !* 13. Determine mass adjustment factor knowing how much
7808 ! CAPE has been removed.
7809 ! -------------------------------------------------
7810 !
7811  WHERE ( gwork1(:) )
7812  zwork1(:) = max( pcape(:) - zcape(:), 0.1 * pcape(:) )
7813  zwork2(:) = zcape(:) / ( pcape(:) + 1.e-8 )
7814 !
7815  gwork1(:) = zwork2(:) > 0.1 .OR. zcape(:) == 0. ! mask for adjustment
7816  END WHERE
7817 !
7818  WHERE ( zcape(:) == 0. .AND. gwork1(:) ) zadj(:) = zadj(:) * 0.5
7819  WHERE ( zcape(:) /= 0. .AND. gwork1(:) ) &
7820  zadj(:) = zadj(:) * xstabc * pcape(:) / ( zwork1(:) + 1.e-8 )
7821  zadj(:) = min( zadj(:), zadjmax(:) )
7822 !
7823 !
7824 !* 13. Adjust mass flux by the factor ZADJ to converge to
7825 ! specified degree of stabilization
7826 ! ----------------------------------------------------
7827 !
7828  CALL convect_closure_adjust_shal( klon, klev, zadj, &
7829  pumf, zumf, puer, zuer, pudr, zudr )
7830 !
7831 !
7832  IF ( count( gwork1(:) ) == 0 ) EXIT ! exit big adjustment iteration loop
7833  ! when all columns have reached
7834  ! desired degree of stabilization.
7835 !
7836 END DO ! end of big adjustment iteration loop
7837 !
7838 !
7839  ! skip adj. total water array to water vapor
7840 DO jk = ikb, ike
7841  prwc(:,jk) = max( 0., prwc(:,jk) - prcc(:,jk) - pric(:,jk) )
7842 END DO
7843 !
7844 !
7845 END SUBROUTINE convect_closure_shal
7846 ! ######spl
7847  SUBROUTINE convect_closure_adjust_shal( KLON, KLEV, PADJ, &
7848  pumf, pzumf, puer, pzuer, pudr, pzudr )
7849 ! #########################################################################
7850 !
7851 !!**** Uses closure adjustment factor to adjust mass flux and to modify
7852 !! precipitation efficiency when necessary. The computations are
7853 !! similar to routine CONVECT_PRECIP_ADJUST.
7854 !!
7855 !!
7856 !! PURPOSE
7857 !! -------
7858 !! The purpose of this routine is to adjust the mass flux using the
7859 !! factor PADJ computed in CONVECT_CLOSURE
7860 !!
7861 !!
7862 !!** METHOD
7863 !! ------
7864 !! Computations are done at every model level starting from bottom.
7865 !! The use of masks allows to optimise the inner loops (horizontal loops).
7866 !!
7867 !!
7868 !! EXTERNAL
7869 !! --------
7870 !! Module MODD_CONVPAREXT
7871 !! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
7872 !!
7873 !! None
7874 !!
7875 !! IMPLICIT ARGUMENTS
7876 !! ------------------
7877 !!
7878 !! None
7879 !!
7880 !! REFERENCE
7881 !! ---------
7882 !!
7883 !! Book1,2 of documentation ( routine CONVECT_CLOSURE_ADJUST)
7884 !!
7885 !! AUTHOR
7886 !! ------
7887 !! P. BECHTOLD * Laboratoire d'Aerologie *
7888 !!
7889 !! MODIFICATIONS
7890 !! -------------
7891 !! Original 26/03/96
7892 !! Last modified 15/11/96
7893 !-------------------------------------------------------------------------------
7894 !
7895 !* 0. DECLARATIONS
7896 ! ------------
7897 !
7898 USE modd_convparext
7899 !
7900 IMPLICIT NONE
7901 !
7902 !* 0.1 Declarations of dummy arguments :
7903 !
7904 !
7905 INTEGER, INTENT(IN) :: KLON ! horizontal dimension
7906 INTEGER, INTENT(IN) :: KLEV ! vertical dimension
7907 REAL, DIMENSION(KLON), INTENT(IN) :: PADJ ! mass adjustment factor
7908 !
7909 !
7910 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
7911 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of "
7912 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
7913 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of "
7914 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
7915 REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of "
7916 !
7917 !
7918 !* 0.2 Declarations of local variables :
7919 !
7920 INTEGER :: IIE, IKB, IKE ! horiz. + vert. loop bounds
7921 INTEGER :: JK ! vertical loop index
7922 !
7923 !
7924 !-------------------------------------------------------------------------------
7925 !
7926 !* 0.3 Compute loop bounds
7927 ! -------------------
7928 !
7929 iie = klon
7930 ikb = 1 + jcvexb
7931 ike = klev - jcvext
7932 !
7933 !
7934 !* 1. Adjust mass flux by the factor PADJ to converge to
7935 ! specified degree of stabilization
7936 ! ----------------------------------------------------
7937 !
7938  DO jk = ikb + 1, ike
7939  pumf(:,jk) = pzumf(:,jk) * padj(:)
7940  puer(:,jk) = pzuer(:,jk) * padj(:)
7941  pudr(:,jk) = pzudr(:,jk) * padj(:)
7942  END DO
7943 !
7944 END SUBROUTINE convect_closure_adjust_shal
modd_convpar_shal::xnhgam
real, save xnhgam
Definition: CVAmnh.f90:5375
ini_convpar1
subroutine ini_convpar1
Definition: CVAmnh.f90:627
modd_cst::xp00
real, save xp00
Definition: CVAmnh.f90:411
modd_cst::xgami
real, save xgami
Definition: CVAmnh.f90:433
modd_cst::xrv
real, save xrv
Definition: CVAmnh.f90:417
convect_closure_shal
subroutine convect_closure_shal(KLON, KLEV, PPRES, PDPRES, PZ, PDXDY, PLMASS, PTHL, PTH, PRW, PRC, PRI, OTRIG1, PTHC, PRWC, PRCC, PRIC, PWSUB, KLCL, KDPL, KPBL, KCTL, PUMF, PUER, PUDR, PUTHL, PURW, PURC, PURI, PCAPE, PTIMEC, KFTSTEPS)
Definition: CVAmnh.f90:7313
convect_closure_adjust_shal
subroutine convect_closure_adjust_shal(KLON, KLEV, PADJ, PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR)
Definition: CVAmnh.f90:7849
convect_satmixratio
subroutine convect_satmixratio(KLON, PPRES, PT, PEW, PLV, PLS, PCPH)
Definition: CVAmnh.f90:2968
pth
INTERFACE SUBROUTINE RRTM_ECRT_140GP pth
Definition: rrtm_ecrt_140gp.intfb.h:3
modd_convpar::xzlcl
real, save xzlcl
Definition: CVAmnh.f90:477
modd_convpar_shal
Definition: CVAmnh.f90:5326
modd_cst::xalpi
real, save xalpi
Definition: CVAmnh.f90:431
modd_convpar::xstabt
real, save xstabt
Definition: CVAmnh.f90:494
modd_convpar_shal::xa25
real, save xa25
Definition: CVAmnh.f90:5360
modd_convpar::xstabc
real, save xstabc
Definition: CVAmnh.f90:496
modd_cst::xestt
real, save xestt
Definition: CVAmnh.f90:427
modd_cst::xcpv
real, save xcpv
Definition: CVAmnh.f90:419
modd_convpar_shal::xcrad
real, save xcrad
Definition: CVAmnh.f90:5362
convect_closure
subroutine convect_closure(KLON, KLEV, PPRES, PDPRES, PZ, PDXDY, PLMASS, PTHL, PTH, PRW, PRC, PRI, OTRIG1, PTHC, PRWC, PRCC, PRIC, PWSUB, KLCL, KDPL, KPBL, KLFS, KCTL, KML, PUMF, PUER, PUDR, PUTHL, PURW, PURC, PURI, PUPR, PDMF, PDER, PDDR, PDTHL, PDRW, PTPR, PSPR, PDTEVR, PCAPE, PTIMEC, KFTSTEPS, PDTEVRF, PPRLFLX, PPRSFLX)
Definition: CVAmnh.f90:4066
modd_convpar_shal::xcdepth_d
real, save xcdepth_d
Definition: CVAmnh.f90:5365
modd_convpar_shal::xstabc
real, save xstabc
Definition: CVAmnh.f90:5384
modd_convpar
Definition: CVAmnh.f90:437
modd_cst::xbetaw
real, save xbetaw
Definition: CVAmnh.f90:429
modd_cst::xci
real, save xci
Definition: CVAmnh.f90:422
convect_trigger_shal
subroutine convect_trigger_shal(KLON, KLEV, PPRES, PTH, PTHV, PTHES, PRV, PW, PZ, PDXDY, PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, KLCL, KDPL, KPBL, OTRIG)
Definition: CVAmnh.f90:6388
modd_cst::xtt
real, save xtt
Definition: CVAmnh.f90:423
modd_convpar::xnhgam
real, save xnhgam
Definition: CVAmnh.f90:485
modd_convpar::xa25
real, save xa25
Definition: CVAmnh.f90:471
modd_cst::xbetai
real, save xbetai
Definition: CVAmnh.f90:432
convect_closure_thrvlcl
subroutine convect_closure_thrvlcl(KLON, KLEV, PPRES, PTH, PRV, PZ, OWORK1, PTHLCL, PRVLCL, PZLCL, PTLCL, PTELCL, KLCL, KDPL, KPBL)
Definition: CVAmnh.f90:4842
modd_convpar_shal::xzlcl
real, save xzlcl
Definition: CVAmnh.f90:5369
modd_cst::xpi
real, save xpi
Definition: CVAmnh.f90:412
modd_convparext
Definition: CVAmnh.f90:394
modd_convparext::jcvexb
integer, save jcvexb
Definition: CVAmnh.f90:399
convect_updraft_shal
subroutine convect_updraft_shal(KLON, KLEV, KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW, PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, PMFLCL, OTRIG, KLCL, KDPL, KPBL, PUMF, PUER, PUDR, PUTHL, PUTHV, PURW, PURC, PURI, PCAPE, KCTL, KETL)
Definition: CVAmnh.f90:6789
modd_cst::xcpd
real, save xcpd
Definition: CVAmnh.f90:418
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
modd_convpar::xentr
real, save xentr
Definition: CVAmnh.f90:475
modd_convpar::xrconv
real, save xrconv
Definition: CVAmnh.f90:493
modd_convpar_shal::xtfrz1
real, save xtfrz1
Definition: CVAmnh.f90:5378
modd_cst::xlstt
real, save xlstt
Definition: CVAmnh.f90:425
modd_convparext::jcvext
integer, save jcvext
Definition: CVAmnh.f90:401
convect_downdraft
subroutine convect_downdraft(KLON, KLEV, KICE, PPRES, PDPRES, PZ, PTH, PTHES, PRW, PRC, PRI, PPREF, KLCL, KCTL, KETL, PUTHL, PURW, PURC, PURI, PDMF, PDER, PDDR, PDTHL, PDRW, PMIXF, PDTEVR, KLFS, KDBL, KML, PDTEVRF)
Definition: CVAmnh.f90:3351
modd_convpar::xrhdbc
real, save xrhdbc
Definition: CVAmnh.f90:491
modd_cst::xmd
real, save xmd
Definition: CVAmnh.f90:414
convect_trigger_funct
subroutine convect_trigger_funct(KLON, KLEV, PPRES, PTH, PTHV, PTHES, PRV, PW, PZ, PDXDY, PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, KLCL, KDPL, KPBL, OTRIG, PCAPE)
Definition: CVAmnh.f90:1857
convect_updraft
subroutine convect_updraft(KLON, KLEV, KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW, PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, PMFLCL, OTRIG, KLCL, KDPL, KPBL, PUMF, PUER, PUDR, PUTHL, PUTHV, PURW, PURC, PURI, PURR, PURS, PUPR, PUTPR, PCAPE, KCTL, KETL)
Definition: CVAmnh.f90:2267
modd_cst
Definition: CVAmnh.f90:406
modd_convpar_shal::xstabt
real, save xstabt
Definition: CVAmnh.f90:5382
ini_convpar_shal
subroutine ini_convpar_shal
Definition: CVAmnh.f90:5390
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
modd_convpar::xdrvpbl
real, save xdrvpbl
Definition: CVAmnh.f90:482
modd_cst::xg
real, save xg
Definition: CVAmnh.f90:413
convection
subroutine convection(KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, PDTCONV, ODEEP, OSHAL, OREFRESH_ALL, ODOWN, KICE, OSETTADJ, PTADJD, PTADJS, KENSM, PPABS, PZZ, PDXDY, PT, PRV, PRC, PRI, PU, PV, PW, KCOUNT, PTTEN, PRVTEN, PRCTEN, PRITEN, PPRTEN, PPRSTEN, PUMF, PDMF, PPRLFLX, PPRSFLX, PCAPE, KCLTOP, KCLBAS, OCHTRANS, KCH1, PCH1, PCH1TEN)
Definition: CVAmnh.f90:12
modd_convpar_shal::xcdepth
real, save xcdepth
Definition: CVAmnh.f90:5364
modd_convpar_shal::xtfrz2
real, save xtfrz2
Definition: CVAmnh.f90:5379
modd_cst::xgamw
real, save xgamw
Definition: CVAmnh.f90:430
convect_precip_adjust
subroutine convect_precip_adjust(KLON, KLEV, PPRES, PUMF, PUER, PUDR, PUPR, PUTPR, PURW, PDMF, PDER, PDDR, PDTHL, PDRW, PPREF, PTPR, PMIXF, PDTEVR, KLFS, KDBL, KLCL, KCTL, KETL, PDTEVRF)
Definition: CVAmnh.f90:3788
modd_convpar::xzpbl
real, save xzpbl
Definition: CVAmnh.f90:479
modd_cst::xcl
real, save xcl
Definition: CVAmnh.f90:421
modd_convpar_shal::xctime_shal
real, save xctime_shal
Definition: CVAmnh.f90:5363
modd_convpar::xmeldpth
real, save xmeldpth
Definition: CVAmnh.f90:500
convect_closure_adjust
subroutine convect_closure_adjust(KLON, KLEV, PADJ, PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR, PDMF, PZDMF, PDER, PZDER, PDDR, PZDDR, PPRMELT, PZPRMELT, PDTEVR, PZDTEVR, PTPR, PZTPR, PPRLFLX, PZPRLFL, PPRSFLX, PZPRSFL)
Definition: CVAmnh.f90:4715
modd_cst::xrd
real, save xrd
Definition: CVAmnh.f90:416
convect_condens
subroutine convect_condens(KLON, KICE, PPRES, PTHL, PRW, PRCO, PRIO, PZ, OWORK1, PT, PEW, PRC, PRI, PLV, PLS, PCPH)
Definition: CVAmnh.f90:2816
modd_convpar_shal::xwtrig
real, save xwtrig
Definition: CVAmnh.f90:5372
modd_convpar_shal::xzpbl
real, save xzpbl
Definition: CVAmnh.f90:5371
modd_convpar::xtfrz2
real, save xtfrz2
Definition: CVAmnh.f90:489
modd_convpar::xusrdpth
real, save xusrdpth
Definition: CVAmnh.f90:498
modd_convpar::xcdepth
real, save xcdepth
Definition: CVAmnh.f90:474
modd_cst::xlvtt
real, save xlvtt
Definition: CVAmnh.f90:424
modd_cst::xlmtt
real, save xlmtt
Definition: CVAmnh.f90:426
pt
INTERFACE SUBROUTINE RRTM_ECRT_140GP pt
Definition: rrtm_ecrt_140gp.intfb.h:3
modd_convpar::xdthpbl
real, save xdthpbl
Definition: CVAmnh.f90:481
modd_convpar::xuvdp
real, save xuvdp
Definition: CVAmnh.f90:502
convect_mixing_funct
subroutine convect_mixing_funct(KLON, PMIXC, KMF, PER, PDR)
Definition: CVAmnh.f90:3057
ini_convpar
subroutine ini_convpar
Definition: CVAmnh.f90:507
convect_deep
subroutine convect_deep(KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, PDTCONV, KICE, OREFRESH, ODOWN, OSETTADJ, PPABST, PZZ, PDXDY, PTIMEC, PTT, PRVT, PRCT, PRIT, PUT, PVT, PWT, KCOUNT, PTTEN, PRVTEN, PRCTEN, PRITEN, PPRLTEN, PPRSTEN, KCLTOP, KCLBAS, PPRLFLX, PPRSFLX, PUMF, PDMF, PCAPE, OCH1CONV, KCH1, PCH1, PCH1TEN)
Definition: CVAmnh.f90:724
convect_tstep_pref
subroutine convect_tstep_pref(KLON, KLEV, PU, PV, PPRES, PZ, PDXDY, KLCL, KCTL, PTIMEA, PPREF)
Definition: CVAmnh.f90:3178
convect_chem_transport
subroutine convect_chem_transport(KLON, KLEV, KCH, PCH1, PCH1C, KDPL, KPBL, KLCL, KCTL, KLFS, KDBL, PUMF, PUER, PUDR, PDMF, PDER, PDDR, PTIMEC, PDXDY, PMIXF, PLMASS, PWSUB, KFTSTEPS)
Definition: CVAmnh.f90:5099
modd_convpar_shal::xdtpert
real, save xdtpert
Definition: CVAmnh.f90:5366
modd_cst::xrholw
real, save xrholw
Definition: CVAmnh.f90:420
modd_convpar::xwtrig
real, save xwtrig
Definition: CVAmnh.f90:480
convect_shallow
subroutine convect_shallow(KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA, PDTCONV, KICE, OSETTADJ, PTADJS, PPABST, PZZ, PTT, PRVT, PRCT, PRIT, PWT, PTTEN, PRVTEN, PRCTEN, PRITEN, KCLTOP, KCLBAS, PUMF, OCH1CONV, KCH1, PCH1, PCH1TEN)
Definition: CVAmnh.f90:5478
modd_cst::xmv
real, save xmv
Definition: CVAmnh.f90:415
modd_convpar::xtfrz1
real, save xtfrz1
Definition: CVAmnh.f90:488
modd_cst::xalpw
real, save xalpw
Definition: CVAmnh.f90:428
modd_convpar::xcrad
real, save xcrad
Definition: CVAmnh.f90:473
modd_convpar_shal::xentr
real, save xentr
Definition: CVAmnh.f90:5367