GCC Code Coverage Report


Directory: ./
File: phys/cv_driver.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 32 209 15.3%
Branches: 1 228 0.4%

Line Branch Exec Source
1
2 ! $Header$
3
4 ✗ SUBROUTINE cv_driver(len, nd, ndp1, ntra, iflag_con, t1, q1, qs1, u1, v1, &
5 ✗ tra1, p1, ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, vprecip1, &
6 ✗ cbmf1, sig1, w01, icb1, inb1, delt, ma1, upwd1, dnwd1, dnwd01, qcondc1, &
7 ✗ wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, clw1, elij1, & !
8 ! RomP
9 evap1, ep1, epmlmmm1, eplamm1, & ! RomP
10 wdtraina1, wdtrainm1, & ! RomP
11 epmax_diag1) ! epmax_cape
12
13 USE dimphy
14 IMPLICIT NONE
15
16 ! .............................START PROLOGUE............................
17
18
19 ! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
20 ! "1" appended.
21 ! The "1" is removed for the corresponding compressed (local) variables.
22
23 ! PARAMETERS:
24 ! Name Type Usage Description
25 ! ---------- ---------- ------- ----------------------------
26
27 ! len Integer Input first (i) dimension
28 ! nd Integer Input vertical (k) dimension
29 ! ndp1 Integer Input nd + 1
30 ! ntra Integer Input number of tracors
31 ! iflag_con Integer Input version of convect (3/4)
32 ! t1 Real Input temperature
33 ! q1 Real Input specific hum
34 ! qs1 Real Input sat specific hum
35 ! u1 Real Input u-wind
36 ! v1 Real Input v-wind
37 ! tra1 Real Input tracors
38 ! p1 Real Input full level pressure
39 ! ph1 Real Input half level pressure
40 ! iflag1 Integer Output flag for Emanuel conditions
41 ! ft1 Real Output temp tend
42 ! fq1 Real Output spec hum tend
43 ! fu1 Real Output u-wind tend
44 ! fv1 Real Output v-wind tend
45 ! ftra1 Real Output tracor tend
46 ! precip1 Real Output precipitation
47 ! VPrecip1 Real Output vertical profile of
48 ! precipitations
49 ! cbmf1 Real Output cloud base mass flux
50 ! sig1 Real In/Out section adiabatic updraft
51 ! w01 Real In/Out vertical velocity within adiab
52 ! updraft
53 ! delt Real Input time step
54 ! Ma1 Real Output mass flux adiabatic updraft
55 ! upwd1 Real Output total upward mass flux
56 ! (adiab+mixed)
57 ! dnwd1 Real Output saturated downward mass flux
58 ! (mixed)
59 ! dnwd01 Real Output unsaturated downward mass flux
60 ! qcondc1 Real Output in-cld mixing ratio of
61 ! condensed water
62 ! wd1 Real Output downdraft velocity scale for
63 ! sfc fluxes
64 ! cape1 Real Output CAPE
65
66 ! wdtrainA1 Real Output precipitation detrained from
67 ! adiabatic draught;
68 ! used in tracer transport (cvltr)
69 ! wdtrainM1 Real Output precipitation detrained from mixed
70 ! draughts;
71 ! used in tracer transport (cvltr)
72 ! da1 Real Output used in tracer transport (cvltr)
73 ! phi1 Real Output used in tracer transport (cvltr)
74 ! mp1 Real Output used in tracer transport (cvltr)
75
76 ! phi21 Real Output used in tracer transport (cvltr)
77
78 ! d1a1 Real Output used in tracer transport (cvltr)
79 ! dam1 Real Output used in tracer transport (cvltr)
80
81 ! evap1 Real Output
82 ! ep1 Real Output
83 ! sij1 Real Output
84 ! elij1 Real Output
85
86 ! S. Bony, Mar 2002:
87 ! * Several modules corresponding to different physical processes
88 ! * Several versions of convect may be used:
89 ! - iflag_con=3: version lmd (previously named convect3)
90 ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
91 ! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
92 ! S. Bony, Oct 2002:
93 ! * Vectorization of convect3 (ie version lmd)
94
95 ! ..............................END PROLOGUE.............................
96
97
98 ! Input
99 INTEGER len
100 INTEGER nd
101 INTEGER ndp1
102 INTEGER noff
103 INTEGER iflag_con
104 INTEGER ntra
105 REAL delt
106 REAL t1(len, nd)
107 REAL q1(len, nd)
108 REAL qs1(len, nd)
109 REAL u1(len, nd)
110 REAL v1(len, nd)
111 REAL tra1(len, nd, ntra)
112 REAL p1(len, nd)
113 REAL ph1(len, ndp1)
114
115 ! Output
116 INTEGER iflag1(len)
117 REAL ft1(len, nd)
118 REAL fq1(len, nd)
119 REAL fu1(len, nd)
120 REAL fv1(len, nd)
121 REAL ftra1(len, nd, ntra)
122 REAL precip1(len)
123 REAL cbmf1(len)
124 REAL sig1(klon, klev)
125 REAL w01(klon, klev)
126 REAL vprecip1(len, nd+1)
127 REAL evap1(len, nd) !RomP
128 REAL ep1(len, nd) !RomP
129 REAL ma1(len, nd)
130 REAL upwd1(len, nd)
131 REAL dnwd1(len, nd)
132 REAL dnwd01(len, nd)
133
134 REAL qcondc1(len, nd) ! cld
135 REAL wd1(len) ! gust
136 REAL cape1(len)
137
138 ! RomP >>>
139 REAL wdtraina1(len, nd), wdtrainm1(len, nd)
140 REAL sij1(len, nd, nd), elij1(len, nd, nd)
141 REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
142
143 REAL phi21(len, nd, nd)
144 REAL d1a1(len, nd), dam1(len, nd)
145 REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
146 ! RomP <<<
147 REAL epmax_diag1 (len) ! epmax_cape
148
149 ! -------------------------------------------------------------------
150 ! Original Prologue by Kerry Emanuel.
151 ! -------------------------------------------------------------------
152 ! --- ARGUMENTS
153 ! -------------------------------------------------------------------
154 ! --- On input:
155
156 ! t: Array of absolute temperature (K) of dimension ND, with first
157 ! index corresponding to lowest model level. Note that this array
158 ! will be altered by the subroutine if dry convective adjustment
159 ! occurs and if IPBL is not equal to 0.
160
161 ! q: Array of specific humidity (gm/gm) of dimension ND, with first
162 ! index corresponding to lowest model level. Must be defined
163 ! at same grid levels as T. Note that this array will be altered
164 ! if dry convective adjustment occurs and if IPBL is not equal to 0.
165
166 ! qs: Array of saturation specific humidity of dimension ND, with first
167 ! index corresponding to lowest model level. Must be defined
168 ! at same grid levels as T. Note that this array will be altered
169 ! if dry convective adjustment occurs and if IPBL is not equal to 0.
170
171 ! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
172 ! index corresponding with the lowest model level. Defined at
173 ! same levels as T. Note that this array will be altered if
174 ! dry convective adjustment occurs and if IPBL is not equal to 0.
175
176 ! v: Same as u but for meridional velocity.
177
178 ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
179 ! where NTRA is the number of different tracers. If no
180 ! convective tracer transport is needed, define a dummy
181 ! input array of dimension (ND,1). Tracers are defined at
182 ! same vertical levels as T. Note that this array will be altered
183 ! if dry convective adjustment occurs and if IPBL is not equal to 0.
184
185 ! p: Array of pressure (mb) of dimension ND, with first
186 ! index corresponding to lowest model level. Must be defined
187 ! at same grid levels as T.
188
189 ! ph: Array of pressure (mb) of dimension ND+1, with first index
190 ! corresponding to lowest level. These pressures are defined at
191 ! levels intermediate between those of P, T, Q and QS. The first
192 ! value of PH should be greater than (i.e. at a lower level than)
193 ! the first value of the array P.
194
195 ! nl: The maximum number of levels to which convection can penetrate, plus
196 ! 1.
197 ! NL MUST be less than or equal to ND-1.
198
199 ! delt: The model time step (sec) between calls to CONVECT
200
201 ! ----------------------------------------------------------------------------
202 ! --- On Output:
203
204 ! iflag: An output integer whose value denotes the following:
205 ! VALUE INTERPRETATION
206 ! ----- --------------
207 ! 0 Moist convection occurs.
208 ! 1 Moist convection occurs, but a CFL condition
209 ! on the subsidence warming is violated. This
210 ! does not cause the scheme to terminate.
211 ! 2 Moist convection, but no precip because ep(inb) lt 0.0001
212 ! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
213 ! 4 No moist convection; atmosphere is not
214 ! unstable
215 ! 6 No moist convection because ihmin le minorig.
216 ! 7 No moist convection because unreasonable
217 ! parcel level temperature or specific humidity.
218 ! 8 No moist convection: lifted condensation
219 ! level is above the 200 mb level.
220 ! 9 No moist convection: cloud base is higher
221 ! then the level NL-1.
222
223 ! ft: Array of temperature tendency (K/s) of dimension ND, defined at
224 ! same
225 ! grid levels as T, Q, QS and P.
226
227 ! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
228 ! defined at same grid levels as T, Q, QS and P.
229
230 ! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
231 ! defined at same grid levels as T.
232
233 ! fv: Same as FU, but for forcing of meridional velocity.
234
235 ! ftra: Array of forcing of tracer content, in tracer mixing ratio per
236 ! second, defined at same levels as T. Dimensioned (ND,NTRA).
237
238 ! precip: Scalar convective precipitation rate (mm/day).
239
240 ! VPrecip: Vertical profile of convective precipitation (kg/m2/s).
241
242 ! wd: A convective downdraft velocity scale. For use in surface
243 ! flux parameterizations. See convect.ps file for details.
244
245 ! tprime: A convective downdraft temperature perturbation scale (K).
246 ! For use in surface flux parameterizations. See convect.ps
247 ! file for details.
248
249 ! qprime: A convective downdraft specific humidity
250 ! perturbation scale (gm/gm).
251 ! For use in surface flux parameterizations. See convect.ps
252 ! file for details.
253
254 ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
255 ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
256 ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
257 ! by the calling program between calls to CONVECT.
258
259 ! det: Array of detrainment mass flux of dimension ND.
260
261 ! -------------------------------------------------------------------
262
263 ! Local arrays
264
265
266 INTEGER i, k, n, il, j
267 INTEGER icbmax
268 ✗ INTEGER nk1(klon)
269 INTEGER icb1(klon)
270 INTEGER inb1(klon)
271 ✗ INTEGER icbs1(klon)
272
273 ✗ REAL plcl1(klon)
274 ✗ REAL tnk1(klon)
275 ✗ REAL qnk1(klon)
276 ✗ REAL gznk1(klon)
277 REAL pnk1(klon)
278 REAL qsnk1(klon)
279 ✗ REAL pbase1(klon)
280 ✗ REAL buoybase1(klon)
281
282 ✗ REAL lv1(klon, klev)
283 ✗ REAL cpn1(klon, klev)
284 ✗ REAL tv1(klon, klev)
285 ✗ REAL gz1(klon, klev)
286 ✗ REAL hm1(klon, klev)
287 ✗ REAL h1(klon, klev)
288 ✗ REAL tp1(klon, klev)
289 ✗ REAL tvp1(klon, klev)
290 REAL clw1(klon, klev)
291 ✗ REAL th1(klon, klev)
292
293 INTEGER ncum
294
295 ! (local) compressed fields:
296
297 ! ym integer nloc
298 ! ym parameter (nloc=klon) ! pour l'instant
299 ✗ INTEGER idcum(klon)
300 ✗ INTEGER iflag(klon), nk(klon), icb(klon)
301 ✗ INTEGER nent(klon, klev)
302 ✗ INTEGER icbs(klon)
303 ✗ INTEGER inb(klon), inbis(klon)
304
305 ✗ REAL cbmf(klon), plcl(klon), tnk(klon), qnk(klon), gznk(klon)
306 ✗ REAL t(klon, klev), q(klon, klev), qs(klon, klev)
307 ✗ REAL u(klon, klev), v(klon, klev)
308 ✗ REAL gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)
309 ✗ REAL p(klon, klev), ph(klon, klev+1), tv(klon, klev), tp(klon, klev)
310 ✗ REAL clw(klon, klev)
311 ✗ REAL dph(klon, klev)
312 ✗ REAL pbase(klon), buoybase(klon), th(klon, klev)
313 ✗ REAL tvp(klon, klev)
314 ✗ REAL sig(klon, klev), w0(klon, klev)
315 ✗ REAL hp(klon, klev), ep(klon, klev), sigp(klon, klev)
316 ✗ REAL frac(klon), buoy(klon, klev)
317 ✗ REAL cape(klon)
318 ✗ REAL m(klon, klev), ment(klon, klev, klev), qent(klon, klev, klev)
319 ✗ REAL uent(klon, klev, klev), vent(klon, klev, klev)
320 ✗ REAL ments(klon, klev, klev), qents(klon, klev, klev)
321 ✗ REAL sij(klon, klev, klev), elij(klon, klev, klev)
322 ✗ REAL qp(klon, klev), up(klon, klev), vp(klon, klev)
323 ✗ REAL wt(klon, klev), water(klon, klev), evap(klon, klev)
324 ✗ REAL b(klon, klev), ft(klon, klev), fq(klon, klev)
325 ✗ REAL fu(klon, klev), fv(klon, klev)
326 ✗ REAL upwd(klon, klev), dnwd(klon, klev), dnwd0(klon, klev)
327 ✗ REAL ma(klon, klev), mike(klon, klev), tls(klon, klev)
328 ✗ REAL tps(klon, klev), qprime(klon), tprime(klon)
329 ✗ REAL precip(klon)
330 ✗ REAL vprecip(klon, klev+1)
331 ✗ REAL tra(klon, klev, ntra), trap(klon, klev, ntra)
332 ✗ REAL ftra(klon, klev, ntra), traent(klon, klev, klev, ntra)
333 ✗ REAL qcondc(klon, klev) ! cld
334 ✗ REAL wd(klon) ! gust
335
336 ! RomP >>>
337 ✗ REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
338 ✗ REAL epmlmmm(klon, klev, klev), eplamm(klon, klev)
339 ✗ REAL phi2(klon, klev, klev)
340 ✗ REAL d1a(klon, klev), dam(klon, klev)
341 ✗ REAL wdtraina(klon, klev), wdtrainm(klon, klev)
342 REAL sigd(klon)
343 ! RomP <<<
344 ✗ REAL epmax_diag(klon) ! epmax_cape
345
346 ✗ nent(:, :) = 0
347 ! -------------------------------------------------------------------
348 ! --- SET CONSTANTS AND PARAMETERS
349 ! -------------------------------------------------------------------
350 ! print *, '-> cv_driver' !jyg
351 ! -- set simulation flags:
352 ! (common cvflag)
353
354 CALL cv_flag(0)
355
356 ! -- set thermodynamical constants:
357 ! (common cvthermo)
358
359 ✗ CALL cv_thermo(iflag_con)
360
361 ! -- set convect parameters
362
363 ! includes microphysical parameters and parameters that
364 ! control the rate of approach to quasi-equilibrium)
365 ! (common cvparam)
366
367
368 ✗ IF (iflag_con==30) THEN
369 ✗ CALL cv30_param(nd, delt)
370 END IF
371
372 ✗ IF (iflag_con==4) THEN
373 ✗ CALL cv_param(nd)
374 END IF
375
376 ! ---------------------------------------------------------------------
377 ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
378 ! ---------------------------------------------------------------------
379
380 ✗ inb(:) = 0.0
381 ✗ inb1(:) = 0.0
382 ✗ icb1(:) = 0.0
383
384 ✗ ft1(:, :) = 0.0
385 ✗ fq1(:, :) = 0.0
386 ✗ fu1(:, :) = 0.0
387 ✗ fv1(:, :) = 0.0
388 ✗ tvp1(:, :) = 0.0
389 ✗ tp1(:, :) = 0.0
390 ✗ clw1(:, :) = 0.0
391 ! ym
392 ✗ clw(:, :) = 0.0
393 ✗ gz1(:, :) = 0.
394 ✗ vprecip1(:, :) = 0.
395 ✗ ma1(:, :) = 0.0
396 ✗ upwd1(:, :) = 0.0
397 ✗ dnwd1(:, :) = 0.0
398 ✗ dnwd01(:, :) = 0.0
399 ✗ qcondc1(:, :) = 0.0
400
401 ✗ ftra1(:, :, :) = 0.0
402
403 ✗ elij1(:, :, :) = 0.0
404 ✗ sij1(:, :, :) = 0.0
405
406 ✗ precip1(:) = 0.0
407 ✗ iflag1(:) = 0
408 ✗ wd1(:) = 0.0
409 ✗ cape1(:) = 0.0
410 ✗ epmax_diag1(:) = 0.0 ! epmax_cape
411
412
413 ✗ IF (iflag_con==30) THEN
414 ✗ DO il = 1, len
415 ✗ sig1(il, nd) = sig1(il, nd) + 1.
416 ✗ sig1(il, nd) = amin1(sig1(il,nd), 12.1)
417 END DO
418 END IF
419
420 ! RomP >>>
421 ✗ wdtraina1(:, :) = 0.
422 ✗ wdtrainm1(:, :) = 0.
423 ✗ da1(:, :) = 0.
424 ✗ phi1(:, :, :) = 0.
425 ✗ epmlmmm1(:, :, :) = 0.
426 ✗ eplamm1(:, :) = 0.
427 ✗ mp1(:, :) = 0.
428 ✗ evap1(:, :) = 0.
429 ✗ ep1(:, :) = 0.
430 ✗ sij1(:, :, :) = 0.
431 ✗ elij1(:, :, :) = 0.
432 ✗ phi21(:, :, :) = 0.
433 ✗ d1a1(:, :) = 0.
434 ✗ dam1(:, :) = 0.
435 ! RomP <<<
436
437 ! --------------------------------------------------------------------
438 ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
439 ! --------------------------------------------------------------------
440
441 ✗ IF (iflag_con==30) THEN
442
443 ! print*,'Emanuel version 30 '
444 CALL cv30_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
445 ✗ , lv1, cpn1, tv1, gz1, h1, hm1, th1)
446 END IF
447
448 ✗ IF (iflag_con==4) THEN
449 CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
450 ✗ hm1)
451 END IF
452
453 ! --------------------------------------------------------------------
454 ! --- CONVECTIVE FEED
455 ! --------------------------------------------------------------------
456
457 ✗ IF (iflag_con==30) THEN
458 CALL cv30_feed(len, nd, t1, q1, qs1, p1, ph1, hm1, gz1 & !
459 ! nd->na
460 ✗ , nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
461 END IF
462
463 ✗ IF (iflag_con==4) THEN
464 CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
465 ✗ iflag1, tnk1, qnk1, gznk1, plcl1)
466 END IF
467
468 ! --------------------------------------------------------------------
469 ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
470 ! (up through ICB for convect4, up through ICB+1 for convect3)
471 ! Calculates the lifted parcel virtual temperature at nk, the
472 ! actual temperature, and the adiabatic liquid water content.
473 ! --------------------------------------------------------------------
474
475 ✗ IF (iflag_con==30) THEN
476 CALL cv30_undilute1(len, nd, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1 & ! nd->na
477 ✗ , tp1, tvp1, clw1, icbs1)
478 END IF
479
480 ✗ IF (iflag_con==4) THEN
481 CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
482 ✗ tvp1, clw1)
483 END IF
484
485 ! -------------------------------------------------------------------
486 ! --- TRIGGERING
487 ! -------------------------------------------------------------------
488
489 ✗ IF (iflag_con==30) THEN
490 CALL cv30_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1 & !
491 ! nd->na
492 ✗ , pbase1, buoybase1, iflag1, sig1, w01)
493 END IF
494
495 ✗ IF (iflag_con==4) THEN
496 ✗ CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
497 END IF
498
499 ! =====================================================================
500 ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
501 ! =====================================================================
502
503 ✗ ncum = 0
504 ✗ DO i = 1, len
505 ✗ IF (iflag1(i)==0) THEN
506 ✗ ncum = ncum + 1
507 ✗ idcum(ncum) = i
508 END IF
509 END DO
510
511 ! print*,'cv_driver : klon, ncum = ',len,ncum
512
513 ✗ IF (ncum>0) THEN
514
515 ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
516 ! --- COMPRESS THE FIELDS
517 ! (-> vectorization over convective gridpoints)
518 ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
519
520 ✗ IF (iflag_con==30) THEN
521 CALL cv30_compress(len, klon, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
522 plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, &
523 gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, &
524 w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, &
525 q, qs, u, v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, &
526 ✗ w0)
527 END IF
528
529 ✗ IF (iflag_con==4) THEN
530 CALL cv_compress(len, klon, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
531 tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
532 tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
533 ✗ q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
534 END IF
535
536 ! -------------------------------------------------------------------
537 ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
538 ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
539 ! --- &
540 ! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
541 ! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
542 ! --- &
543 ! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
544 ! -------------------------------------------------------------------
545
546 ✗ IF (iflag_con==30) THEN
547 CALL cv30_undilute2(klon, ncum, nd, icb, icbs, nk & !na->nd
548 , tnk, qnk, gznk, t, q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, &
549 ✗ inb, tp, tvp, clw, hp, ep, sigp, buoy)
550 END IF
551
552 ✗ IF (iflag_con==4) THEN
553 CALL cv_undilute2(klon, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
554 ✗ gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
555 END IF
556
557 ! -------------------------------------------------------------------
558 ! --- CLOSURE
559 ! -------------------------------------------------------------------
560
561 ✗ IF (iflag_con==30) THEN
562 CALL cv30_closure(klon, ncum, nd, icb, inb & ! na->nd
563 ✗ , pbase, p, ph, tv, buoy, sig, w0, cape, m)
564
565 ! epmax_cape
566 call cv30_epmax_fn_cape(klon,ncum,nd &
567 ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
568 ✗ ,epmax_diag)
569 ! on écrase ep et recalcule hp
570 END IF
571
572 ✗ IF (iflag_con==4) THEN
573 CALL cv_closure(klon, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
574 ✗ cpn, iflag, cbmf)
575 END IF
576
577
578 ! -------------------------------------------------------------------
579 ! --- MIXING
580 ! -------------------------------------------------------------------
581
582 ✗ IF (iflag_con==30) THEN
583 CALL cv30_mixing(klon, ncum, nd, nd, ntra, icb, nk, inb & !
584 ! na->nd
585 , ph, t, q, qs, u, v, tra, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, &
586 ✗ ment, qent, uent, vent, sij, elij, ments, qents, traent)
587 END IF
588
589 ✗ IF (iflag_con==4) THEN
590 CALL cv_mixing(klon, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
591 h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
592 ✗ nent, sij, elij)
593 END IF
594
595 ! -------------------------------------------------------------------
596 ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
597 ! -------------------------------------------------------------------
598
599 ✗ IF (iflag_con==30) THEN
600 ! RomP >>>
601 CALL cv30_unsat(klon, ncum, nd, nd, ntra, icb, inb & ! na->nd
602 , t, q, qs, gz, u, v, tra, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, &
603 ment, elij, delt, plcl, mp, qp, up, vp, trap, wt, water, evap, b, &
604 ✗ wdtraina, wdtrainm)
605 ! RomP <<<
606 END IF
607
608 ✗ IF (iflag_con==4) THEN
609 CALL cv_unsat(klon, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
610 ✗ ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
611 END IF
612
613 ! -------------------------------------------------------------------
614 ! --- YIELD
615 ! (tendencies, precipitation, variables of interface with other
616 ! processes, etc)
617 ! -------------------------------------------------------------------
618
619 ✗ IF (iflag_con==30) THEN
620 CALL cv30_yield(klon, ncum, nd, nd, ntra & ! na->nd
621 , icb, inb, delt, t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th, ep, &
622 clw, m, tp, mp, qp, up, vp, trap, wt, water, evap, b, ment, qent, &
623 uent, vent, nent, elij, traent, sig, tv, tvp, iflag, precip, vprecip, &
624 ft, fq, fu, fv, ftra, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, &
625 ✗ wd)
626 END IF
627
628 ✗ IF (iflag_con==4) THEN
629 CALL cv_yield(klon, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
630 ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
631 evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
632 ✗ tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
633 END IF
634
635 ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
636 ! --- passive tracers
637 ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
638
639 ✗ IF (iflag_con==30) THEN
640 ! RomP >>>
641 CALL cv30_tracer(klon, len, ncum, nd, nd, ment, sij, da, phi, phi2, &
642 ✗ d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
643 ! RomP <<<
644 END IF
645
646 ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
647 ! --- UNCOMPRESS THE FIELDS
648 ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
649 ! set iflag1 =42 for non convective points
650 ✗ DO i = 1, len
651 ✗ iflag1(i) = 42
652 END DO
653
654 ✗ IF (iflag_con==30) THEN
655 CALL cv30_uncompress(klon, len, ncum, nd, ntra, idcum, iflag, precip, &
656 vprecip, evap, ep, sig, w0 & !RomP
657 , ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
658 da, phi, mp, phi2, d1a, dam, sij & !RomP
659 , elij, clw, epmlmmm, eplamm & !RomP
660 , wdtraina, wdtrainm,epmax_diag & !RomP
661 , iflag1, precip1, vprecip1, evap1, ep1, sig1, w01 & !RomP
662 , ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, dnwd01, &
663 qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1 & !RomP
664 , elij1, clw1, epmlmmm1, eplamm1 & !RomP
665 ✗ , wdtraina1, wdtrainm1,epmax_diag1) !RomP
666 END IF
667
668 ✗ IF (iflag_con==4) THEN
669 CALL cv_uncompress(klon, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
670 fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
671 ✗ ma1, qcondc1)
672 END IF
673
674 END IF ! ncum>0
675
676 ! print *, 'fin cv_driver ->' !jyg
677 ✗ RETURN
678 END SUBROUTINE cv_driver
679
680 ! ==================================================================
681 240 SUBROUTINE cv_flag(iflag_ice_thermo)
682
683 USE ioipsl_getin_p_mod, ONLY : getin_p
684
685 IMPLICIT NONE
686
687 ! Argument : iflag_ice_thermo : ice thermodynamics is taken into account if
688 ! iflag_ice_thermo >=1
689 INTEGER iflag_ice_thermo
690
691 include "cvflag.h"
692
693 ! -- si .TRUE., on rend la gravite plus explicite et eventuellement
694 ! differente de 10.0 dans convect3:
695 240 cvflag_grav = .TRUE.
696 240 cvflag_ice = iflag_ice_thermo >= 1
697 !
698 ! si icvflag_Tpa=0, alors la fraction de glace dans l'ascendance adiabatique est
699 ! fonction de la temperature de l'environnement et la temperature de l'ascendance est
700 ! calculee en deux it�rations, une en supposant qu'il n'y a pas de glace et l'autre
701 ! en ajoutant la glace (ancien sch�ma d'Arnaud Jam).
702 ! si icvflag_Tpa=1, alors la fraction de glace dans l'ascendance adiabatique est
703 ! fonction de la temperature de l'environnement et la temperature de l'ascendance est
704 ! calculee en une seule iteration.
705 ! si icvflag_Tpa=2, alors la fraction de glace dans l'ascendance adiabatique est
706 ! fonction de la temperature de l'ascendance et la temperature de l'ascendance est
707 ! calculee en une seule iteration.
708 240 icvflag_Tpa=0
709 240 call getin_p('icvflag_Tpa', icvflag_Tpa)
710
711 240 RETURN
712 END SUBROUTINE cv_flag
713
714 ! ==================================================================
715 720 SUBROUTINE cv_thermo(iflag_con)
716 IMPLICIT NONE
717
718 ! -------------------------------------------------------------
719 ! Set thermodynamical constants for convectL
720 ! -------------------------------------------------------------
721
722 include "YOMCST.h"
723 include "cvthermo.h"
724
725 INTEGER iflag_con
726
727
728 ! original set from convect:
729
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 240 times.
240 IF (iflag_con==4) THEN
730 ✗ cpd = 1005.7
731 ✗ cpv = 1870.0
732 ✗ cl = 4190.0
733 ✗ rrv = 461.5
734 ✗ rrd = 287.04
735 ✗ lv0 = 2.501E6
736 ✗ g = 9.8
737 ✗ t0 = 273.15
738 ✗ grav = g
739 ELSE
740
741 ! constants consistent with LMDZ:
742 240 cpd = rcpd
743 240 cpv = rcpv
744 240 cl = rcw
745 240 ci = rcs
746 240 rrv = rv
747 240 rrd = rd
748 240 lv0 = rlvtt
749 240 lf0 = rlstt - rlvtt
750 240 g = rg ! not used in convect3
751 ! ori t0 = RTT
752 240 t0 = 273.15 ! convect3 (RTT=273.16)
753 ! maf grav= 10. ! implicitely or explicitely used in convect3
754 240 grav = g ! implicitely or explicitely used in convect3
755 END IF
756
757 240 rowl = 1000.0 !(a quelle variable de YOMCST cela correspond-il?)
758
759 240 clmcpv = cl - cpv
760 240 clmcpd = cl - cpd
761 240 clmci = cl - ci
762 240 cpdmcp = cpd - cpv
763 240 cpvmcpd = cpv - cpd
764 240 cpvmcl = cl - cpv ! for convect3
765 240 eps = rrd/rrv
766 240 epsi = 1.0/eps
767 240 epsim1 = epsi - 1.0
768 ! ginv=1.0/g
769 240 ginv = 1.0/grav
770 240 hrd = 0.5*rrd
771
772 240 RETURN
773 END SUBROUTINE cv_thermo
774