GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/cva_driver.F90 Lines: 274 359 76.3 %
Date: 2023-06-30 12:56:34 Branches: 296 386 76.7 %

Line Branch Exec Source
1
2
! $Id: cva_driver.F90 3670 2020-04-27 08:49:09Z jyg $
3
4
144
SUBROUTINE 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
144
                      iflag1, ft1, fq1, fu1, fv1, ftra1, &
14
144
                      precip1, kbas1, ktop1, &
15
                      cbmf1, plcl1, plfc1, wbeff1, &
16
                      sig1, w01, & !input/output
17
                      ptop21, sigd1, &
18
144
                      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
144
                      da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
27
                      qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP, RL
28
                      wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &     !!jygprl
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 ejected from adiabatic draught;
127
!                                         should be used in tracer transport (cvltr)
128
! wdtrainS1     Real           Output   precipitation detrained from shedding of adiabatic draught;
129
!                                         used in tracer transport (cvltr)
130
! wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
131
!                                         used in tracer transport (cvltr)
132
! da1           Real           Output     used in tracer transport (cvltr)
133
! phi1          Real           Output     used in tracer transport (cvltr)
134
! mp1           Real           Output     used in tracer transport (cvltr)
135
! qtc1          Real           Output     specific humidity in convection
136
! sigt1         Real           Output     surface fraction in adiabatic updrafts
137
! phi21         Real           Output     used in tracer transport (cvltr)
138
139
! d1a1          Real           Output     used in tracer transport (cvltr)
140
! dam1          Real           Output     used in tracer transport (cvltr)
141
142
! epmlmMm1      Real           Output     used in tracer transport (cvltr)
143
! eplaMm1       Real           Output     used in tracer transport (cvltr)
144
145
! evap1         Real           Output
146
! ep1           Real           Output
147
! sigij1        Real           Output     used in tracer transport (cvltr)
148
! clw1          Real           Output   condensed water content of the adiabatic updraught
149
! elij1         Real           Output
150
! wghti1        Real           Output   final weight of the feeding layers,
151
!                                         used in tracer transport (cvltr)
152
153
154
! S. Bony, Mar 2002:
155
! * Several modules corresponding to different physical processes
156
! * Several versions of convect may be used:
157
!         - iflag_con=3: version lmd  (previously named convect3)
158
!         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
159
! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
160
! S. Bony, Oct 2002:
161
! * Vectorization of convect3 (ie version lmd)
162
163
! ..............................END PROLOGUE.............................
164
165
166
167
! Input
168
  INTEGER, INTENT (IN)                               :: len
169
  INTEGER, INTENT (IN)                               :: nd
170
  INTEGER, INTENT (IN)                               :: ndp1
171
  INTEGER, INTENT (IN)                               :: ntra
172
  INTEGER, INTENT(IN)                                :: nloc ! (nloc=len)  pour l'instant
173
  INTEGER, INTENT (IN)                               :: k_upper
174
  INTEGER, INTENT (IN)                               :: iflag_con
175
  INTEGER, INTENT (IN)                               :: iflag_mix
176
  INTEGER, INTENT (IN)                               :: iflag_ice_thermo
177
  INTEGER, INTENT (IN)                               :: iflag_clos
178
  LOGICAL, INTENT (IN)                               :: ok_conserv_q
179
  REAL, INTENT (IN)                                  :: tau_cld_cv
180
  REAL, INTENT (IN)                                  :: coefw_cld_cv
181
  REAL, INTENT (IN)                                  :: delt
182
  REAL, INTENT (IN)                                  :: comp_threshold
183
  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1
184
  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1
185
  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1
186
  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake
187
  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1_wake
188
  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1_wake
189
  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
190
  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1
191
  REAL, DIMENSION (len, nd), INTENT (IN)             :: v1
192
  REAL, DIMENSION (len, nd, ntra), INTENT (IN)       :: tra1
193
  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
194
  REAL, DIMENSION (len, ndp1), INTENT (IN)           :: ph1
195
  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1
196
  REAL, DIMENSION (len), INTENT (IN)                 :: Alp1
197
  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
198
  REAL, INTENT (IN)                                  :: sig1feed1 ! pressure at lower bound of feeding layer
199
  REAL, INTENT (IN)                                  :: sig2feed1 ! pressure at upper bound of feeding layer
200
  REAL, DIMENSION (nd), INTENT (IN)                  :: wght1     ! weight density determining the feeding mixture
201
  INTEGER, DIMENSION (len), INTENT (IN)              :: lalim_conv1
202
203
! Input/Output
204
  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: sig1
205
  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: w01
206
207
! Output
208
  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1
209
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1
210
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fq1
211
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fu1
212
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fv1
213
  REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
214
  REAL, DIMENSION (len), INTENT (OUT)                :: precip1
215
  INTEGER, DIMENSION (len), INTENT (OUT)             :: kbas1
216
  INTEGER, DIMENSION (len), INTENT (OUT)             :: ktop1
217
  REAL, DIMENSION (len), INTENT (OUT)                :: cbmf1
218
  REAL, DIMENSION (len), INTENT (OUT)                :: plcl1
219
  REAL, DIMENSION (len), INTENT (OUT)                :: plfc1
220
  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
221
  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
222
  REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
223
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1        ! adiab. asc. mass flux (staggered grid)
224
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mip1       ! mass flux shed from adiab. ascent (extensive)
225
! real Vprecip1(len,nd)
226
  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecip1   ! tot precipitation flux (staggered grid)
227
  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecipi1  ! ice precipitation flux (staggered grid)
228
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1      ! upwd sat. mass flux (staggered grid)
229
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd1      ! dnwd sat. mass flux (staggered grid)
230
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd01     ! unsat. mass flux (staggered grid)
231
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1    ! max cloud condensate (intensive)  ! cld
232
  REAL, DIMENSION (len), INTENT (OUT)                :: wd1             ! gust
