source: LMDZ5/branches/IPSLCM6.0.8/libf/phylmd/cva_driver.F90 @ 5455

Last change on this file since 5455 was 2787, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2727:2785 into testing branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 49.2 KB
Line 
1
2! $Id: cva_driver.F90 2787 2017-01-30 16:54:45Z aborella $
3
4SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, k_upper, &
5                      iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
6!!                      delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &  ! jyg
7                      delt, comp_threshold, &                                      ! jyg
8                      t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &          ! jyg
9                      u1, v1, tra1, &
10                      p1, ph1, &
11                      Ale1, Alp1, omega1, &
12                      sig1feed1, sig2feed1, wght1, &
13                      iflag1, ft1, fq1, fu1, fv1, ftra1, &
14                      precip1, kbas1, ktop1, &
15                      cbmf1, plcl1, plfc1, wbeff1, &
16                      sig1, w01, & !input/output
17                      ptop21, sigd1, &
18                      ma1, mip1, Vprecip1, Vprecipi1, upwd1, dnwd1, dnwd01, &      ! jyg
19                      qcondc1, wd1, &
20                      cape1, cin1, tvp1, &
21                      ftd1, fqd1, &
22                      Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
23                      lalim_conv1, &
24!!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
25!!                      elij1,evap1,ep1,epmlmMm1,eplaMm1, &                ! RomP
26                      da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
27                      clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &        ! RomP, RL
28                      wdtrainA1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &
29                      coefw_cld_cv, &                                      ! RomP, AJ
30                      epmax_diag1)  ! epmax_cape
31! **************************************************************
32! *
33! CV_DRIVER                                                   *
34! *
35! *
36! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
37! modified by :                                               *
38! **************************************************************
39! **************************************************************
40
41  USE dimphy
42  USE print_control_mod, ONLY: prt_level, lunout
43  IMPLICIT NONE
44
45! .............................START PROLOGUE............................
46
47
48! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
49! The "1" is removed for the corresponding compressed variables.
50! PARAMETERS:
51! Name            Type         Usage            Description
52! ----------      ----------     -------  ----------------------------
53
54! len           Integer        Input        first (i) dimension
55! nd            Integer        Input        vertical (k) dimension
56! ndp1          Integer        Input        nd + 1
57! ntra          Integer        Input        number of tracors
58! nloc          Integer        Input        dimension of arrays for compressed fields
59! k_upper       Integer        Input        upmost level for vertical loops
60! iflag_con     Integer        Input        version of convect (3/4)
61! iflag_mix     Integer        Input        version of mixing  (0/1/2)
62! iflag_ice_thermo Integer        Input        accounting for ice thermodynamics (0/1)
63! iflag_clos    Integer        Input        version of closure (0/1)
64! tau_cld_cv    Real           Input        characteristic time of dissipation of mixing fluxes
65! coefw_cld_cv  Real           Input        coefficient for updraft velocity in convection
66! ok_conserv_q  Logical        Input        when true corrections for water conservation are swtiched on
67! delt          Real           Input        time step
68! comp_threshold Real           Input       threshold on the fraction of convective points below which
69!                                            fields  are compressed
70! t1            Real           Input        temperature (sat draught envt)
71! q1            Real           Input        specific hum (sat draught envt)
72! qs1           Real           Input        sat specific hum (sat draught envt)
73! t1_wake       Real           Input        temperature (unsat draught envt)
74! q1_wake       Real           Input        specific hum(unsat draught envt)
75! qs1_wake      Real           Input        sat specific hum(unsat draughts envt)
76! s1_wake       Real           Input        fractionnal area covered by wakes
77! u1            Real           Input        u-wind
78! v1            Real           Input        v-wind
79! tra1          Real           Input        tracors
80! p1            Real           Input        full level pressure
81! ph1           Real           Input        half level pressure
82! ALE1          Real           Input        Available lifting Energy
83! ALP1          Real           Input        Available lifting Power
84! sig1feed1     Real           Input        sigma coord at lower bound of feeding layer
85! sig2feed1     Real           Input        sigma coord at upper bound of feeding layer
86! wght1         Real           Input        weight density determining the feeding mixture
87! iflag1        Integer        Output       flag for Emanuel conditions
88! ft1           Real           Output       temp tend
89! fq1           Real           Output       spec hum tend
90! fu1           Real           Output       u-wind tend
91! fv1           Real           Output       v-wind tend
92! ftra1         Real           Output       tracor tend
93! precip1       Real           Output       precipitation
94! kbas1         Integer        Output       cloud base level
95! ktop1         Integer        Output       cloud top level
96! cbmf1         Real           Output       cloud base mass flux
97! sig1          Real           In/Out       section adiabatic updraft
98! w01           Real           In/Out       vertical velocity within adiab updraft
99! ptop21        Real           In/Out       top of entraining zone
100! Ma1           Real           Output       mass flux adiabatic updraft
101! mip1          Real           Output       mass flux shed by the adiabatic updraft
102! Vprecip1      Real           Output       vertical profile of total precipitation
103! Vprecipi1     Real           Output       vertical profile of ice precipitation
104! upwd1         Real           Output       total upward mass flux (adiab+mixed)
105! dnwd1         Real           Output       saturated downward mass flux (mixed)
106! dnwd01        Real           Output       unsaturated downward mass flux
107! qcondc1       Real           Output       in-cld mixing ratio of condensed water
108! wd1           Real           Output       downdraft velocity scale for sfc fluxes
109! cape1         Real           Output       CAPE
110! cin1          Real           Output       CIN
111! tvp1          Real           Output       adiab lifted parcell virt temp
112! ftd1          Real           Output       precip temp tend
113! fqt1          Real           Output       precip spec hum tend
114! Plim11        Real           Output
115! Plim21        Real           Output
116! asupmax1      Real           Output
117! supmax01      Real           Output
118! asupmaxmin1   Real           Output
119
120! ftd1          Real           Output  Array of temperature tendency due to precipitations (K/s) of dimension ND,
121!                                      defined at same grid levels as T, Q, QS and P.
122
123! fqd1          Real           Output  Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
124!                                      of dimension ND, defined at same grid levels as T, Q, QS and P.
125
126! wdtrainA1     Real           Output   precipitation detrained from adiabatic draught;
127!                                         used in tracer transport (cvltr)
128! wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
129!                                         used in tracer transport (cvltr)
130! da1           Real           Output     used in tracer transport (cvltr)
131! phi1          Real           Output     used in tracer transport (cvltr)
132! mp1           Real           Output     used in tracer transport (cvltr)
133! qtc1          Real           Output     specific humidity in convection
134! sigt1         Real           Output     surface fraction in adiabatic updrafts                                         
135! phi21         Real           Output     used in tracer transport (cvltr)
136                                         
137! d1a1          Real           Output     used in tracer transport (cvltr)
138! dam1          Real           Output     used in tracer transport (cvltr)
139                                         
140! epmlmMm1      Real           Output     used in tracer transport (cvltr)
141! eplaMm1       Real           Output     used in tracer transport (cvltr)
142                                         
143! evap1         Real           Output   
144! ep1           Real           Output   
145! sigij1        Real           Output     used in tracer transport (cvltr)
146! clw1          Real           Output   condensed water content of the adiabatic updraught
147! elij1         Real           Output
148! wghti1        Real           Output   final weight of the feeding layers,
149!                                         used in tracer transport (cvltr)
150
151
152! S. Bony, Mar 2002:
153! * Several modules corresponding to different physical processes
154! * Several versions of convect may be used:
155!         - iflag_con=3: version lmd  (previously named convect3)
156!         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
157! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
158! S. Bony, Oct 2002:
159! * Vectorization of convect3 (ie version lmd)
160
161! ..............................END PROLOGUE.............................
162
163
164
165! Input
166  INTEGER, INTENT (IN)                               :: len
167  INTEGER, INTENT (IN)                               :: nd
168  INTEGER, INTENT (IN)                               :: ndp1
169  INTEGER, INTENT (IN)                               :: ntra
170  INTEGER, INTENT(IN)                                :: nloc ! (nloc=klon)  pour l'instant
171  INTEGER, INTENT (IN)                               :: k_upper
172  INTEGER, INTENT (IN)                               :: iflag_con
173  INTEGER, INTENT (IN)                               :: iflag_mix
174  INTEGER, INTENT (IN)                               :: iflag_ice_thermo
175  INTEGER, INTENT (IN)                               :: iflag_clos
176  LOGICAL, INTENT (IN)                               :: ok_conserv_q
177  REAL, INTENT (IN)                                  :: tau_cld_cv
178  REAL, INTENT (IN)                                  :: coefw_cld_cv
179  REAL, INTENT (IN)                                  :: delt
180  REAL, INTENT (IN)                                  :: comp_threshold
181  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1
182  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1
183  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1
184  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake
185  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1_wake
186  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1_wake
187  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
188  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1
189  REAL, DIMENSION (len, nd), INTENT (IN)             :: v1
190  REAL, DIMENSION (len, nd, ntra), INTENT (IN)       :: tra1
191  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
192  REAL, DIMENSION (len, ndp1), INTENT (IN)           :: ph1
193  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1
194  REAL, DIMENSION (len), INTENT (IN)                 :: Alp1
195  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
196  REAL, INTENT (IN)                                  :: sig1feed1 ! pressure at lower bound of feeding layer
197  REAL, INTENT (IN)                                  :: sig2feed1 ! pressure at upper bound of feeding layer
198  REAL, DIMENSION (nd), INTENT (IN)                  :: wght1     ! weight density determining the feeding mixture
199  INTEGER, DIMENSION (len), INTENT (IN)              :: lalim_conv1
200
201! Input/Output
202  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: sig1
203  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: w01
204
205! Output
206  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1
207  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1
208  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fq1
209  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fu1
210  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fv1
211  REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
212  REAL, DIMENSION (len), INTENT (OUT)                :: precip1
213  INTEGER, DIMENSION (len), INTENT (OUT)             :: kbas1
214  INTEGER, DIMENSION (len), INTENT (OUT)             :: ktop1
215  REAL, DIMENSION (len), INTENT (OUT)                :: cbmf1
216  REAL, DIMENSION (len), INTENT (OUT)                :: plcl1
217  REAL, DIMENSION (len), INTENT (OUT)                :: plfc1
218  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
219  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
220  REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
221  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1
222  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mip1
223! real Vprecip1(len,nd)
224  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecip1
225  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecipi1
226  REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1
227  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd1
228  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd01
229  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1         ! cld
230  REAL, DIMENSION (len), INTENT (OUT)                :: wd1             ! gust
231  REAL, DIMENSION (len), INTENT (OUT)                :: cape1
232  REAL, DIMENSION (len), INTENT (OUT)                :: cin1
233  REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1
234
235!AC!
236!!      real da1(len,nd),phi1(len,nd,nd)
237!!      real da(len,nd),phi(len,nd,nd)
238!AC!
239  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1
240  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqd1
241  REAL, DIMENSION (len), INTENT (OUT)                :: Plim11
242  REAL, DIMENSION (len), INTENT (OUT)                :: Plim21
243  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1
244  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01
245  REAL, DIMENSION (len), INTENT (OUT)                :: asupmaxmin1
246  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1            ! cld
247  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1           ! cld
248
249! RomP >>>
250  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainM1
251  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1, mp1
252  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1
253  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1
254  REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplaMm1
255  REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1, ep1
256  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1, elij1
257  REAL, DIMENSION (len, nd), INTENT (OUT)            :: clw1
258!JYG,RL
259  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti1      ! final weight of the feeding layers
260!JYG,RL
261  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21
262  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1, dam1
263! RomP <<<
264  REAL, DIMENSION (len ), INTENT (OUT)               :: epmax_diag1     
265
266! -------------------------------------------------------------------
267! Prolog by Kerry Emanuel.
268! -------------------------------------------------------------------
269! --- ARGUMENTS
270! -------------------------------------------------------------------
271! --- On input:
272
273! t:   Array of absolute temperature (K) of dimension ND, with first
274! index corresponding to lowest model level. Note that this array
275! will be altered by the subroutine if dry convective adjustment
276! occurs and if IPBL is not equal to 0.
277
278! q:   Array of specific humidity (gm/gm) of dimension ND, with first
279! index corresponding to lowest model level. Must be defined
280! at same grid levels as T. Note that this array will be altered
281! if dry convective adjustment occurs and if IPBL is not equal to 0.
282
283! qs:  Array of saturation specific humidity of dimension ND, with first
284! index corresponding to lowest model level. Must be defined
285! at same grid levels as T. Note that this array will be altered
286! if dry convective adjustment occurs and if IPBL is not equal to 0.
287
288! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
289! of dimension ND, with first index corresponding to lowest model level.
290
291! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
292! of dimension ND, with first index corresponding to lowest model level.
293! Must be defined at same grid levels as T.
294
295! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
296! of dimension ND, with first index corresponding to lowest model level.
297! Must be defined at same grid levels as T.
298
299! s_wake: Array of fractionnal area occupied by the wakes.
300
301! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
302! index corresponding with the lowest model level. Defined at
303! same levels as T. Note that this array will be altered if
304! dry convective adjustment occurs and if IPBL is not equal to 0.
305
306! v:   Same as u but for meridional velocity.
307
308! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
309! where NTRA is the number of different tracers. If no
310! convective tracer transport is needed, define a dummy
311! input array of dimension (ND,1). Tracers are defined at
312! same vertical levels as T. Note that this array will be altered
313! if dry convective adjustment occurs and if IPBL is not equal to 0.
314
315! p:   Array of pressure (mb) of dimension ND, with first
316! index corresponding to lowest model level. Must be defined
317! at same grid levels as T.
318
319! ph:  Array of pressure (mb) of dimension ND+1, with first index
320! corresponding to lowest level. These pressures are defined at
321! levels intermediate between those of P, T, Q and QS. The first
322! value of PH should be greater than (i.e. at a lower level than)
323! the first value of the array P.
324
325! ALE:  Available lifting Energy
326
327! ALP:  Available lifting Power
328
329! nl:  The maximum number of levels to which convection can penetrate, plus 1.
330!       NL MUST be less than or equal to ND-1.
331
332! delt: The model time step (sec) between calls to CONVECT
333
334! ----------------------------------------------------------------------------
335! ---   On Output:
336
337! iflag: An output integer whose value denotes the following:
338!       VALUE   INTERPRETATION
339!       -----   --------------
340!         0     Moist convection occurs.
341!         1     Moist convection occurs, but a CFL condition
342!               on the subsidence warming is violated. This
343!               does not cause the scheme to terminate.
344!         2     Moist convection, but no precip because ep(inb) lt 0.0001
345!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
346!         4     No moist convection; atmosphere is not
347!               unstable
348!         6     No moist convection because ihmin le minorig.
349!         7     No moist convection because unreasonable
350!               parcel level temperature or specific humidity.
351!         8     No moist convection: lifted condensation
352!               level is above the 200 mb level.
353!         9     No moist convection: cloud base is higher
354!               then the level NL-1.
355!        10     No moist convection: cloud top is too warm.
356!
357
358! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
359!       grid levels as T, Q, QS and P.
360
361! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
362!       defined at same grid levels as T, Q, QS and P.
363
364! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
365!      defined at same grid levels as T.
366
367! fv:   Same as FU, but for forcing of meridional velocity.
368
369! ftra: Array of forcing of tracer content, in tracer mixing ratio per
370!       second, defined at same levels as T. Dimensioned (ND,NTRA).
371
372! precip: Scalar convective precipitation rate (mm/day).
373
374! wd:   A convective downdraft velocity scale. For use in surface
375!       flux parameterizations. See convect.ps file for details.
376
377! tprime: A convective downdraft temperature perturbation scale (K).
378!         For use in surface flux parameterizations. See convect.ps
379!         file for details.
380
381! qprime: A convective downdraft specific humidity
382!         perturbation scale (gm/gm).
383!         For use in surface flux parameterizations. See convect.ps
384!         file for details.
385
386! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
387!       BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
388!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
389!       by the calling program between calls to CONVECT.
390
391! det:   Array of detrainment mass flux of dimension ND.
392! -------------------------------------------------------------------
393
394! Local (non compressed) arrays
395
396
397  INTEGER i, k, n, il, j
398  INTEGER nword1, nword2, nword3, nword4
399  INTEGER icbmax
400  INTEGER nk1(klon)
401  INTEGER icb1(klon)
402  INTEGER icbs1(klon)
403
404  LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
405  LOGICAL, SAVE :: debut = .TRUE.
406!$OMP THREADPRIVATE(debut)
407
408  REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
409  REAL tnk1(klon)
410  REAL thnk1(klon)
411  REAL qnk1(klon)
412  REAL gznk1(klon)
413  REAL pnk1(klon)
414  REAL qsnk1(klon)
415  REAL unk1(klon)
416  REAL vnk1(klon)
417  REAL cpnk1(klon)
418  REAL hnk1(klon)
419  REAL pbase1(klon)
420  REAL buoybase1(klon)
421
422  REAL lf1(klon, klev), lf1_wake(klon, klev)
423  REAL lv1(klon, klev), lv1_wake(klon, klev)
424  REAL cpn1(klon, klev), cpn1_wake(klon, klev)
425  REAL tv1(klon, klev), tv1_wake(klon, klev)
426  REAL gz1(klon, klev), gz1_wake(klon, klev)
427  REAL hm1(klon, klev), hm1_wake(klon, klev)
428  REAL h1(klon, klev), h1_wake(klon, klev)
429  REAL tp1(klon, klev)
430  REAL th1(klon, klev), th1_wake(klon, klev)
431
432  REAL bid(klon, klev) ! dummy array
433
434  INTEGER ncum
435
436  INTEGER j1feed(klon)
437  INTEGER j2feed(klon)
438  REAL p1feed1(len) ! pressure at lower bound of feeding layer
439  REAL p2feed1(len) ! pressure at upper bound of feeding layer
440!JYG,RL
441!!      real wghti1(len,nd) ! weights of the feeding layers
442!JYG,RL
443
444! (local) compressed fields:
445
446
447  INTEGER idcum(nloc)
448!jyg<
449  LOGICAL compress    ! True if compression occurs
450!>jyg
451  INTEGER iflag(nloc), nk(nloc), icb(nloc)
452  INTEGER nent(nloc, klev)
453  INTEGER icbs(nloc)
454  INTEGER inb(nloc), inbis(nloc)
455
456  REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
457  REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
458  REAL t_wake(nloc, klev), q_wake(nloc, klev), qs_wake(nloc, klev)
459  REAL s_wake(nloc)
460  REAL u(nloc, klev), v(nloc, klev)
461  REAL gz(nloc, klev), h(nloc, klev), hm(nloc, klev)
462  REAL h_wake(nloc, klev), hm_wake(nloc, klev)
463  REAL lv(nloc, klev), lf(nloc, klev), cpn(nloc, klev)
464  REAL lv_wake(nloc, klev), lf_wake(nloc, klev), cpn_wake(nloc, klev)
465  REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
466  REAL tv_wake(nloc, klev)
467  REAL clw(nloc, klev)
468  REAL dph(nloc, klev)
469  REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
470  REAL th_wake(nloc, klev)
471  REAL tvp(nloc, klev)
472  REAL sig(nloc, klev), w0(nloc, klev), ptop2(nloc)
473  REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
474  REAL buoy(nloc, klev)
475  REAL cape(nloc)
476  REAL cin(nloc)
477  REAL m(nloc, klev)
478  REAL ment(nloc, klev, klev), sigij(nloc, klev, klev)
479  REAL qent(nloc, klev, klev)
480  REAL hent(nloc, klev, klev)
481  REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
482  REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
483  REAL elij(nloc, klev, klev)
484  REAL supmax(nloc, klev)
485  REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
486  REAL omega(nloc,klev)
487  REAL sigd(nloc)
488! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
489! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
490! real b(nloc,klev), sigd(nloc)
491! save mp,qp,up,vp,wt,water,evap,b
492  REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
493  REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
494  REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
495  REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
496!$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
497  REAL ft(nloc, klev), fq(nloc, klev)
498  REAL ftd(nloc, klev), fqd(nloc, klev)
499  REAL fu(nloc, klev), fv(nloc, klev)
500  REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
501  REAL ma(nloc, klev), mip(nloc, klev)
502!!  REAL tls(nloc, klev), tps(nloc, klev)                 ! unused . jyg
503  REAL qprime(nloc), tprime(nloc)
504  REAL precip(nloc)
505! real Vprecip(nloc,klev)
506  REAL vprecip(nloc, klev+1)
507  REAL vprecipi(nloc, klev+1)
508  REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
509  REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
510  REAL qcondc(nloc, klev)      ! cld
511  REAL wd(nloc)                ! gust
512  REAL Plim1(nloc), plim2(nloc)
513  REAL asupmax(nloc, klev)
514  REAL supmax0(nloc)
515  REAL asupmaxmin(nloc)
516
517  REAL tnk(nloc), qnk(nloc), gznk(nloc)
518  REAL wghti(nloc, nd)
519  REAL hnk(nloc), unk(nloc), vnk(nloc)
520
521  REAL qtc(nloc, klev)         ! cld
522  REAL sigt(nloc, klev)        ! cld
523 
524! RomP >>>
525  REAL wdtrainA(nloc, klev), wdtrainM(nloc, klev)
526  REAL da(len, nd), phi(len, nd, nd)
527  REAL epmlmMm(nloc, klev, klev), eplaMm(nloc, klev)
528  REAL phi2(len, nd, nd)
529  REAL d1a(len, nd), dam(len, nd)
530! RomP <<<
531  REAL epmax_diag(nloc) ! epmax_cape
532
533  LOGICAL, SAVE :: first = .TRUE.
534!$OMP THREADPRIVATE(first)
535  CHARACTER (LEN=20) :: modname = 'cva_driver'
536  CHARACTER (LEN=80) :: abort_message
537
538  INTEGER,SAVE                                       :: igout=1
539!$OMP THREADPRIVATE(igout)
540
541
542! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
543! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
544
545! -------------------------------------------------------------------
546! --- SET CONSTANTS AND PARAMETERS
547! -------------------------------------------------------------------
548
549  IF (first) THEN
550    ALLOCATE (mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
551    ALLOCATE (vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
552    ALLOCATE (ice(nloc,klev), fondue(nloc,klev))
553    ALLOCATE (evap(nloc,klev), b(nloc,klev))
554    ALLOCATE (frac(nloc,klev), faci(nloc,klev))
555    first = .FALSE.
556  END IF
557! -- set simulation flags:
558! (common cvflag)
559
560  CALL cv_flag(iflag_ice_thermo)
561
562! -- set thermodynamical constants:
563! (common cvthermo)
564
565  CALL cv_thermo(iflag_con)
566
567! -- set convect parameters
568
569! includes microphysical parameters and parameters that
570! control the rate of approach to quasi-equilibrium)
571! (common cvparam)
572
573  IF (iflag_con==3) THEN
574    CALL cv3_param(nd, k_upper, delt)
575
576  END IF
577
578  IF (iflag_con==4) THEN
579    CALL cv_param(nd)
580  END IF
581
582! ---------------------------------------------------------------------
583! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
584! ---------------------------------------------------------------------
585  nword1 = len
586  nword2 = len*nd
587  nword3 = len*nd*ntra
588  nword4 = len*nd*nd
589
590  iflag1(:) = 0
591  ktop1(:) = 0
592  kbas1(:) = 0
593  ft1(:, :) = 0.0
594  fq1(:, :) = 0.0
595  fu1(:, :) = 0.0
596  fv1(:, :) = 0.0
597  ftra1(:, :, :) = 0.
598  precip1(:) = 0.
599  cbmf1(:) = 0.
600  plcl1(:) = 0.
601  plfc1(:) = 0.
602  wbeff1(:) = 0.
603  ptop21(:) = 0.
604  sigd1(:) = 0.
605  ma1(:, :) = 0.
606  mip1(:, :) = 0.
607  vprecip1(:, :) = 0.
608  vprecipi1(:, :) = 0.
609  upwd1(:, :) = 0.
610  dnwd1(:, :) = 0.
611  dnwd01(:, :) = 0.
612  qcondc1(:, :) = 0.
613  wd1(:) = 0.
614  cape1(:) = 0.
615  cin1(:) = 0.
616  tvp1(:, :) = 0.
617  ftd1(:, :) = 0.
618  fqd1(:, :) = 0.
619  Plim11(:) = 0.
620  Plim21(:) = 0.
621  asupmax1(:, :) = 0.
622  supmax01(:) = 0.
623  asupmaxmin1(:) = 0.
624
625  DO il = 1, len
626    cin1(il) = -100000.
627    cape1(il) = -1.
628  END DO
629
630!!  IF (iflag_con==3) THEN
631!!    DO il = 1, len
632!!      sig1(il, nd) = sig1(il, nd) + 1.
633!!      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
634!!    END DO
635!!  END IF
636
637  IF (iflag_con==3) THEN
638      CALL cv3_incrcount(len,nd,delt,sig1)
639  END IF  ! (iflag_con==3)
640
641! RomP >>>
642  sigt1(:, :) = 0.
643  qtc1(:, :) = 0.
644  wdtrainA1(:, :) = 0.
645  wdtrainM1(:, :) = 0.
646  da1(:, :) = 0.
647  phi1(:, :, :) = 0.
648  epmlmMm1(:, :, :) = 0.
649  eplaMm1(:, :) = 0.
650  mp1(:, :) = 0.
651  evap1(:, :) = 0.
652  ep1(:, :) = 0.
653  sigij1(:, :, :) = 0.
654  elij1(:, :, :) = 0.
655  clw1(:,:) = 0.
656  wghti1(:,:) = 0.
657  phi21(:, :, :) = 0.
658  d1a1(:, :) = 0.
659  dam1(:, :) = 0.
660! RomP <<<
661! ---------------------------------------------------------------------
662! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
663! ---------------------------------------------------------------------
664
665  DO il = 1, nloc
666    coef_clos(il) = 1.
667  END DO
668
669! --------------------------------------------------------------------
670! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
671! --------------------------------------------------------------------
672
673  IF (iflag_con==3) THEN
674
675    IF (debut) THEN
676      PRINT *, 'Emanuel version 3 nouvelle'
677    END IF
678! print*,'t1, q1 ',t1,q1
679        if (prt_level >= 9) &
680             PRINT *, 'cva_driver -> cv3_prelim'
681    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
682                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
683
684
685        if (prt_level >= 9) &
686             PRINT *, 'cva_driver -> cv3_prelim'
687    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
688                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
689                    h1_wake, bid, th1_wake)
690
691  END IF
692
693  IF (iflag_con==4) THEN
694    PRINT *, 'Emanuel version 4 '
695        if (prt_level >= 9) &
696             PRINT *, 'cva_driver -> cv_prelim'
697    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
698                   lv1, cpn1, tv1, gz1, h1, hm1)
699  END IF
700
701! --------------------------------------------------------------------
702! --- CONVECTIVE FEED
703! --------------------------------------------------------------------
704
705! compute feeding layer potential temperature and mixing ratio :
706
707! get bounds of feeding layer
708
709! test niveaux couche alimentation KE
710  IF (sig1feed1==sig2feed1) THEN
711    WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
712    WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
713    abort_message = ''
714    CALL abort_physic(modname, abort_message, 1)
715  END IF
716
717  DO i = 1, len
718    p1feed1(i) = sig1feed1*ph1(i, 1)
719    p2feed1(i) = sig2feed1*ph1(i, 1)
720!test maf
721!   p1feed1(i)=ph1(i,1)
722!   p2feed1(i)=ph1(i,2)
723!   p2feed1(i)=ph1(i,3)
724!testCR: on prend la couche alim des thermiques
725!   p2feed1(i)=ph1(i,lalim_conv1(i)+1)
726!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
727  END DO
728
729  IF (iflag_con==3) THEN
730  END IF
731  DO i = 1, len
732! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
733  END DO
734  IF (iflag_con==3) THEN
735
736! print*, 'IFLAG1 avant cv3_feed'
737! print*,'len,nd',len,nd
738! write(*,'(64i1)') iflag1(2:klon-1)
739
740        if (prt_level >= 9) &
741             PRINT *, 'cva_driver -> cv3_feed'
742    CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
743                  t1, q1, u1, v1, p1, ph1, hm1, gz1, &
744                  p1feed1, p2feed1, wght1, &
745                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
746                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
747  END IF
748
749! print*, 'IFLAG1 apres cv3_feed'
750! print*,'len,nd',len,nd
751! write(*,'(64i1)') iflag1(2:klon-1)
752
753  IF (iflag_con==4) THEN
754        if (prt_level >= 9) &
755             PRINT *, 'cva_driver -> cv_feed'
756    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
757                 nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
758  END IF
759
760! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
761
762! --------------------------------------------------------------------
763! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
764! (up through ICB for convect4, up through ICB+1 for convect3)
765! Calculates the lifted parcel virtual temperature at nk, the
766! actual temperature, and the adiabatic liquid water content.
767! --------------------------------------------------------------------
768
769  IF (iflag_con==3) THEN
770
771        if (prt_level >= 9) &
772             PRINT *, 'cva_driver -> cv3_undilute1'
773    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
774                       gznk1, tp1, tvp1, clw1, icbs1)
775  END IF
776
777
778  IF (iflag_con==4) THEN
779        if (prt_level >= 9) &
780             PRINT *, 'cva_driver -> cv_undilute1'
781    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
782                      tp1, tvp1, clw1)
783  END IF
784
785! -------------------------------------------------------------------
786! --- TRIGGERING
787! -------------------------------------------------------------------
788
789! print *,' avant triggering, iflag_con ',iflag_con
790
791  IF (iflag_con==3) THEN
792
793        if (prt_level >= 9) &
794             PRINT *, 'cva_driver -> cv3_trigger'
795    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
796                      pbase1, buoybase1, iflag1, sig1, w01)
797
798
799! print*, 'IFLAG1 apres cv3_triger'
800! print*,'len,nd',len,nd
801! write(*,'(64i1)') iflag1(2:klon-1)
802
803! call dump2d(iim,jjm-1,sig1(2)
804  END IF
805
806  IF (iflag_con==4) THEN
807        if (prt_level >= 9) &
808             PRINT *, 'cva_driver -> cv_trigger'
809    CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
810  END IF
811
812
813! =====================================================================
814! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
815! =====================================================================
816
817!  Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
818!  gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
819!  elsewhere).
820  ncum = 0
821  coef_convective(:) = 0.
822  DO i = 1, len
823    IF (iflag1(i)==0) THEN
824      coef_convective(i) = 1.
825      ncum = ncum + 1
826      idcum(ncum) = i
827    END IF
828  END DO
829
830! print*,'klon, ncum = ',len,ncum
831
832  IF (ncum>0) THEN
833
834! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
835! --- COMPRESS THE FIELDS
836!       (-> vectorization over convective gridpoints)
837! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
838
839    IF (iflag_con==3) THEN
840! print*,'ncum tv1 ',ncum,tv1
841! print*,'tvp1 ',tvp1
842!jyg<
843!   If the fraction of convective points is larger than comp_threshold, then compression
844!   is assumed useless.
845!
846  compress = ncum .lt. len*comp_threshold
847!
848  IF (.not. compress) THEN
849    DO i = 1,len
850      idcum(i) = i
851    ENDDO
852  ENDIF
853!
854!>jyg
855        if (prt_level >= 9) &
856             PRINT *, 'cva_driver -> cv3a_compress'
857      CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
858                         iflag1, nk1, icb1, icbs1, &
859                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
860                         wghti1, pbase1, buoybase1, &
861                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
862                         u1, v1, gz1, th1, th1_wake, &
863                         tra1, &
864                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
865                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
866                         sig1, w01, ptop21, &
867                         Ale1, Alp1, omega1, &
868                         iflag, nk, icb, icbs, &
869                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
870                         wghti, pbase, buoybase, &
871                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
872                         u, v, gz, th, th_wake, &
873                         tra, &
874                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
875                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
876                         sig, w0, ptop2, &
877                         Ale, Alp, omega)
878
879! print*,'tv ',tv
880! print*,'tvp ',tvp
881
882    END IF
883
884    IF (iflag_con==4) THEN
885        if (prt_level >= 9) &
886             PRINT *, 'cva_driver -> cv_compress'
887      CALL cv_compress(len, nloc, ncum, nd, &
888                       iflag1, nk1, icb1, &
889                       cbmf1, plcl1, tnk1, qnk1, gznk1, &
890                       t1, q1, qs1, u1, v1, gz1, &
891                       h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
892                       iflag, nk, icb, &
893                       cbmf, plcl, tnk, qnk, gznk, &
894                       t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
895                       dph)
896    END IF
897
898! -------------------------------------------------------------------
899! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
900! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
901! ---   &
902! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
903! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
904! ---   &
905! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
906! -------------------------------------------------------------------
907
908    IF (iflag_con==3) THEN
909        if (prt_level >= 9) &
910             PRINT *, 'cva_driver -> cv3_undilute2'
911      CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &        !na->nd
912                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
913                         p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
914                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
915                         frac)
916    END IF
917
918    IF (iflag_con==4) THEN
919        if (prt_level >= 9) &
920             PRINT *, 'cva_driver -> cv_undilute2'
921      CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
922                        tnk, qnk, gznk, t, q, qs, gz, &
923                        p, dph, h, tv, lv, &
924                        inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
925    END IF
926
927    ! epmax_cape
928    ! on recalcule ep et hp   
929        if (prt_level >= 9) &
930             PRINT *, 'cva_driver -> cv3_epmax_cape'
931    call cv3_epmax_fn_cape(nloc,ncum,nd &
932                , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac &
933                , pbase, p, ph, tv, buoy, sig, w0,iflag &
934                , epmax_diag)
935
936! -------------------------------------------------------------------
937! --- MIXING(1)   (if iflag_mix .ge. 1)
938! -------------------------------------------------------------------
939    IF (iflag_con==3) THEN
940!      IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
941!        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
942!          '. Might as well stop here.'
943!        STOP
944!      END IF
945      IF (iflag_mix>=1) THEN
946        CALL zilch(supmax, nloc*klev)
947        if (prt_level >= 9) &
948             PRINT *, 'cva_driver -> cv3p_mixing'
949        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
950                         ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
951                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
952                         ment, qent, hent, uent, vent, nent, &
953                         sigij, elij, supmax, ments, qents, traent)
954! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
955
956      ELSE
957        CALL zilch(supmax, nloc*klev)
958      END IF
959    END IF
960! -------------------------------------------------------------------
961! --- CLOSURE
962! -------------------------------------------------------------------
963
964
965    IF (iflag_con==3) THEN
966      IF (iflag_clos==0) THEN
967        if (prt_level >= 9) &
968             PRINT *, 'cva_driver -> cv3_closure'
969        CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
970                         pbase, p, ph, tv, buoy, &
971                         sig, w0, cape, m, iflag)
972      END IF   ! iflag_clos==0
973
974      ok_inhib = iflag_mix == 2
975
976      IF (iflag_clos==1) THEN
977        PRINT *, ' pas d appel cv3p_closure'
978! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              ! na->nd
979! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
980! c    :                       ,supmax
981! c    o                       ,sig,w0,ptop2,cape,cin,m)
982      END IF   ! iflag_clos==1
983
984      IF (iflag_clos==2) THEN
985        if (prt_level >= 9) &
986             PRINT *, 'cva_driver -> cv3p1_closure'
987        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
988                           pbase, plcl, p, ph, tv, tvp, buoy, &
989                           supmax, ok_inhib, Ale, Alp, omega, &
990                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
991                           Plim1, plim2, asupmax, supmax0, &
992                           asupmaxmin, cbmf, plfc, wbeff)
993        if (prt_level >= 10) &
994             PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
995      END IF   ! iflag_clos==2
996
997      IF (iflag_clos==3) THEN
998        if (prt_level >= 9) &
999             PRINT *, 'cva_driver -> cv3p2_closure'
1000        CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
1001                           pbase, plcl, p, ph, tv, tvp, buoy, &
1002                           supmax, ok_inhib, Ale, Alp, omega, &
1003                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1004                           Plim1, plim2, asupmax, supmax0, &
1005                           asupmaxmin, cbmf, plfc, wbeff)
1006        if (prt_level >= 10) &
1007             PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1008      END IF   ! iflag_clos==3
1009    END IF ! iflag_con==3
1010
1011    IF (iflag_con==4) THEN
1012        if (prt_level >= 9) &
1013             PRINT *, 'cva_driver -> cv_closure'
1014      CALL cv_closure(nloc, ncum, nd, nk, icb, &
1015                         tv, tvp, p, ph, dph, plcl, cpn, &
1016                         iflag, cbmf)
1017    END IF
1018
1019! print *,'cv_closure-> cape ',cape(1)
1020
1021! -------------------------------------------------------------------
1022! --- MIXING(2)
1023! -------------------------------------------------------------------
1024
1025    IF (iflag_con==3) THEN
1026      IF (iflag_mix==0) THEN
1027        if (prt_level >= 9) &
1028             PRINT *, 'cva_driver -> cv3_mixing'
1029        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
1030                        ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
1031                        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
1032                        ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
1033        CALL zilch(hent, nloc*klev*klev)
1034      ELSE
1035        CALL cv3_mixscale(nloc, ncum, nd, ment, m)
1036        IF (debut) THEN
1037          PRINT *, ' cv3_mixscale-> '
1038        END IF !(debut) THEN
1039      END IF
1040    END IF
1041
1042    IF (iflag_con==4) THEN
1043        if (prt_level >= 9) &
1044             PRINT *, 'cva_driver -> cv_mixing'
1045      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
1046                     ph, t, q, qs, u, v, h, lv, qnk, &
1047                     hp, tv, tvp, ep, clw, cbmf, &
1048                     m, ment, qent, uent, vent, nent, sigij, elij)
1049    END IF                                                                                         
1050
1051    IF (debut) THEN
1052      PRINT *, ' cv_mixing ->'
1053    END IF !(debut) THEN
1054! do i = 1,nd
1055! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
1056! enddo
1057
1058! -------------------------------------------------------------------
1059! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1060! -------------------------------------------------------------------
1061    IF (iflag_con==3) THEN
1062      IF (debut) THEN
1063        PRINT *, ' cva_driver -> cv3_unsat '
1064      END IF !(debut) THEN
1065
1066        if (prt_level >= 9) &
1067             PRINT *, 'cva_driver -> cv3_unsat'
1068      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
1069                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
1070                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
1071                     ep, sigp, clw, &
1072                     m, ment, elij, delt, plcl, coef_clos, &
1073                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
1074                     faci, b, sigd, &
1075                     wdtrainA, wdtrainM)                                       ! RomP
1076!
1077      IF (prt_level >= 10) THEN
1078        Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
1079        DO k = 1,nd
1080        write (6, '(i4,5(1x,e13.6))'), &
1081          k, mp(igout,k), water(igout,k), ice(igout,k), &
1082           evap(igout,k), fondue(igout,k)
1083        ENDDO
1084        Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainM '
1085        DO k = 1,nd
1086        write (6, '(i4,2(1x,e13.6))'), &
1087           k, wdtrainA(igout,k), wdtrainM(igout,k)
1088        ENDDO
1089      ENDIF
1090!
1091    END IF  !(iflag_con==3)
1092
1093    IF (iflag_con==4) THEN
1094        if (prt_level >= 9) &
1095             PRINT *, 'cva_driver -> cv_unsat'
1096      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1097                     h, lv, ep, sigp, clw, m, ment, elij, &
1098                     iflag, mp, qp, up, vp, wt, water, evap)
1099    END IF
1100
1101    IF (debut) THEN
1102      PRINT *, 'cv_unsat-> '
1103    END IF !(debut) THEN
1104
1105! print *,'cv_unsat-> mp ',mp
1106! print *,'cv_unsat-> water ',water
1107! -------------------------------------------------------------------
1108! --- YIELD
1109! (tendencies, precipitation, variables of interface with other
1110! processes, etc)
1111! -------------------------------------------------------------------
1112
1113    IF (iflag_con==3) THEN
1114
1115        if (prt_level >= 9) &
1116             PRINT *, 'cva_driver -> cv3_yield'
1117      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
1118                     icb, inb, delt, &
1119                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
1120                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1121                     ep, clw, m, tp, mp, qp, up, vp, trap, &
1122                     wt, water, ice, evap, fondue, faci, b, sigd, &
1123                     ment, qent, hent, iflag_mix, uent, vent, &
1124                     nent, elij, traent, sig, &
1125                     tv, tvp, wghti, &
1126                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &      ! jyg
1127                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
1128!!                     tls, tps, &                            ! useless . jyg
1129                     qcondc, wd, &
1130                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1131!
1132      IF (debut) THEN
1133        PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
1134      END IF !(debut) THEN
1135!   
1136      IF (prt_level >= 10) THEN
1137        Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
1138                    ft(igout,1), ftd(igout,1)
1139        Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
1140                    fq(igout,1), fqd(igout,1)
1141      ENDIF
1142!   
1143    END IF
1144
1145    IF (iflag_con==4) THEN
1146        if (prt_level >= 9) &
1147             PRINT *, 'cva_driver -> cv_yield'
1148      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1149                     t, q, u, v, &
1150                     gz, p, ph, h, hp, lv, cpn, &
1151                     ep, clw, frac, m, mp, qp, up, vp, &
1152                     wt, water, evap, &
1153                     ment, qent, uent, vent, nent, elij, &
1154                     tv, tvp, &
1155                     iflag, wd, qprime, tprime, &
1156                     precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1157    END IF
1158
1159!AC!
1160!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1161!--- passive tracers
1162!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1163
1164    IF (iflag_con==3) THEN
1165!RomP >>>
1166        if (prt_level >= 9) &
1167             PRINT *, 'cva_driver -> cv3_tracer'
1168      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1169                     ment, sigij, da, phi, phi2, d1a, dam, &
1170                     ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1171                     icb, inb)
1172!RomP <<<
1173    END IF
1174
1175!AC!
1176
1177! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1178! --- UNCOMPRESS THE FIELDS
1179! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1180
1181
1182    IF (iflag_con==3) THEN
1183        if (prt_level >= 9) &
1184             PRINT *, 'cva_driver -> cv3a_uncompress'
1185      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1186                           iflag, icb, inb, &
1187                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1188                           ft, fq, fu, fv, ftra, &
1189                           sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1190                           qcondc, wd, cape, cin, &
1191                           tvp, &
1192                           ftd, fqd, &
1193                           Plim1, plim2, asupmax, supmax0, &
1194                           asupmaxmin, &
1195                           da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
1196                           clw, elij, evap, ep, epmlmMm, eplaMm, &       ! RomP
1197                           wdtrainA, wdtrainM, &                         ! RomP
1198                           qtc, sigt, epmax_diag, & ! epmax_cape
1199                           iflag1, kbas1, ktop1, &
1200                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1201                           ft1, fq1, fu1, fv1, ftra1, &
1202                           sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1203                           qcondc1, wd1, cape1, cin1, &
1204                           tvp1, &
1205                           ftd1, fqd1, &
1206                           Plim11, plim21, asupmax1, supmax01, &
1207                           asupmaxmin1, &
1208                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  & ! RomP
1209                           clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1210                           wdtrainA1, wdtrainM1,                       & ! RomP
1211                           qtc1, sigt1, epmax_diag1) ! epmax_cape
1212    END IF
1213
1214    IF (iflag_con==4) THEN
1215        if (prt_level >= 9) &
1216             PRINT *, 'cva_driver -> cv_uncompress'
1217      CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1218                           iflag, &
1219                           precip, cbmf, &
1220                           ft, fq, fu, fv, &
1221                           ma, qcondc, &
1222                           iflag1, &
1223                           precip1,cbmf1, &
1224                           ft1, fq1, fu1, fv1, &
1225                           ma1, qcondc1)
1226    END IF
1227
1228  END IF ! ncum>0
1229
1230!
1231! In order take into account the possibility of changing the compression,
1232! reset m, sig and w0 to zero for non-convective points.
1233  DO k = 1,nd-1
1234        sig1(:, k) = sig1(:, k)*coef_convective(:)
1235        w01(:, k)  = w01(:, k)*coef_convective(:)
1236  ENDDO
1237
1238  IF (debut) THEN
1239    PRINT *, ' cv_uncompress -> '
1240    debut = .FALSE.
1241  END IF  !(debut) THEN
1242
1243
1244  RETURN
1245END SUBROUTINE cva_driver
Note: See TracBrowser for help on using the repository browser.