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

Last change on this file since 2492 was 2481, checked in by fhourdin, 9 years ago

Introduction d'une dependance epmax=f(Cape) sur proposition de Camille Risi

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