233
  REAL, DIMENSION (len), INTENT (OUT)                :: cape1
234
  REAL, DIMENSION (len), INTENT (OUT)                :: cin1
235
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1       ! Virt. temp. in the adiab. ascent
236
237
!AC!
238
!!      real da1(len,nd),phi1(len,nd,nd)
239
!!      real da(len,nd),phi(len,nd,nd)
240
!AC!
241
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1       ! Temp. tendency due to the sole unsat. drafts
242
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqd1       ! Moist. tendency due to the sole unsat. drafts
243
  REAL, DIMENSION (len), INTENT (OUT)                :: Plim11
244
  REAL, DIMENSION (len), INTENT (OUT)                :: Plim21
245
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1   ! Highest mixing fraction of mixed updraughts
246
  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01
247
  REAL, DIMENSION (len), INTENT (OUT)                :: asupmaxmin1
248
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1    ! in cloud water content (intensive)   ! cld
249
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1   ! fract. cloud area (intensive)        ! cld
250
251
! RomP >>>
252
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainS1, wdtrainM1 ! precipitation sources (extensive)
253
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mp1  ! unsat. mass flux (staggered grid)
254
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1  ! detrained mass flux of adiab. asc. air (extensive)
255
  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
256
  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1  ! (extensive)
257
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplaMm1   ! (extensive)
258
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1 ! evaporation rate in precip. downdraft. (intensive)
259
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ep1
260
  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
261
  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: elij1! cond. water per unit mass of mixed draughts (intensive)
262
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qta1 ! total water per unit mass of the adiab. asc. (intensive)
263
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: clw1 ! cond. water per unit mass of the adiab. asc. (intensive)
264
!JYG,RL
265
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti1   ! final weight of the feeding layers (extensive)
266
!JYG,RL
267
  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21    ! (extensive)
268
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1     ! (extensive)
269
  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dam1     ! (extensive)
270
! RomP <<<
271
  REAL, DIMENSION (len ), INTENT (OUT)               :: epmax_diag1
272
273
! -------------------------------------------------------------------
274
! Prolog by Kerry Emanuel.
275
! -------------------------------------------------------------------
276
! --- ARGUMENTS
277
! -------------------------------------------------------------------
278
! --- On input:
279
280
! t:   Array of absolute temperature (K) of dimension ND, with first
281
! index corresponding to lowest model level. Note that this array
282
! will be altered by the subroutine if dry convective adjustment
283
! occurs and if IPBL is not equal to 0.
284
285
! q:   Array of specific humidity (gm/gm) of dimension ND, with first
286
! index corresponding to lowest model level. Must be defined
287
! at same grid levels as T. Note that this array will be altered
288
! if dry convective adjustment occurs and if IPBL is not equal to 0.
289
290
! qs:  Array of saturation specific humidity of dimension ND, with first
291
! index corresponding to lowest model level. Must be defined
292
! at same grid levels as T. Note that this array will be altered
293
! if dry convective adjustment occurs and if IPBL is not equal to 0.
294
295
! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
296
! of dimension ND, with first index corresponding to lowest model level.
297
298
! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
299
! of dimension ND, with first index corresponding to lowest model level.
300
! Must be defined at same grid levels as T.
301
302
! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
303
! of dimension ND, with first index corresponding to lowest model level.
304
! Must be defined at same grid levels as T.
305
306
! s_wake: Array of fractionnal area occupied by the wakes.
307
308
! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
309
! index corresponding with the lowest model level. Defined at
310
! same levels as T. Note that this array will be altered if
311
! dry convective adjustment occurs and if IPBL is not equal to 0.
312
313
! v:   Same as u but for meridional velocity.
314
315
! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
316
! where NTRA is the number of different tracers. If no
317
! convective tracer transport is needed, define a dummy
318
! input array of dimension (ND,1). Tracers are defined at
319
! same vertical levels as T. Note that this array will be altered
320
! if dry convective adjustment occurs and if IPBL is not equal to 0.
321
322
! p:   Array of pressure (mb) of dimension ND, with first
323
! index corresponding to lowest model level. Must be defined
324
! at same grid levels as T.
325
326
! ph:  Array of pressure (mb) of dimension ND+1, with first index
327
! corresponding to lowest level. These pressures are defined at
328
! levels intermediate between those of P, T, Q and QS. The first
329
! value of PH should be greater than (i.e. at a lower level than)
330
! the first value of the array P.
331
332
! ALE:  Available lifting Energy
333
334
! ALP:  Available lifting Power
335
336
! nl:  The maximum number of levels to which convection can penetrate, plus 1.
337
!       NL MUST be less than or equal to ND-1.
338
339
! delt: The model time step (sec) between calls to CONVECT
340
341
! ----------------------------------------------------------------------------
342
! ---   On Output:
343
344
! iflag: An output integer whose value denotes the following:
345
!       VALUE   INTERPRETATION
346
!       -----   --------------
347
!         0     Moist convection occurs.
348
!         1     Moist convection occurs, but a CFL condition
349
!               on the subsidence warming is violated. This
350
!               does not cause the scheme to terminate.
351
!         2     Moist convection, but no precip because ep(inb) lt 0.0001
352
!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
353
!         4     No moist convection; atmosphere is not
354
!               unstable
355
!         6     No moist convection because ihmin le minorig.
356
!         7     No moist convection because unreasonable
357
!               parcel level temperature or specific humidity.
358
!         8     No moist convection: lifted condensation
359
!               level is above the 200 mb level.
360
!         9     No moist convection: cloud base is higher
361
!               then the level NL-1.
362
!        10     No moist convection: cloud top is too warm.
363
!        14     No moist convection; atmosphere is very
364
!               stable (=> no computation)
365
!
366
367
! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
368
!       grid levels as T, Q, QS and P.
369
370
! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
371
!       defined at same grid levels as T, Q, QS and P.
372
373
! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
374
!      defined at same grid levels as T.
375
376
! fv:   Same as FU, but for forcing of meridional velocity.
377
378
! ftra: Array of forcing of tracer content, in tracer mixing ratio per
379
!       second, defined at same levels as T. Dimensioned (ND,NTRA).
380
381
! precip: Scalar convective precipitation rate (mm/day).
382
383
! wd:   A convective downdraft velocity scale. For use in surface
384
!       flux parameterizations. See convect.ps file for details.
385
386
! tprime: A convective downdraft temperature perturbation scale (K).
387
!         For use in surface flux parameterizations. See convect.ps
388
!         file for details.
389
390
! qprime: A convective downdraft specific humidity
391
!         perturbation scale (gm/gm).
392
!         For use in surface flux parameterizations. See convect.ps
393
!         file for details.
394
395
! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
396
!       BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
397
!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
398
!       by the calling program between calls to CONVECT.
399
400
! det:   Array of detrainment mass flux of dimension ND.
401
! -------------------------------------------------------------------
402
403
! Local (non compressed) arrays
404
405
406
  INTEGER i, k, il
