source: LMDZ6/trunk/libf/phylmd/cv_driver.F90 @ 5715

Last change on this file since 5715 was 5712, checked in by yann meurdesoif, 7 days ago

Convection GPU porting : Compression of active convection point is now optional (default remain to true). For GPU runs, convection is not compressed and is computed on each column. The update is done only for column where convection is active

YM

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