source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/cv_driver.F90

Last change on this file was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

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