407
  INTEGER nword1, nword2, nword3, nword4
408
  INTEGER icbmax
409
288
  INTEGER nk1(len)
410
288
  INTEGER icb1(len)
411
288
  INTEGER icbs1(len)
412
413
  LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
414
  LOGICAL, SAVE :: debut = .TRUE.
415
!$OMP THREADPRIVATE(debut)
416
417
288
  REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
418
288
  REAL tnk1(len)
419
288
  REAL thnk1(len)
420
288
  REAL qnk1(len)
421
288
  REAL gznk1(len)
422
288
  REAL qsnk1(len)
423
288
  REAL unk1(len)
424
288
  REAL vnk1(len)
425
288
  REAL cpnk1(len)
426
288
  REAL hnk1(len)
427
288
  REAL pbase1(len)
428
288
  REAL buoybase1(len)
429
430
288
  REAL lf1(len, nd), lf1_wake(len, nd)
431
288
  REAL lv1(len, nd), lv1_wake(len, nd)
432
288
  REAL cpn1(len, nd), cpn1_wake(len, nd)
433
288
  REAL tv1(len, nd), tv1_wake(len, nd)
434
288
  REAL gz1(len, nd), gz1_wake(len, nd)
435
288
  REAL hm1(len, nd)
436
288
  REAL h1(len, nd), h1_wake(len, nd)
437
288
  REAL tp1(len, nd)
438
288
  REAL th1(len, nd), th1_wake(len, nd)
439
440
288
  REAL bid(len, nd) ! dummy array
441
442
  INTEGER ncum
443
444
288
  REAL p1feed1(len) ! pressure at lower bound of feeding layer
445
288
  REAL p2feed1(len) ! pressure at upper bound of feeding layer
446
!JYG,RL
447
!!      real wghti1(len,nd) ! weights of the feeding layers
448
!JYG,RL
449
450
! (local) compressed fields:
451
452
453
288
  INTEGER idcum(nloc)
454
!jyg<
455
  LOGICAL compress    ! True if compression occurs
456
!>jyg
457
288
  INTEGER iflag(nloc), nk(nloc), icb(nloc)
458
288
  INTEGER nent(nloc, nd)
459
288
  INTEGER icbs(nloc)
460
288
  INTEGER inb(nloc), inbis(nloc)
461
462
288
  REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
463
288
  REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
464
288
  REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
465
288
  REAL s_wake(nloc)
466
288
  REAL u(nloc, nd), v(nloc, nd)
467
288
  REAL gz(nloc, nd), h(nloc, nd)
468
288
  REAL h_wake(nloc, nd)
469
288
  REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
470
288
  REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
471
288
  REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
472
288
  REAL tv_wake(nloc, nd)
473
288
  REAL clw(nloc, nd)
474
288
  REAL, DIMENSION(nloc, nd)    :: qta, qpreca                       !!jygprl
475
288
  REAL dph(nloc, nd)
476
288
  REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
477
288
  REAL th_wake(nloc, nd)
478
288
  REAL tvp(nloc, nd)
479
288
  REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
480
288
  REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
481
288
  REAL buoy(nloc, nd)
482
288
  REAL cape(nloc)
483
288
  REAL cin(nloc)
484
288
  REAL m(nloc, nd)
485
288
  REAL mm(nloc, nd)
486
288
  REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
487
288
  REAL qent(nloc, nd, nd)
488
288
  REAL hent(nloc, nd, nd)
489
288
  REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
490
288
  REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
491
288
  REAL elij(nloc, nd, nd)
492
288
  REAL supmax(nloc, nd)
493
288
  REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
494
288
  REAL omega(nloc,nd)
495
288
  REAL sigd(nloc)
496
! real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
497
! real wt(nloc,nd), water(nloc,nd), evap(nloc,nd), ice(nloc,nd)
498
! real b(nloc,nd), sigd(nloc)
499
! save mp,qp,up,vp,wt,water,evap,b
500
288
  REAL, DIMENSION(len,nd)     :: mp, qp, up, vp
501
288
  REAL, DIMENSION(len,nd)     :: wt, water, evap
502
288
  REAL, DIMENSION(len,nd)     :: ice, fondue, b
503
288
  REAL, DIMENSION(len,nd)     :: frac_a, frac_s, faci               !!jygprl
504
288
  REAL ft(nloc, nd), fq(nloc, nd)
505
288
  REAL ftd(nloc, nd), fqd(nloc, nd)
506
288
  REAL fu(nloc, nd), fv(nloc, nd)
