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

Last change on this file since 5695 was 5692, checked in by yann meurdesoif, 6 weeks ago

Convection GPU porting : set convection subroutines into module

Files will be renamed later to *_mod.f90

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.5 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
350  nent(:, :) = 0
351  ! -------------------------------------------------------------------
352  ! --- SET CONSTANTS AND PARAMETERS
353  ! -------------------------------------------------------------------
354  ! print *, '-> cv_driver'      !jyg
355  ! -- set simulation flags:
356  ! (common cvflag)
357
358  CALL cv_flag(0)
359
360  ! -- set thermodynamical constants:
361  ! (common cvthermo)
362
363  CALL cv_thermo(iflag_con)
364
365  ! -- set convect parameters
366
367  ! includes microphysical parameters and parameters that
368  ! control the rate of approach to quasi-equilibrium)
369  ! (common cvparam)
370
371
372  IF (iflag_con==30) THEN
373    CALL cv30_param(nd, delt)
374  END IF
375
376  IF (iflag_con==4) THEN
377    CALL cv_param(nd)
378  END IF
379
380  ! ---------------------------------------------------------------------
381  ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
382  ! ---------------------------------------------------------------------
383
384  inb(:) = 0.0
385  inb1(:) = 0.0
386  icb1(:) = 0.0
387
388  ft1(:, :) = 0.0
389  fq1(:, :) = 0.0
390  fu1(:, :) = 0.0
391  fv1(:, :) = 0.0
392  tvp1(:, :) = 0.0
393  tp1(:, :) = 0.0
394  clw1(:, :) = 0.0
395  ! ym
396  clw(:, :) = 0.0
397  gz1(:, :) = 0.
398  vprecip1(:, :) = 0.
399  ma1(:, :) = 0.0
400  upwd1(:, :) = 0.0
401  dnwd1(:, :) = 0.0
402  dnwd01(:, :) = 0.0
403  qcondc1(:, :) = 0.0
404
405  ftra1(:, :, :) = 0.0
406
407  elij1(:, :, :) = 0.0
408  sij1(:, :, :) = 0.0
409
410  precip1(:) = 0.0
411  iflag1(:) = 0
412  wd1(:) = 0.0
413  cape1(:) = 0.0
414  epmax_diag1(:) = 0.0 ! epmax_cape
415
416
417  IF (iflag_con==30) THEN
418    DO il = 1, len
419      sig1(il, nd) = sig1(il, nd) + 1.
420      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
421    END DO
422  END IF
423
424  ! RomP >>>
425  wdtraina1(:, :) = 0.
426  wdtrainm1(:, :) = 0.
427  da1(:, :) = 0.
428  phi1(:, :, :) = 0.
429  epmlmmm1(:, :, :) = 0.
430  eplamm1(:, :) = 0.
431  mp1(:, :) = 0.
432  evap1(:, :) = 0.
433  ep1(:, :) = 0.
434  sij1(:, :, :) = 0.
435  elij1(:, :, :) = 0.
436  phi21(:, :, :) = 0.
437  d1a1(:, :) = 0.
438  dam1(:, :) = 0.
439  ! RomP <<<
440
441  ! --------------------------------------------------------------------
442  ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
443  ! --------------------------------------------------------------------
444
445  IF (iflag_con==30) THEN
446
447    ! print*,'Emanuel version 30 '
448    CALL cv30_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
449      , lv1, cpn1, tv1, gz1, h1, hm1, th1)
450  END IF
451
452  IF (iflag_con==4) THEN
453    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
454      hm1)
455  END IF
456
457  ! --------------------------------------------------------------------
458  ! --- CONVECTIVE FEED
459  ! --------------------------------------------------------------------
460
461  IF (iflag_con==30) THEN
462    CALL cv30_feed(len, nd, t1, q1, qs1, p1, ph1, hm1, gz1 & !
463                                                             ! nd->na
464      , nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
465  END IF
466
467  IF (iflag_con==4) THEN
468    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
469      iflag1, tnk1, qnk1, gznk1, plcl1)
470  END IF
471
472  ! --------------------------------------------------------------------
473  ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
474  ! (up through ICB for convect4, up through ICB+1 for convect3)
475  ! Calculates the lifted parcel virtual temperature at nk, the
476  ! actual temperature, and the adiabatic liquid water content.
477  ! --------------------------------------------------------------------
478
479  IF (iflag_con==30) THEN
480    CALL cv30_undilute1(len, nd, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1 & ! nd->na
481      , tp1, tvp1, clw1, icbs1)
482  END IF
483
484  IF (iflag_con==4) THEN
485    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
486      tvp1, clw1)
487  END IF
488
489  ! -------------------------------------------------------------------
490  ! --- TRIGGERING
491  ! -------------------------------------------------------------------
492
493  IF (iflag_con==30) THEN
494    CALL cv30_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1 & !
495                                                                 ! nd->na
496      , pbase1, buoybase1, iflag1, sig1, w01)
497  END IF
498
499  IF (iflag_con==4) THEN
500    CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
501  END IF
502
503  ! =====================================================================
504  ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
505  ! =====================================================================
506
507  ncum = 0
508  DO i = 1, len
509    IF (iflag1(i)==0) THEN
510      ncum = ncum + 1
511      idcum(ncum) = i
512    END IF
513  END DO
514
515  ! print*,'cv_driver : klon, ncum = ',len,ncum
516
517  IF (ncum>0) THEN
518
519    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
520    ! --- COMPRESS THE FIELDS
521    ! (-> vectorization over convective gridpoints)
522    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
523
524    IF (iflag_con==30) THEN
525      CALL cv30_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
526        plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, &
527        gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, &
528        w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, &
529        q, qs, u, v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, &
530        w0)
531    END IF
532
533    IF (iflag_con==4) THEN
534      CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
535        tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
536        tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
537        q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
538    END IF
539
540    ! -------------------------------------------------------------------
541    ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
542    ! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
543    ! ---   &
544    ! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
545    ! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
546    ! ---   &
547    ! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
548    ! -------------------------------------------------------------------
549
550    IF (iflag_con==30) THEN
551      CALL cv30_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
552        , tnk, qnk, gznk, t, q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, &
553        inb, tp, tvp, clw, hp, ep, sigp, buoy)
554    END IF
555
556    IF (iflag_con==4) THEN
557      CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
558        gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
559    END IF
560
561    ! -------------------------------------------------------------------
562    ! --- CLOSURE
563    ! -------------------------------------------------------------------
564
565    IF (iflag_con==30) THEN
566      CALL cv30_closure(nloc, ncum, nd, icb, inb & ! na->nd
567        , pbase, p, ph, tv, buoy, sig, w0, cape, m)
568
569      ! epmax_cape
570      call cv30_epmax_fn_cape(nloc,ncum,nd &
571                ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
572                ,epmax_diag)
573        ! on écrase ep et recalcule hp
574    END IF
575
576    IF (iflag_con==4) THEN
577      CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
578        cpn, iflag, cbmf)
579    END IF
580   
581
582    ! -------------------------------------------------------------------
583    ! --- MIXING
584    ! -------------------------------------------------------------------
585
586    IF (iflag_con==30) THEN
587      CALL cv30_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
588                                                                ! na->nd
589        , ph, t, q, qs, u, v, tra, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, &
590        ment, qent, uent, vent, sij, elij, ments, qents, traent)
591    END IF
592
593    IF (iflag_con==4) THEN
594      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
595        h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
596        nent, sij, elij)
597    END IF
598
599    ! -------------------------------------------------------------------
600    ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
601    ! -------------------------------------------------------------------
602
603    IF (iflag_con==30) THEN
604      ! RomP >>>
605      CALL cv30_unsat(nloc, ncum, nd, nd, ntra, icb, inb & ! na->nd
606        , t, q, qs, gz, u, v, tra, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, &
607        ment, elij, delt, plcl, mp, qp, up, vp, trap, wt, water, evap, b, &
608        wdtraina, wdtrainm)
609      ! RomP <<<
610    END IF
611
612    IF (iflag_con==4) THEN
613      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
614        ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
615    END IF
616
617    ! -------------------------------------------------------------------
618    ! --- YIELD
619    ! (tendencies, precipitation, variables of interface with other
620    ! processes, etc)
621    ! -------------------------------------------------------------------
622
623    IF (iflag_con==30) THEN
624      CALL cv30_yield(nloc, ncum, nd, nd, ntra & ! na->nd
625        , icb, inb, delt, t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th, ep, &
626        clw, m, tp, mp, qp, up, vp, trap, wt, water, evap, b, ment, qent, &
627        uent, vent, nent, elij, traent, sig, tv, tvp, iflag, precip, vprecip, &
628        ft, fq, fu, fv, ftra, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, &
629        wd)
630    END IF
631
632    IF (iflag_con==4) THEN
633      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
634        ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
635        evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
636        tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
637    END IF
638
639    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
640    ! --- passive tracers
641    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
642
643    IF (iflag_con==30) THEN
644      ! RomP >>>
645      CALL cv30_tracer(nloc, len, ncum, nd, nd, ment, sij, da, phi, phi2, &
646        d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
647      ! RomP <<<
648    END IF
649
650    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
651    ! --- UNCOMPRESS THE FIELDS
652    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
653    ! set iflag1 =42 for non convective points
654    DO i = 1, len
655      iflag1(i) = 42
656    END DO
657
658    IF (iflag_con==30) THEN
659      CALL cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
660        vprecip, evap, ep, sig, w0 & !RomP
661        , ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
662        da, phi, mp, phi2, d1a, dam, sij & !RomP
663        , elij, clw, epmlmmm, eplamm & !RomP
664        , wdtraina, wdtrainm,epmax_diag &     !RomP
665        , iflag1, precip1, vprecip1, evap1, ep1, sig1, w01 & !RomP
666        , ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, dnwd01, &
667        qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1 & !RomP
668        , elij1, clw1, epmlmmm1, eplamm1 & !RomP
669        , wdtraina1, wdtrainm1,epmax_diag1) !RomP
670    END IF
671
672    IF (iflag_con==4) THEN
673      CALL cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
674        fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
675        ma1, qcondc1)
676    END IF
677
678  END IF ! ncum>0
679
680  ! print *, 'fin cv_driver ->'      !jyg
681  RETURN
682END SUBROUTINE cv_driver
683
684! ==================================================================
685SUBROUTINE cv_flag(iflag_ice_thermo)
686
687  USE cvflag_mod_h
688  USE ioipsl_getin_p_mod, ONLY : getin_p
689
690  IMPLICIT NONE
691
692  ! Argument : iflag_ice_thermo : ice thermodynamics is taken into account if
693  ! iflag_ice_thermo >=1
694  INTEGER iflag_ice_thermo
695
696
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
701  !
702! si icvflag_Tpa=0, 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 deux it�rations, une en supposant qu'il n'y a pas de glace et l'autre
705  ! en ajoutant la glace (ancien sch�ma d'Arnaud Jam).
706! si icvflag_Tpa=1, alors la fraction de glace dans l'ascendance adiabatique est
707  ! fonction de la temperature de l'environnement et la temperature de l'ascendance est
708  ! calculee en une seule iteration.
709! si icvflag_Tpa=2, alors la fraction de glace dans l'ascendance adiabatique est
710  ! fonction de la temperature de l'ascendance et la temperature de l'ascendance est
711  ! calculee en une seule iteration.
712  icvflag_Tpa=0
713  call getin_p('icvflag_Tpa', icvflag_Tpa)
714
715  RETURN
716END SUBROUTINE cv_flag
717
718! ==================================================================
719SUBROUTINE cv_thermo(iflag_con)
720  USE yomcst_mod_h
721  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
722
723IMPLICIT NONE
724
725  ! -------------------------------------------------------------
726  ! Set thermodynamical constants for convectL
727  ! -------------------------------------------------------------
728
729
730
731  INTEGER iflag_con
732
733
734  ! original set from convect:
735  IF (iflag_con==4) THEN
736    cpd = 1005.7
737    cpv = 1870.0
738    cl = 4190.0
739    rrv = 461.5
740    rrd = 287.04
741    lv0 = 2.501E6
742    g = 9.8
743    t0 = 273.15
744    grav = g
745  ELSE
746
747    ! constants consistent with LMDZ:
748    cpd = rcpd
749    cpv = rcpv
750    cl = rcw
751    ci = rcs
752    rrv = rv
753    rrd = rd
754    lv0 = rlvtt
755    lf0 = rlstt - rlvtt
756    g = rg ! not used in convect3
757    ! ori      t0  = RTT
758    t0 = 273.15 ! convect3 (RTT=273.16)
759    ! maf       grav= 10.    ! implicitely or explicitely used in convect3
760    grav = g ! implicitely or explicitely used in convect3
761  END IF
762
763  rowl = 1000.0 !(a quelle variable de YOMCST cela correspond-il?)
764
765  clmcpv = cl - cpv
766  clmcpd = cl - cpd
767  clmci = cl - ci
768  cpdmcp = cpd - cpv
769  cpvmcpd = cpv - cpd
770  cpvmcl = cl - cpv ! for convect3
771  eps = rrd/rrv
772  epsi = 1.0/eps
773  epsim1 = epsi - 1.0
774  ! ginv=1.0/g
775  ginv = 1.0/grav
776  hrd = 0.5*rrd
777
778  RETURN
779END SUBROUTINE cv_thermo
Note: See TracBrowser for help on using the repository browser.