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

Last change on this file since 5306 was 5285, checked in by abarral, 3 days ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

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