507
288
  REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
508
288
  REAL ma(nloc, nd), mip(nloc, nd)
509
!!  REAL tls(nloc, nd), tps(nloc, nd)                 ! unused . jyg
510
288
  REAL qprime(nloc), tprime(nloc)
511
288
  REAL precip(nloc)
512
! real Vprecip(nloc,nd)
513
288
  REAL vprecip(nloc, nd+1)
514
288
  REAL vprecipi(nloc, nd+1)
515
288
  REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
516
288
  REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
517
288
  REAL qcondc(nloc, nd)      ! cld
518
288
  REAL wd(nloc)                ! gust
519
288
  REAL Plim1(nloc), plim2(nloc)
520
288
  REAL asupmax(nloc, nd)
521
288
  REAL supmax0(nloc)
522
288
  REAL asupmaxmin(nloc)
523
524
288
  REAL tnk(nloc), qnk(nloc), gznk(nloc)
525
288
  REAL wghti(nloc, nd)
526
288
  REAL hnk(nloc), unk(nloc), vnk(nloc)
527
528
288
  REAL qtc(nloc, nd)         ! cld
529
288
  REAL sigt(nloc, nd)        ! cld
530
531
! RomP >>>
532
288
  REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd)   !!jygprl
533
288
  REAL da(len, nd), phi(len, nd, nd)
534
288
  REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
535
288
  REAL phi2(len, nd, nd)
536
288
  REAL d1a(len, nd), dam(len, nd)
537
! RomP <<<
538
288
  REAL epmax_diag(nloc) ! epmax_cape
539
540
  CHARACTER (LEN=20) :: modname = 'cva_driver'
541
  CHARACTER (LEN=80) :: abort_message
542
543
  REAL, PARAMETER    :: Cin_noconv = -100000.
544
  REAL, PARAMETER    :: Cape_noconv = -1.
545
546
  INTEGER,SAVE                                       :: igout=1
547
!$OMP THREADPRIVATE(igout)
548
549
550
! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd)
551
! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
552
553
! -------------------------------------------------------------------
554
! --- SET CONSTANTS AND PARAMETERS
555
! -------------------------------------------------------------------
556
557
! -- set simulation flags:
558
! (common cvflag)
559
560
144
  CALL cv_flag(iflag_ice_thermo)
561
562
! -- set thermodynamical constants:
563
! (common cvthermo)
564
565
144
  CALL cv_thermo(iflag_con)
566
567
! -- set convect parameters
568
569
! includes microphysical parameters and parameters that
570
! control the rate of approach to quasi-equilibrium)
571
! (common cvparam)
572
573
144
  IF (iflag_con==3) THEN
574
144
    CALL cv3_param(nd, k_upper, delt)
575
576
  END IF
577
578
144
  IF (iflag_con==4) THEN
579
    CALL cv_param(nd)
580
  END IF
581
582
! ---------------------------------------------------------------------
583
! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
584
! ---------------------------------------------------------------------
585
  nword1 = len
586
  nword2 = len*nd
587
  nword3 = len*nd*ntra
588
  nword4 = len*nd*nd
589
590
143280
  iflag1(:) = 0
591
143280
  ktop1(:) = 0
592
143280
  kbas1(:) = 0
593

5588064
  ft1(:, :) = 0.0
594

5588064
  fq1(:, :) = 0.0
595

5588064
  fu1(:, :) = 0.0
596

5588064
  fv1(:, :) = 0.0
597

11176272
  ftra1(:, :, :) = 0.
598
143280
  precip1(:) = 0.
599
143280
  cbmf1(:) = 0.
600
143280
  plcl1(:) = 0.
601
143280
  plfc1(:) = 0.
602
143280
  wbeff1(:) = 0.
603
143280
  ptop21(:) = 0.
604
143280
  sigd1(:) = 0.
605

5588064
  ma1(:, :) = 0.
606

5588064
  mip1(:, :) = 0.
607

5731344
  vprecip1(:, :) = 0.
608

5731344
  vprecipi1(:, :) = 0.
609

5588064
  upwd1(:, :) = 0.
610

5588064
  dnwd1(:, :) = 0.
611

5588064
  dnwd01(:, :) = 0.
612

5588064
  qcondc1(:, :) = 0.
613
143280
  wd1(:) = 0.
614
143280
  cape1(:) = 0.
615
143280
  cin1(:) = 0.
616

5588064
  tvp1(:, :) = 0.
617

5588064
  ftd1(:, :) = 0.
618

5588064
  fqd1(:, :) = 0.
619
143280
  Plim11(:) = 0.
620
143280
  Plim21(:) = 0.
621

5588064
  asupmax1(:, :) = 0.
622
143280
  supmax01(:) = 0.
623
143280
  asupmaxmin1(:) = 0.
624
625

5588064
  tvp(:, :) = 0. !ym missing init, need to have a look by developpers
626

5588064
  tv(:, :) = 0. !ym missing init, need to have a look by developpers
627
628
143280
  DO il = 1, len
629
!!    cin1(il) = -100000.
630
!!    cape1(il) = -1.
631
143136
    cin1(il) = Cin_noconv
632
143280
    cape1(il) = Cape_noconv
633
  END DO
634
635
!!  IF (iflag_con==3) THEN
636
!!    DO il = 1, len
637
!!      sig1(il, nd) = sig1(il, nd) + 1.
638
!!      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
639
!!    END DO
640
!!  END IF
641
642
144
  IF (iflag_con==3) THEN
643
144
      CALL cv3_incrcount(len,nd,delt,sig1)
644
  END IF  ! (iflag_con==3)
645
646
! RomP >>>
647

5588064
  sigt1(:, :) = 0.
648

5588064
  qtc1(:, :) = 0.
649

5588064
  wdtrainA1(:, :) = 0.
650

