source: LMDZ6/branches/LMDZ-QUEST/libf/phylmd/cva_driver.F90 @ 5407

Last change on this file since 5407 was 3564, checked in by jghattas, 5 years ago

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