source: LMDZ5/trunk/libf/phylmd/cva_driver.F90 @ 2639

Last change on this file since 2639 was 2638, checked in by jyg, 8 years ago

Some improvements to commit 2635 concerning wake
variables in physiq_mod.F90.

  • 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 2638 2016-09-29 11:18:14Z jyg $
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
356! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
357!       grid levels as T, Q, QS and P.
358
359! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
360!       defined at same grid levels as T, Q, QS and P.
361
362! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
363!      defined at same grid levels as T.
364
365! fv:   Same as FU, but for forcing of meridional velocity.
366
367! ftra: Array of forcing of tracer content, in tracer mixing ratio per
368!       second, defined at same levels as T. Dimensioned (ND,NTRA).
369
370! precip: Scalar convective precipitation rate (mm/day).
371
372! wd:   A convective downdraft velocity scale. For use in surface
373!       flux parameterizations. See convect.ps file for details.
374
375! tprime: A convective downdraft temperature perturbation scale (K).
376!         For use in surface flux parameterizations. See convect.ps
377!         file for details.
378
379! qprime: A convective downdraft specific humidity
380!         perturbation scale (gm/gm).
381!         For use in surface flux parameterizations. See convect.ps
382!         file for details.
383
384! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
385!       BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
386!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
387!       by the calling program between calls to CONVECT.
388
389! det:   Array of detrainment mass flux of dimension ND.
390! -------------------------------------------------------------------
391
392! Local (non compressed) arrays
393
394
395  INTEGER i, k, n, il, j
396  INTEGER nword1, nword2, nword3, nword4
397  INTEGER icbmax
398  INTEGER nk1(klon)
399  INTEGER icb1(klon)
400  INTEGER icbs1(klon)
401
402  LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
403  LOGICAL, SAVE :: debut = .TRUE.
404!$OMP THREADPRIVATE(debut)
405
406  REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
407  REAL tnk1(klon)
408  REAL thnk1(klon)
409  REAL qnk1(klon)
410  REAL gznk1(klon)
411  REAL pnk1(klon)
412  REAL qsnk1(klon)
413  REAL unk1(klon)
414  REAL vnk1(klon)
415  REAL cpnk1(klon)
416  REAL hnk1(klon)
417  REAL pbase1(klon)
418  REAL buoybase1(klon)
419
420  REAL lf1(klon, klev), lf1_wake(klon, klev)
421  REAL lv1(klon, klev), lv1_wake(klon, klev)
422  REAL cpn1(klon, klev), cpn1_wake(klon, klev)
423  REAL tv1(klon, klev), tv1_wake(klon, klev)
424  REAL gz1(klon, klev), gz1_wake(klon, klev)
425  REAL hm1(klon, klev), hm1_wake(klon, klev)
426  REAL h1(klon, klev), h1_wake(klon, klev)
427  REAL tp1(klon, klev)
428  REAL th1(klon, klev), th1_wake(klon, klev)
429
430  REAL bid(klon, klev) ! dummy array
431
432  INTEGER ncum
433
434  INTEGER j1feed(klon)
435  INTEGER j2feed(klon)
436  REAL p1feed1(len) ! pressure at lower bound of feeding layer
437  REAL p2feed1(len) ! pressure at upper bound of feeding layer
438!JYG,RL
439!!      real wghti1(len,nd) ! weights of the feeding layers
440!JYG,RL
441
442! (local) compressed fields:
443
444
445  INTEGER idcum(nloc)
446!jyg<
447  LOGICAL compress    ! True if compression occurs
448!>jyg
449  INTEGER iflag(nloc), nk(nloc), icb(nloc)
450  INTEGER nent(nloc, klev)
451  INTEGER icbs(nloc)
452  INTEGER inb(nloc), inbis(nloc)
453
454  REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
455  REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
456  REAL t_wake(nloc, klev), q_wake(nloc, klev), qs_wake(nloc, klev)
457  REAL s_wake(nloc)
458  REAL u(nloc, klev), v(nloc, klev)
459  REAL gz(nloc, klev), h(nloc, klev), hm(nloc, klev)
460  REAL h_wake(nloc, klev), hm_wake(nloc, klev)
461  REAL lv(nloc, klev), lf(nloc, klev), cpn(nloc, klev)
462  REAL lv_wake(nloc, klev), lf_wake(nloc, klev), cpn_wake(nloc, klev)
463  REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
464  REAL tv_wake(nloc, klev)
465  REAL clw(nloc, klev)
466  REAL dph(nloc, klev)
467  REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
468  REAL th_wake(nloc, klev)
469  REAL tvp(nloc, klev)
470  REAL sig(nloc, klev), w0(nloc, klev), ptop2(nloc)
471  REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
472  REAL buoy(nloc, klev)
473  REAL cape(nloc)
474  REAL cin(nloc)
475  REAL m(nloc, klev)
476  REAL ment(nloc, klev, klev), sigij(nloc, klev, klev)
477  REAL qent(nloc, klev, klev)
478  REAL hent(nloc, klev, klev)
479  REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
480  REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
481  REAL elij(nloc, klev, klev)
482  REAL supmax(nloc, klev)
483  REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
484  REAL omega(nloc,klev)
485  REAL sigd(nloc)
486! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
487! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
488! real b(nloc,klev), sigd(nloc)
489! save mp,qp,up,vp,wt,water,evap,b
490  REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
491  REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
492  REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
493  REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
494!$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
495  REAL ft(nloc, klev), fq(nloc, klev)
496  REAL ftd(nloc, klev), fqd(nloc, klev)
497  REAL fu(nloc, klev), fv(nloc, klev)
498  REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
499  REAL ma(nloc, klev), mip(nloc, klev)
500!!  REAL tls(nloc, klev), tps(nloc, klev)                 ! unused . jyg
501  REAL qprime(nloc), tprime(nloc)
502  REAL precip(nloc)
503! real Vprecip(nloc,klev)
504  REAL vprecip(nloc, klev+1)
505  REAL vprecipi(nloc, klev+1)
506  REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
507  REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
508  REAL qcondc(nloc, klev)      ! cld
509  REAL wd(nloc)                ! gust
510  REAL Plim1(nloc), plim2(nloc)
511  REAL asupmax(nloc, klev)
512  REAL supmax0(nloc)
513  REAL asupmaxmin(nloc)
514
515  REAL tnk(nloc), qnk(nloc), gznk(nloc)
516  REAL wghti(nloc, nd)
517  REAL hnk(nloc), unk(nloc), vnk(nloc)
518
519  REAL qtc(nloc, klev)         ! cld
520  REAL sigt(nloc, klev)        ! cld
521 
522! RomP >>>
523  REAL wdtrainA(nloc, klev), wdtrainM(nloc, klev)
524  REAL da(len, nd), phi(len, nd, nd)
525  REAL epmlmMm(nloc, klev, klev), eplaMm(nloc, klev)
526  REAL phi2(len, nd, nd)
527  REAL d1a(len, nd), dam(len, nd)
528! RomP <<<
529  REAL epmax_diag(nloc) ! epmax_cape
530
531  LOGICAL, SAVE :: first = .TRUE.
532!$OMP THREADPRIVATE(first)
533  CHARACTER (LEN=20) :: modname = 'cva_driver'
534  CHARACTER (LEN=80) :: abort_message
535
536  INTEGER,SAVE                                       :: igout=1
537!$OMP THREADPRIVATE(igout)
538
539
540! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
541! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
542
543! -------------------------------------------------------------------
544! --- SET CONSTANTS AND PARAMETERS
545! -------------------------------------------------------------------
546
547  IF (first) THEN
548    ALLOCATE (mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
549    ALLOCATE (vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
550    ALLOCATE (ice(nloc,klev), fondue(nloc,klev))
551    ALLOCATE (evap(nloc,klev), b(nloc,klev))
552    ALLOCATE (frac(nloc,klev), faci(nloc,klev))
553    first = .FALSE.
554  END IF
555! -- set simulation flags:
556! (common cvflag)
557
558  CALL cv_flag(iflag_ice_thermo)
559
560! -- set thermodynamical constants:
561! (common cvthermo)
562
563  CALL cv_thermo(iflag_con)
564
565! -- set convect parameters
566
567! includes microphysical parameters and parameters that
568! control the rate of approach to quasi-equilibrium)
569! (common cvparam)
570
571  IF (iflag_con==3) THEN
572    CALL cv3_param(nd, k_upper, delt)
573
574  END IF
575
576  IF (iflag_con==4) THEN
577    CALL cv_param(nd)
578  END IF
579
580! ---------------------------------------------------------------------
581! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
582! ---------------------------------------------------------------------
583  nword1 = len
584  nword2 = len*nd
585  nword3 = len*nd*ntra
586  nword4 = len*nd*nd
587
588  iflag1(:) = 0
589  ktop1(:) = 0
590  kbas1(:) = 0
591  ft1(:, :) = 0.0
592  fq1(:, :) = 0.0
593  fu1(:, :) = 0.0
594  fv1(:, :) = 0.0
595  ftra1(:, :, :) = 0.
596  precip1(:) = 0.
597  cbmf1(:) = 0.
598  plcl1(:) = 0.
599  plfc1(:) = 0.
600  wbeff1(:) = 0.
601  ptop21(:) = 0.
602  sigd1(:) = 0.
603  ma1(:, :) = 0.
604  mip1(:, :) = 0.
605  vprecip1(:, :) = 0.
606  vprecipi1(:, :) = 0.
607  upwd1(:, :) = 0.
608  dnwd1(:, :) = 0.
609  dnwd01(:, :) = 0.
610  qcondc1(:, :) = 0.
611  wd1(:) = 0.
612  cape1(:) = 0.
613  cin1(:) = 0.
614  tvp1(:, :) = 0.
615  ftd1(:, :) = 0.
616  fqd1(:, :) = 0.
617  Plim11(:) = 0.
618  Plim21(:) = 0.
619  asupmax1(:, :) = 0.
620  supmax01(:) = 0.
621  asupmaxmin1(:) = 0.
622
623  DO il = 1, len
624    cin1(il) = -100000.
625    cape1(il) = -1.
626  END DO
627
628!!  IF (iflag_con==3) THEN
629!!    DO il = 1, len
630!!      sig1(il, nd) = sig1(il, nd) + 1.
631!!      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
632!!    END DO
633!!  END IF
634
635  IF (iflag_con==3) THEN
636      CALL cv3_incrcount(len,nd,delt,sig1)
637  END IF  ! (iflag_con==3)
638
639! RomP >>>
640  sigt1(:, :) = 0.
641  qtc1(:, :) = 0.
642  wdtrainA1(:, :) = 0.
643  wdtrainM1(:, :) = 0.
644  da1(:, :) = 0.
645  phi1(:, :, :) = 0.
646  epmlmMm1(:, :, :) = 0.
647  eplaMm1(:, :) = 0.
648  mp1(:, :) = 0.
649  evap1(:, :) = 0.
650  ep1(:, :) = 0.
651  sigij1(:, :, :) = 0.
652  elij1(:, :, :) = 0.
653  clw1(:,:) = 0.
654  wghti1(:,:) = 0.
655  phi21(:, :, :) = 0.
656  d1a1(:, :) = 0.
657  dam1(:, :) = 0.
658! RomP <<<
659! ---------------------------------------------------------------------
660! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
661! ---------------------------------------------------------------------
662
663  DO il = 1, nloc
664    coef_clos(il) = 1.
665  END DO
666
667! --------------------------------------------------------------------
668! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
669! --------------------------------------------------------------------
670
671  IF (iflag_con==3) THEN
672
673    IF (debut) THEN
674      PRINT *, 'Emanuel version 3 nouvelle'
675    END IF
676! print*,'t1, q1 ',t1,q1
677        if (prt_level >= 9) &
678             PRINT *, 'cva_driver -> cv3_prelim'
679    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
680                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
681
682
683        if (prt_level >= 9) &
684             PRINT *, 'cva_driver -> cv3_prelim'
685    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
686                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
687                    h1_wake, bid, th1_wake)
688
689  END IF
690
691  IF (iflag_con==4) THEN
692    PRINT *, 'Emanuel version 4 '
693        if (prt_level >= 9) &
694             PRINT *, 'cva_driver -> cv_prelim'
695    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
696                   lv1, cpn1, tv1, gz1, h1, hm1)
697  END IF
698
699! --------------------------------------------------------------------
700! --- CONVECTIVE FEED
701! --------------------------------------------------------------------
702
703! compute feeding layer potential temperature and mixing ratio :
704
705! get bounds of feeding layer
706
707! test niveaux couche alimentation KE
708  IF (sig1feed1==sig2feed1) THEN
709    WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
710    WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
711    abort_message = ''
712    CALL abort_physic(modname, abort_message, 1)
713  END IF
714
715  DO i = 1, len
716    p1feed1(i) = sig1feed1*ph1(i, 1)
717    p2feed1(i) = sig2feed1*ph1(i, 1)
718!test maf
719!   p1feed1(i)=ph1(i,1)
720!   p2feed1(i)=ph1(i,2)
721!   p2feed1(i)=ph1(i,3)
722!testCR: on prend la couche alim des thermiques
723!   p2feed1(i)=ph1(i,lalim_conv1(i)+1)
724!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
725  END DO
726
727  IF (iflag_con==3) THEN
728  END IF
729  DO i = 1, len
730! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
731  END DO
732  IF (iflag_con==3) THEN
733
734! print*, 'IFLAG1 avant cv3_feed'
735! print*,'len,nd',len,nd
736! write(*,'(64i1)') iflag1(2:klon-1)
737
738        if (prt_level >= 9) &
739             PRINT *, 'cva_driver -> cv3_feed'
740    CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
741                  t1, q1, u1, v1, p1, ph1, hm1, gz1, &
742                  p1feed1, p2feed1, wght1, &
743                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
744                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
745  END IF
746
747! print*, 'IFLAG1 apres cv3_feed'
748! print*,'len,nd',len,nd
749! write(*,'(64i1)') iflag1(2:klon-1)
750
751  IF (iflag_con==4) THEN
752        if (prt_level >= 9) &
753             PRINT *, 'cva_driver -> cv_feed'
754    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
755                 nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
756  END IF
757
758! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
759
760! --------------------------------------------------------------------
761! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
762! (up through ICB for convect4, up through ICB+1 for convect3)
763! Calculates the lifted parcel virtual temperature at nk, the
764! actual temperature, and the adiabatic liquid water content.
765! --------------------------------------------------------------------
766
767  IF (iflag_con==3) THEN
768
769        if (prt_level >= 9) &
770             PRINT *, 'cva_driver -> cv3_undilute1'
771    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
772                       gznk1, tp1, tvp1, clw1, icbs1)
773  END IF
774
775
776  IF (iflag_con==4) THEN
777        if (prt_level >= 9) &
778             PRINT *, 'cva_driver -> cv_undilute1'
779    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
780                      tp1, tvp1, clw1)
781  END IF
782
783! -------------------------------------------------------------------
784! --- TRIGGERING
785! -------------------------------------------------------------------
786
787! print *,' avant triggering, iflag_con ',iflag_con
788
789  IF (iflag_con==3) THEN
790
791        if (prt_level >= 9) &
792             PRINT *, 'cva_driver -> cv3_trigger'
793    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
794                      pbase1, buoybase1, iflag1, sig1, w01)
795
796
797! print*, 'IFLAG1 apres cv3_triger'
798! print*,'len,nd',len,nd
799! write(*,'(64i1)') iflag1(2:klon-1)
800
801! call dump2d(iim,jjm-1,sig1(2)
802  END IF
803
804  IF (iflag_con==4) THEN
805        if (prt_level >= 9) &
806             PRINT *, 'cva_driver -> cv_trigger'
807    CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
808  END IF
809
810
811! =====================================================================
812! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
813! =====================================================================
814
815!  Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
816!  gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
817!  elsewhere).
818  ncum = 0
819  coef_convective(:) = 0.
820  DO i = 1, len
821    IF (iflag1(i)==0) THEN
822      coef_convective(i) = 1.
823      ncum = ncum + 1
824      idcum(ncum) = i
825    END IF
826  END DO
827
828! print*,'klon, ncum = ',len,ncum
829
830  IF (ncum>0) THEN
831
832! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
833! --- COMPRESS THE FIELDS
834!       (-> vectorization over convective gridpoints)
835! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
836
837    IF (iflag_con==3) THEN
838! print*,'ncum tv1 ',ncum,tv1
839! print*,'tvp1 ',tvp1
840!jyg<
841!   If the fraction of convective points is larger than comp_threshold, then compression
842!   is assumed useless.
843!
844  compress = ncum .lt. len*comp_threshold
845!
846  IF (.not. compress) THEN
847    DO i = 1,len
848      idcum(i) = i
849    ENDDO
850  ENDIF
851!
852!>jyg
853        if (prt_level >= 9) &
854             PRINT *, 'cva_driver -> cv3a_compress'
855      CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
856                         iflag1, nk1, icb1, icbs1, &
857                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
858                         wghti1, pbase1, buoybase1, &
859                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
860                         u1, v1, gz1, th1, th1_wake, &
861                         tra1, &
862                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
863                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
864                         sig1, w01, ptop21, &
865                         Ale1, Alp1, omega1, &
866                         iflag, nk, icb, icbs, &
867                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
868                         wghti, pbase, buoybase, &
869                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
870                         u, v, gz, th, th_wake, &
871                         tra, &
872                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
873                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
874                         sig, w0, ptop2, &
875                         Ale, Alp, omega)
876
877! print*,'tv ',tv
878! print*,'tvp ',tvp
879
880    END IF
881
882    IF (iflag_con==4) THEN
883        if (prt_level >= 9) &
884             PRINT *, 'cva_driver -> cv_compress'
885      CALL cv_compress(len, nloc, ncum, nd, &
886                       iflag1, nk1, icb1, &
887                       cbmf1, plcl1, tnk1, qnk1, gznk1, &
888                       t1, q1, qs1, u1, v1, gz1, &
889                       h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
890                       iflag, nk, icb, &
891                       cbmf, plcl, tnk, qnk, gznk, &
892                       t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
893                       dph)
894    END IF
895
896! -------------------------------------------------------------------
897! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
898! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
899! ---   &
900! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
901! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
902! ---   &
903! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
904! -------------------------------------------------------------------
905
906    IF (iflag_con==3) THEN
907        if (prt_level >= 9) &
908             PRINT *, 'cva_driver -> cv3_undilute2'
909      CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, &              !na->nd
910                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
911                         p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
912                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
913                         frac)
914    END IF
915
916    IF (iflag_con==4) THEN
917        if (prt_level >= 9) &
918             PRINT *, 'cva_driver -> cv_undilute2'
919      CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
920                        tnk, qnk, gznk, t, q, qs, gz, &
921                        p, dph, h, tv, lv, &
922                        inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
923    END IF
924
925    ! epmax_cape
926    ! on recalcule ep et hp   
927        if (prt_level >= 9) &
928             PRINT *, 'cva_driver -> cv3_epmax_cape'
929    call cv3_epmax_fn_cape(nloc,ncum,nd &
930                , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac &
931                , pbase, p, ph, tv, buoy, sig, w0,iflag &
932                , epmax_diag)
933
934! -------------------------------------------------------------------
935! --- MIXING(1)   (if iflag_mix .ge. 1)
936! -------------------------------------------------------------------
937    IF (iflag_con==3) THEN
938!      IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
939!        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
940!          '. Might as well stop here.'
941!        STOP
942!      END IF
943      IF (iflag_mix>=1) THEN
944        CALL zilch(supmax, nloc*klev)
945        if (prt_level >= 9) &
946             PRINT *, 'cva_driver -> cv3p_mixing'
947        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
948                         ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
949                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
950                         ment, qent, hent, uent, vent, nent, &
951                         sigij, elij, supmax, ments, qents, traent)
952! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
953
954      ELSE
955        CALL zilch(supmax, nloc*klev)
956      END IF
957    END IF
958! -------------------------------------------------------------------
959! --- CLOSURE
960! -------------------------------------------------------------------
961
962
963    IF (iflag_con==3) THEN
964      IF (iflag_clos==0) THEN
965        if (prt_level >= 9) &
966             PRINT *, 'cva_driver -> cv3_closure'
967        CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
968                         pbase, p, ph, tv, buoy, &
969                         sig, w0, cape, m, iflag)
970      END IF   ! iflag_clos==0
971
972      ok_inhib = iflag_mix == 2
973
974      IF (iflag_clos==1) THEN
975        PRINT *, ' pas d appel cv3p_closure'
976! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              ! na->nd
977! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
978! c    :                       ,supmax
979! c    o                       ,sig,w0,ptop2,cape,cin,m)
980      END IF   ! iflag_clos==1
981
982      IF (iflag_clos==2) THEN
983        if (prt_level >= 9) &
984             PRINT *, 'cva_driver -> cv3p1_closure'
985        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
986                           pbase, plcl, p, ph, tv, tvp, buoy, &
987                           supmax, ok_inhib, Ale, Alp, omega, &
988                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
989                           Plim1, plim2, asupmax, supmax0, &
990                           asupmaxmin, cbmf, plfc, wbeff)
991        if (prt_level >= 10) &
992             PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
993      END IF   ! iflag_clos==2
994
995      IF (iflag_clos==3) THEN
996        if (prt_level >= 9) &
997             PRINT *, 'cva_driver -> cv3p2_closure'
998        CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
999                           pbase, plcl, p, ph, tv, tvp, buoy, &
1000                           supmax, ok_inhib, Ale, Alp, omega, &
1001                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1002                           Plim1, plim2, asupmax, supmax0, &
1003                           asupmaxmin, cbmf, plfc, wbeff)
1004        if (prt_level >= 10) &
1005             PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1006      END IF   ! iflag_clos==3
1007    END IF ! iflag_con==3
1008
1009    IF (iflag_con==4) THEN
1010        if (prt_level >= 9) &
1011             PRINT *, 'cva_driver -> cv_closure'
1012      CALL cv_closure(nloc, ncum, nd, nk, icb, &
1013                         tv, tvp, p, ph, dph, plcl, cpn, &
1014                         iflag, cbmf)
1015    END IF
1016
1017! print *,'cv_closure-> cape ',cape(1)
1018
1019! -------------------------------------------------------------------
1020! --- MIXING(2)
1021! -------------------------------------------------------------------
1022
1023    IF (iflag_con==3) THEN
1024      IF (iflag_mix==0) THEN
1025        if (prt_level >= 9) &
1026             PRINT *, 'cva_driver -> cv3_mixing'
1027        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
1028                        ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
1029                        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
1030                        ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
1031        CALL zilch(hent, nloc*klev*klev)
1032      ELSE
1033        CALL cv3_mixscale(nloc, ncum, nd, ment, m)
1034        IF (debut) THEN
1035          PRINT *, ' cv3_mixscale-> '
1036        END IF !(debut) THEN
1037      END IF
1038    END IF
1039
1040    IF (iflag_con==4) THEN
1041        if (prt_level >= 9) &
1042             PRINT *, 'cva_driver -> cv_mixing'
1043      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
1044                     ph, t, q, qs, u, v, h, lv, qnk, &
1045                     hp, tv, tvp, ep, clw, cbmf, &
1046                     m, ment, qent, uent, vent, nent, sigij, elij)
1047    END IF                                                                                         
1048
1049    IF (debut) THEN
1050      PRINT *, ' cv_mixing ->'
1051    END IF !(debut) THEN
1052! do i = 1,nd
1053! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
1054! enddo
1055
1056! -------------------------------------------------------------------
1057! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1058! -------------------------------------------------------------------
1059    IF (iflag_con==3) THEN
1060      IF (debut) THEN
1061        PRINT *, ' cva_driver -> cv3_unsat '
1062      END IF !(debut) THEN
1063
1064        if (prt_level >= 9) &
1065             PRINT *, 'cva_driver -> cv3_unsat'
1066      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
1067                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
1068                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
1069                     ep, sigp, clw, &
1070                     m, ment, elij, delt, plcl, coef_clos, &
1071                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
1072                     faci, b, sigd, &
1073                     wdtrainA, wdtrainM)                                       ! RomP
1074!
1075      IF (prt_level >= 10) THEN
1076        Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
1077        DO k = 1,nd
1078        write (6, '(i4,5(1x,e13.6))'), &
1079          k, mp(idcum(igout),k), water(idcum(igout),k), ice(idcum(igout),k), &
1080           evap(idcum(igout),k), fondue(idcum(igout),k)
1081        ENDDO
1082        Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainM '
1083        DO k = 1,nd
1084        write (6, '(i4,2(1x,e13.6))'), &
1085           k, wdtrainA(idcum(igout),k), wdtrainM(idcum(igout),k)
1086        ENDDO
1087      ENDIF
1088!
1089    END IF  !(iflag_con==3)
1090
1091    IF (iflag_con==4) THEN
1092        if (prt_level >= 9) &
1093             PRINT *, 'cva_driver -> cv_unsat'
1094      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1095                     h, lv, ep, sigp, clw, m, ment, elij, &
1096                     iflag, mp, qp, up, vp, wt, water, evap)
1097    END IF
1098
1099    IF (debut) THEN
1100      PRINT *, 'cv_unsat-> '
1101    END IF !(debut) THEN
1102
1103! print *,'cv_unsat-> mp ',mp
1104! print *,'cv_unsat-> water ',water
1105! -------------------------------------------------------------------
1106! --- YIELD
1107! (tendencies, precipitation, variables of interface with other
1108! processes, etc)
1109! -------------------------------------------------------------------
1110
1111    IF (iflag_con==3) THEN
1112
1113        if (prt_level >= 9) &
1114             PRINT *, 'cva_driver -> cv3_yield'
1115      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
1116                     icb, inb, delt, &
1117                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
1118                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1119                     ep, clw, m, tp, mp, qp, up, vp, trap, &
1120                     wt, water, ice, evap, fondue, faci, b, sigd, &
1121                     ment, qent, hent, iflag_mix, uent, vent, &
1122                     nent, elij, traent, sig, &
1123                     tv, tvp, wghti, &
1124                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &      ! jyg
1125                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
1126!!                     tls, tps, &                            ! useless . jyg
1127                     qcondc, wd, &
1128                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1129!
1130      IF (debut) THEN
1131        PRINT *, ' cv3_yield -> fqd(1) = ', fqd(idcum(igout), 1)
1132      END IF !(debut) THEN
1133!   
1134      IF (prt_level >= 10) THEN
1135        Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
1136                    ft(idcum(igout),1), ftd(idcum(igout),1)
1137        Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
1138                    fq(idcum(igout),1), fqd(idcum(igout),1)
1139      ENDIF
1140!   
1141    END IF
1142
1143    IF (iflag_con==4) THEN
1144        if (prt_level >= 9) &
1145             PRINT *, 'cva_driver -> cv_yield'
1146      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1147                     t, q, u, v, &
1148                     gz, p, ph, h, hp, lv, cpn, &
1149                     ep, clw, frac, m, mp, qp, up, vp, &
1150                     wt, water, evap, &
1151                     ment, qent, uent, vent, nent, elij, &
1152                     tv, tvp, &
1153                     iflag, wd, qprime, tprime, &
1154                     precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1155    END IF
1156
1157!AC!
1158!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1159!--- passive tracers
1160!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1161
1162    IF (iflag_con==3) THEN
1163!RomP >>>
1164        if (prt_level >= 9) &
1165             PRINT *, 'cva_driver -> cv3_tracer'
1166      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1167                     ment, sigij, da, phi, phi2, d1a, dam, &
1168                     ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1169                     icb, inb)
1170!RomP <<<
1171    END IF
1172
1173!AC!
1174
1175! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1176! --- UNCOMPRESS THE FIELDS
1177! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1178
1179
1180    IF (iflag_con==3) THEN
1181        if (prt_level >= 9) &
1182             PRINT *, 'cva_driver -> cv3a_uncompress'
1183      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1184                           iflag, icb, inb, &
1185                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1186                           ft, fq, fu, fv, ftra, &
1187                           sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1188                           qcondc, wd, cape, cin, &
1189                           tvp, &
1190                           ftd, fqd, &
1191                           Plim1, plim2, asupmax, supmax0, &
1192                           asupmaxmin, &
1193                           da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
1194                           clw, elij, evap, ep, epmlmMm, eplaMm, &       ! RomP
1195                           wdtrainA, wdtrainM, &                         ! RomP
1196                           qtc, sigt, epmax_diag, & ! epmax_cape
1197                           iflag1, kbas1, ktop1, &
1198                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1199                           ft1, fq1, fu1, fv1, ftra1, &
1200                           sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1201                           qcondc1, wd1, cape1, cin1, &
1202                           tvp1, &
1203                           ftd1, fqd1, &
1204                           Plim11, plim21, asupmax1, supmax01, &
1205                           asupmaxmin1, &
1206                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  & ! RomP
1207                           clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1208                           wdtrainA1, wdtrainM1,                       & ! RomP
1209                           qtc1, sigt1, epmax_diag1) ! epmax_cape
1210    END IF
1211
1212    IF (iflag_con==4) THEN
1213        if (prt_level >= 9) &
1214             PRINT *, 'cva_driver -> cv_uncompress'
1215      CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1216                           iflag, &
1217                           precip, cbmf, &
1218                           ft, fq, fu, fv, &
1219                           ma, qcondc, &
1220                           iflag1, &
1221                           precip1,cbmf1, &
1222                           ft1, fq1, fu1, fv1, &
1223                           ma1, qcondc1)
1224    END IF
1225
1226  END IF ! ncum>0
1227
1228!
1229! In order take into account the possibility of changing the compression,
1230! reset m, sig and w0 to zero for non-convective points.
1231  DO k = 1,nd-1
1232        sig1(:, k) = sig1(:, k)*coef_convective(:)
1233        w01(:, k)  = w01(:, k)*coef_convective(:)
1234  ENDDO
1235
1236  IF (debut) THEN
1237    PRINT *, ' cv_uncompress -> '
1238    debut = .FALSE.
1239  END IF  !(debut) THEN
1240
1241
1242  RETURN
1243END SUBROUTINE cva_driver
Note: See TracBrowser for help on using the repository browser.