5588064
  wdtrainS1(:, :) = 0.
651

5588064
  wdtrainM1(:, :) = 0.
652

5588064
  da1(:, :) = 0.
653

217934640
  phi1(:, :, :) = 0.
654

217934640
  epmlmMm1(:, :, :) = 0.
655

5588064
  eplaMm1(:, :) = 0.
656

5588064
  mp1(:, :) = 0.
657

5588064
  evap1(:, :) = 0.
658

5588064
  ep1(:, :) = 0.
659

217934640
  sigij1(:, :, :) = 0.
660

217934640
  elij1(:, :, :) = 0.
661

5588064
  qta1(:,:) = 0.
662

5588064
  clw1(:,:) = 0.
663

5588064
  wghti1(:,:) = 0.
664

217934640
  phi21(:, :, :) = 0.
665

5588064
  d1a1(:, :) = 0.
666

5588064
  dam1(:, :) = 0.
667
! RomP <<<
668
! ---------------------------------------------------------------------
669
! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
670
! ---------------------------------------------------------------------
671
672
143280
  DO il = 1, nloc
673
143280
    coef_clos(il) = 1.
674
  END DO
675
676
! --------------------------------------------------------------------
677
! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
678
! --------------------------------------------------------------------
679
680
144
  IF (iflag_con==3) THEN
681
682
144
    IF (debut) THEN
683
1
      PRINT *, 'Emanuel version 3 nouvelle'
684
    END IF
685
! print*,'t1, q1 ',t1,q1
686
144
        if (prt_level >= 9) &
687
             PRINT *, 'cva_driver -> cv3_prelim'
688
    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
689
144
                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
690
691
692
144
        if (prt_level >= 9) &
693
             PRINT *, 'cva_driver -> cv3_prelim'
694
    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
695
                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
696
144
                    h1_wake, bid, th1_wake)
697
698
  END IF
699
700
144
  IF (iflag_con==4) THEN
701
    PRINT *, 'Emanuel version 4 '
702
        if (prt_level >= 9) &
703
             PRINT *, 'cva_driver -> cv_prelim'
704
    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
705
                   lv1, cpn1, tv1, gz1, h1, hm1)
706
  END IF
707
708
! --------------------------------------------------------------------
709
! --- CONVECTIVE FEED
710
! --------------------------------------------------------------------
711
712
! compute feeding layer potential temperature and mixing ratio :
713
714
! get bounds of feeding layer
715
716
! test niveaux couche alimentation KE
717
144
  IF (sig1feed1==sig2feed1) THEN
718
    WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
719
    WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
720
    abort_message = ''
721
    CALL abort_physic(modname, abort_message, 1)
722
  END IF
723
724
143280
  DO i = 1, len
725
143136
    p1feed1(i) = sig1feed1*ph1(i, 1)
726
143280
    p2feed1(i) = sig2feed1*ph1(i, 1)
727
!test maf
728
!   p1feed1(i)=ph1(i,1)
729
!   p2feed1(i)=ph1(i,2)
730
!   p2feed1(i)=ph1(i,3)
731
!testCR: on prend la couche alim des thermiques
732
!   p2feed1(i)=ph1(i,lalim_conv1(i)+1)
733
!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
734
  END DO
735
736
  IF (iflag_con==3) THEN
737
  END IF
738
  DO i = 1, len
739
! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
740
  END DO
741
144
  IF (iflag_con==3) THEN
742
743
! print*, 'IFLAG1 avant cv3_feed'
744
! print*,'len,nd',len,nd
745
! write(*,'(64i1)') iflag1(2:len-1)
746
747
144
        if (prt_level >= 9) &
748
             PRINT *, 'cva_driver -> cv3_feed'
749
    CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
750
                  t1, q1, u1, v1, p1, ph1, h1, gz1, &
751
                  p1feed1, p2feed1, wght1, &
752
                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
753
144
                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
754
  END IF
755
756
! print*, 'IFLAG1 apres cv3_feed'
757
! print*,'len,nd',len,nd
758
! write(*,'(64i1)') iflag1(2:len-1)
759
760
144
  IF (iflag_con==4) THEN
761
        if (prt_level >= 9) &
762
             PRINT *, 'cva_driver -> cv_feed'
763
    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
764
                 nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
765
  END IF
766
767
! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
768
769
! --------------------------------------------------------------------
770
! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
771
! (up through ICB for convect4, up through ICB+1 for convect3)
772
! Calculates the lifted parcel virtual temperature at nk, the
773
! actual temperature, and the adiabatic liquid water content.
774
! --------------------------------------------------------------------
775
776
144
  IF (iflag_con==3) THEN
777
778
144
        if (prt_level >= 9) &
779
             PRINT *, 'cva_driver -> cv3_undilute1'
780
    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
781
144
                       gznk1, tp1, tvp1, clw1, icbs1)
782
  END IF
783
784
785
144
  IF (iflag_con==4) THEN
786
        if (prt_level >= 9) &
787
             PRINT *, 'cva_driver -> cv_undilute1'
788
    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
789
                      tp1, tvp1, clw1)
790
  END IF
791
792
! -------------------------------------------------------------------
793
! --- TRIGGERING
794
! -------------------------------------------------------------------
795
796
! print *,' avant triggering, iflag_con ',iflag_con
797
798
144
  IF (iflag_con==3) THEN
799
800
144
        if (prt_level >= 9) &
801
             PRINT *, 'cva_driver -> cv3_trigger'
802
    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
803
144
                      pbase1, buoybase1, iflag1, sig1, w01)
804
805
806
! print*, 'IFLAG1 apres cv3_triger'
807
! print*,'len,nd',len,nd
808
! write(*,'(64i1)') iflag1(2:len-1)
809
810
! call dump2d(iim,jjm-1,sig1(2)
811
  END IF
812
813
144
  IF (iflag_con==4) THEN
814
        if (prt_level >= 9) &
815
             PRINT *, 'cva_driver -> cv_trigger'
816
    CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
817
  END IF
818
819
820
! =====================================================================
821
! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
822
! =====================================================================
823
824
!  Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
825
!  gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
826
!  elsewhere).
827
144
  ncum = 0
828
143280
  coef_convective(:) = 0.
829
143280
  DO i = 1, len
830
143280
    IF (iflag1(i)==0) THEN
831
68966
      coef_convective(i) = 1.
832
68966
      ncum = ncum + 1
833
68966
      idcum(ncum) = i
834
    END IF
835
  END DO
836
837
! print*,'len, ncum = ',len,ncum
838
839
144
  IF (ncum>0) THEN
840
841
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
842
! --- COMPRESS THE FIELDS
843
!       (-> vectorization over convective gridpoints)
844
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
845
846
144
    IF (iflag_con==3) THEN
847
! print*,'ncum tv1 ',ncum,tv1
848
! print*,'tvp1 ',tvp1
849
!jyg<
850
!   If the fraction of convective points is larger than comp_threshold, then compression
851
!   is assumed useless.
852
!
853
144
  compress = ncum .lt. len*comp_threshold
854
!
855
144
  IF (.not. compress) THEN
856
    DO i = 1,len
857
      idcum(i) = i
858
    ENDDO
859
  ENDIF
860
!
861
!>jyg
862
144
        if (prt_level >= 9) &
863
             PRINT *, 'cva_driver -> cv3a_compress'
864
      CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
865
                         iflag1, nk1, icb1, icbs1, &
866
                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
867
                         wghti1, pbase1, buoybase1, &
868
                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
869
                         u1, v1, gz1, th1, th1_wake, &
870
                         tra1, &
871
                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
872
                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
873
                         sig1, w01, ptop21, &
874
                         Ale1, Alp1, omega1, &
875
                         iflag, nk, icb, icbs, &
876
                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
877
                         wghti, pbase, buoybase, &
878
                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
879
                         u, v, gz, th, th_wake, &
880
                         tra, &
881
                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
882
                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
883
                         sig, w0, ptop2, &
884
144
                         Ale, Alp, omega)
885
886
! print*,'tv ',tv
887
! print*,'tvp ',tvp
888
889
    END IF
890
891
144
    IF (iflag_con==4) THEN
892
        if (prt_level >= 9) &
893
             PRINT *, 'cva_driver -> cv_compress'
894
      CALL cv_compress(len, nloc, ncum, nd, &
895
                       iflag1, nk1, icb1, &
896
                       cbmf1, plcl1, tnk1, qnk1, gznk1, &
897
                       t1, q1, qs1, u1, v1, gz1, &
898
                       h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
899
                       iflag, nk, icb, &
900
                       cbmf, plcl, tnk, qnk, gznk, &
901
                       t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
902
                       dph)
903
    END IF
904
905
! -------------------------------------------------------------------
906
! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
907
! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
908
! ---   &
909
! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
910
! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
911
! ---   &
912
! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
913
! -------------------------------------------------------------------
914
915
144
    IF (iflag_con==3) THEN
916
144
        if (prt_level >= 9) &
917
             PRINT *, 'cva_driver -> cv3_undilute2'
918
      CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &        !na->nd
919
                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
920
                         p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
921
                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
922
144
                         frac_a, frac_s, qpreca, qta)                        !!jygprl
923
    END IF
924
925
144
    IF (iflag_con==4) THEN
926
        if (prt_level >= 9) &
927
             PRINT *, 'cva_driver -> cv_undilute2'
928
      CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
929
                        tnk, qnk, gznk, t, q, qs, gz, &
930
                        p, dph, h, tv, lv, &
931
                        inb, inbis, tp, tvp, clw, hp, ep, sigp, frac_s)
932
    END IF
933
934
    ! epmax_cape
935
    ! on recalcule ep et hp
936
144
        if (prt_level >= 9) &
937
             PRINT *, 'cva_driver -> cv3_epmax_cape'
938
    call cv3_epmax_fn_cape(nloc,ncum,nd &
939
                , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac_s &
940
                , pbase, p, ph, tv, buoy, sig, w0,iflag &
941
144
                , epmax_diag)
942
943
! -------------------------------------------------------------------
944
! --- MIXING(1)   (if iflag_mix .ge. 1)
945
! -------------------------------------------------------------------
946
144
    IF (iflag_con==3) THEN
947
!      IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
948
!        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
949
!          '. Might as well stop here.'
950
!        STOP
951
!      END IF
952
144
      IF (iflag_mix>=1) THEN
953
144
        CALL zilch(supmax, nloc*nd)
954
144
        if (prt_level >= 9) &
955
             PRINT *, 'cva_driver -> cv3p_mixing'
956
        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
957
!!                         ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
958
                         ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, &      !!jygprl
959
                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
960
                         ment, qent, hent, uent, vent, nent, &
961
144
                         sigij, elij, supmax, ments, qents, traent)
962
! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
963
964
      ELSE
965
        CALL zilch(supmax, nloc*nd)
966
      END IF
967
    END IF
968
! -------------------------------------------------------------------
969
! --- CLOSURE
970
! -------------------------------------------------------------------
971
972
973
144
    IF (iflag_con==3) THEN
974
144
      IF (iflag_clos==0) THEN
975
        if (prt_level >= 9) &
976
             PRINT *, 'cva_driver -> cv3_closure'
977
        CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
978
                         pbase, p, ph, tv, buoy, &
979
                         sig, w0, cape, m, iflag)
980
      END IF   ! iflag_clos==0
981
982
144
      ok_inhib = iflag_mix == 2
983
984
144
      IF (iflag_clos==1) THEN
985
        PRINT *, ' pas d appel cv3p_closure'
986
! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              ! na->nd
987
! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
988
! c    :                       ,supmax
989
! c    o                       ,sig,w0,ptop2,cape,cin,m)
990
      END IF   ! iflag_clos==1
991
992
144
      IF (iflag_clos==2) THEN
993
144
        if (prt_level >= 9) &
994
             PRINT *, 'cva_driver -> cv3p1_closure'
995
        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
996
                           pbase, plcl, p, ph, tv, tvp, buoy, &
997
                           supmax, ok_inhib, Ale, Alp, omega, &
998
                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
999
                           Plim1, plim2, asupmax, supmax0, &
1000
144
                           asupmaxmin, cbmf, plfc, wbeff)
1001
144
        if (prt_level >= 10) &
1002
             PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1003
      END IF   ! iflag_clos==2
1004
1005
144
      IF (iflag_clos==3) THEN
1006
        if (prt_level >= 9) &
1007
             PRINT *, 'cva_driver -> cv3p2_closure'
1008
        CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
1009
                           pbase, plcl, p, ph, tv, tvp, buoy, &
1010
                           supmax, ok_inhib, Ale, Alp, omega, &
1011
                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1012
                           Plim1, plim2, asupmax, supmax0, &
1013
                           asupmaxmin, cbmf, plfc, wbeff)
1014
        if (prt_level >= 10) &
1015
             PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1016
      END IF   ! iflag_clos==3
1017
    END IF ! iflag_con==3
1018
1019
144
    IF (iflag_con==4) THEN
1020
        if (prt_level >= 9) &
1021
             PRINT *, 'cva_driver -> cv_closure'
1022
      CALL cv_closure(nloc, ncum, nd, nk, icb, &
1023
                         tv, tvp, p, ph, dph, plcl, cpn, &
1024
                         iflag, cbmf)
1025
    END IF
1026
1027
! print *,'cv_closure-> cape ',cape(1)
1028
1029
! -------------------------------------------------------------------
1030
! --- MIXING(2)
1031
! -------------------------------------------------------------------
1032
1033
144
    IF (iflag_con==3) THEN
1034
144
      IF (iflag_mix==0) THEN
1035
        if (prt_level >= 9) &
1036
             PRINT *, 'cva_driver -> cv3_mixing'
1037
        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
1038
                        ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, &
1039
                        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
1040
                        ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
1041
        CALL zilch(hent, nloc*nd*nd)
1042
      ELSE
1043
!!jyg:  Essais absurde pour voir
1044
!!        mm(:,1) = 0.
1045
!!        DO  i = 2,nd
1046
!!          mm(:,i) = m(:,i)*(1.-qta(:,i-1))
1047
!!        ENDDO
1048

5588064
        mm(:,:) = m(:,:)
1049
144
        CALL cv3_mixscale(nloc, ncum, nd, ment, mm)
1050
144
        IF (debut) THEN
1051
1
          PRINT *, ' cv3_mixscale-> '
1052
        END IF !(debut) THEN
1053
      END IF
1054
    END IF
1055
1056
144
    IF (iflag_con==4) THEN
1057
        if (prt_level >= 9) &
1058
             PRINT *, 'cva_driver -> cv_mixing'
1059
      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
1060
                     ph, t, q, qs, u, v, h, lv, qnk, &
1061
                     hp, tv, tvp, ep, clw, cbmf, &
1062
                     m, ment, qent, uent, vent, nent, sigij, elij)
1063
    END IF
1064
1065
144
    IF (debut) THEN
1066
1
      PRINT *, ' cv_mixing ->'
1067
    END IF !(debut) THEN
1068
! do i = 1,nd
1069
! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
1070
! enddo
1071
1072
! -------------------------------------------------------------------
1073
! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1074
! -------------------------------------------------------------------
1075
144
    IF (iflag_con==3) THEN
1076
144
      IF (debut) THEN
1077
1
        PRINT *, ' cva_driver -> cv3_unsat '
1078
      END IF !(debut) THEN
1079
1080
144
        if (prt_level >= 9) &
1081
             PRINT *, 'cva_driver -> cv3_unsat'
1082
      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
1083
                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
1084
                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
1085
                     ep, sigp, clw, frac_s, qpreca, frac_a, qta, &                    !!jygprl
1086
                     m, ment, elij, delt, plcl, coef_clos, &
1087
                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
1088
                     faci, b, sigd, &
1089
!!                     wdtrainA, wdtrainM)                                       ! RomP
1090
144
                     wdtrainA, wdtrainS, wdtrainM)                               !!jygprl
1091
!
1092
144
      IF (prt_level >= 10) THEN
1093
        Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
1094
        DO k = 1,nd
1095
        write (6, '(i4,5(1x,e13.6))'), &
1096
          k, mp(igout,k), water(igout,k), ice(igout,k), &
1097
           evap(igout,k), fondue(igout,k)
1098
        ENDDO
1099
        Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM '     !!jygprl
1100
        DO k = 1,nd
1101
        write (6, '(i4,3(1x,e13.6))'), &
1102
           k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k)            !!jygprl
1103
        ENDDO
1104
      ENDIF
1105
!
1106
    END IF  !(iflag_con==3)
1107
1108
144
    IF (iflag_con==4) THEN
1109
        if (prt_level >= 9) &
1110
             PRINT *, 'cva_driver -> cv_unsat'
1111
      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1112
                     h, lv, ep, sigp, clw, m, ment, elij, &
1113
                     iflag, mp, qp, up, vp, wt, water, evap)
1114
    END IF
1115
1116
144
    IF (debut) THEN
1117
1
      PRINT *, 'cv_unsat-> '
1118
    END IF !(debut) THEN
1119
1120
! print *,'cv_unsat-> mp ',mp
1121
! print *,'cv_unsat-> water ',water
1122
! -------------------------------------------------------------------
1123
! --- YIELD
1124
! (tendencies, precipitation, variables of interface with other
1125
! processes, etc)
1126
! -------------------------------------------------------------------
1127
1128
144
    IF (iflag_con==3) THEN
1129
1130
144
        if (prt_level >= 9) &
1131
             PRINT *, 'cva_driver -> cv3_yield'
1132
      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
1133
                     icb, inb, delt, &
1134
                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
1135
                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1136
                     ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, &
1137
                     wt, water, ice, evap, fondue, faci, b, sigd, &
1138
                     ment, qent, hent, iflag_mix, uent, vent, &
1139
                     nent, elij, traent, sig, &
1140
                     tv, tvp, wghti, &
1141
                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &      ! jyg
1142
                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
1143
!!                     tls, tps, &                            ! useless . jyg
1144
                     qcondc, wd, &
1145
!!                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1146
144
                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv)         !!jygprl
1147
!
1148
!         Test conseravtion de l'eau
1149
!
1150
144
      IF (debut) THEN
1151
1
        PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
1152
      END IF !(debut) THEN
1153
!
1154
144
      IF (prt_level >= 10) THEN
1155
        Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
1156
                    ft(igout,1), ftd(igout,1)
1157
        Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
1158
                    fq(igout,1), fqd(igout,1)
1159
      ENDIF
1160
!
1161
    END IF
1162
1163
144
    IF (iflag_con==4) THEN
1164
        if (prt_level >= 9) &
1165
             PRINT *, 'cva_driver -> cv_yield'
1166
      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1167
                     t, q, u, v, &
1168
                     gz, p, ph, h, hp, lv, cpn, &
1169
                     ep, clw, frac_s, m, mp, qp, up, vp, &
1170
                     wt, water, evap, &
1171
                     ment, qent, uent, vent, nent, elij, &
1172
                     tv, tvp, &
1173
                     iflag, wd, qprime, tprime, &
1174
                     precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1175
    END IF
1176
1177
!AC!
1178
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1179
!--- passive tracers
1180
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1181
1182
144
    IF (iflag_con==3) THEN
1183
!RomP >>>
1184
144
        if (prt_level >= 9) &
1185
             PRINT *, 'cva_driver -> cv3_tracer'
1186
      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1187
                     ment, sigij, da, phi, phi2, d1a, dam, &
1188
                     ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1189
144
                     icb, inb)
1190
!RomP <<<
1191
    END IF
1192
1193
!AC!
1194
1195
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1196
! --- UNCOMPRESS THE FIELDS
1197
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1198
1199
1200
144
    IF (iflag_con==3) THEN
1201
144
        if (prt_level >= 9) &
1202
             PRINT *, 'cva_driver -> cv3a_uncompress'
1203
      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1204
                           iflag, icb, inb, &
1205
                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1206
                           ft, fq, fu, fv, ftra, &
1207
                           sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1208
                           qcondc, wd, cape, cin, &
1209
                           tvp, &
1210
                           ftd, fqd, &
1211
                           Plim1, plim2, asupmax, supmax0, &
1212
                           asupmaxmin, &
1213
                           da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
1214
                           qta, clw, elij, evap, ep, epmlmMm, eplaMm, &  ! RomP
1215
                           wdtrainA, wdtrainS, wdtrainM, &                         ! RomP
1216
                           qtc, sigt, epmax_diag, & ! epmax_cape
1217
                           iflag1, kbas1, ktop1, &
1218
                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1219
                           ft1, fq1, fu1, fv1, ftra1, &
1220
                           sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1221
                           qcondc1, wd1, cape1, cin1, &
1222
                           tvp1, &
1223
                           ftd1, fqd1, &
1224
                           Plim11, plim21, asupmax1, supmax01, &
1225
                           asupmaxmin1, &
1226
                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  &       ! RomP
1227
                           qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1228
                           wdtrainA1, wdtrainS1, wdtrainM1,                  & ! RomP
1229
144
                           qtc1, sigt1, epmax_diag1) ! epmax_cape
1230
!
1231
144
      IF (prt_level >= 10) THEN
1232
        Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
1233
                    ft1(igout,1), ftd1(igout,1)
1234
        Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
1235
                    fq1(igout,1), fqd1(igout,1)
1236
      ENDIF
1237
!
1238
    END IF
1239
1240
144
    IF (iflag_con==4) THEN
1241
        if (prt_level >= 9) &
1242
             PRINT *, 'cva_driver -> cv_uncompress'
1243
      CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1244
                           iflag, &
1245
                           precip, cbmf, &
1246
                           ft, fq, fu, fv, &
1247
                           ma, qcondc, &
1248
                           iflag1, &
1249
                           precip1,cbmf1, &
1250
                           ft1, fq1, fu1, fv1, &
1251
                           ma1, qcondc1)
1252
    END IF
1253
1254
  END IF ! ncum>0
1255
!
1256
!
1257
143280
  DO i = 1,len
1258
143280
    IF (iflag1(i) == 14) THEN
1259
45992
      Cin1(i) = Cin_noconv
1260
45992
      Cape1(i) = Cape_noconv
1261
    ENDIF
1262
  ENDDO
1263
1264
!
1265
! In order take into account the possibility of changing the compression,
1266
! reset m, sig and w0 to zero for non-convective points.
1267
5616
  DO k = 1,nd-1
1268
5444640
        sig1(:, k) = sig1(:, k)*coef_convective(:)
1269
5444784
        w01(:, k)  = w01(:, k)*coef_convective(:)
1270
  ENDDO
1271
1272
144
  IF (debut) THEN
1273
1
    PRINT *, ' cv_uncompress -> '
1274
1
    debut = .FALSE.
1275
  END IF  !(debut) THEN
1276
1277
1278
144
  RETURN
1279
END SUBROUTINE cva_driver