source: LMDZ5/trunk/libf/phylmd/cva_driver.F90 @ 1992

Last change on this file since 1992 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: 35.5 KB
Line 
1
2! $Id: cva_driver.F90 1992 2014-03-05 13:19:12Z lguez $
3
4SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, iflag_con, iflag_mix, &
5    iflag_ice_thermo, iflag_clos, delt, t1, q1, qs1, t1_wake, q1_wake, &
6    qs1_wake, s1_wake, u1, v1, tra1, p1, ph1, ale1, alp1, sig1feed1, &
7    sig2feed1, wght1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, kbas1, &
8    ktop1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, & !input/output
9    ptop21, sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, qcondc1, wd1, &
10    cape1, cin1, tvp1, ftd1, fqd1, plim11, plim21, asupmax1, supmax01, &
11    asupmaxmin1, lalim_conv, da1, phi1, mp1, phi21, d1a1, dam1, sigij1, clw1, & ! RomP
12    elij1, evap1, ep1, epmlmmm1, eplamm1, & ! RomP
13    wdtraina1, wdtrainm1) ! RomP
14  ! **************************************************************
15  ! *
16  ! CV_DRIVER                                                   *
17  ! *
18  ! *
19  ! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
20  ! modified by :                                               *
21  ! **************************************************************
22  ! **************************************************************
23
24  USE dimphy
25  IMPLICIT NONE
26
27  ! .............................START PROLOGUE............................
28
29
30  ! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
31  ! "1" appended.
32  ! The "1" is removed for the corresponding compressed variables.
33  ! PARAMETERS:
34  ! Name            Type         Usage            Description
35  ! ----------      ----------     -------  ----------------------------
36
37  ! len           Integer        Input        first (i) dimension
38  ! nd            Integer        Input        vertical (k) dimension
39  ! ndp1          Integer        Input        nd + 1
40  ! ntra          Integer        Input        number of tracors
41  ! iflag_con     Integer        Input        version of convect (3/4)
42  ! iflag_mix     Integer        Input        version of mixing  (0/1/2)
43  ! iflag_ice_thermo Integer        Input        accounting for ice
44  ! thermodynamics (0/1)
45  ! iflag_clos    Integer        Input        version of closure (0/1)
46  ! delt          Real           Input        time step
47  ! t1            Real           Input        temperature (sat draught envt)
48  ! q1            Real           Input        specific hum (sat draught envt)
49  ! qs1           Real           Input        sat specific hum (sat draught
50  ! envt)
51  ! t1_wake       Real           Input        temperature (unsat draught
52  ! envt)
53  ! q1_wake       Real           Input        specific hum(unsat draught
54  ! envt)
55  ! qs1_wake      Real           Input        sat specific hum(unsat draughts
56  ! envt)
57  ! s1_wake       Real           Input        fractionnal area covered by
58  ! wakes
59  ! u1            Real           Input        u-wind
60  ! v1            Real           Input        v-wind
61  ! tra1          Real           Input        tracors
62  ! p1            Real           Input        full level pressure
63  ! ph1           Real           Input        half level pressure
64  ! ALE1          Real           Input        Available lifting Energy
65  ! ALP1          Real           Input        Available lifting Power
66  ! sig1feed1     Real           Input        sigma coord at lower bound of
67  ! feeding layer
68  ! sig2feed1     Real           Input        sigma coord at upper bound of
69  ! feeding layer
70  ! wght1         Real           Input        weight density determining the
71  ! feeding mixture
72  ! iflag1        Integer        Output       flag for Emanuel conditions
73  ! ft1           Real           Output       temp tend
74  ! fq1           Real           Output       spec hum tend
75  ! fu1           Real           Output       u-wind tend
76  ! fv1           Real           Output       v-wind tend
77  ! ftra1         Real           Output       tracor tend
78  ! precip1       Real           Output       precipitation
79  ! kbas1         Integer        Output       cloud base level
80  ! ktop1         Integer        Output       cloud top level
81  ! cbmf1         Real           Output       cloud base mass flux
82  ! sig1          Real           In/Out       section adiabatic updraft
83  ! w01           Real           In/Out       vertical velocity within adiab
84  ! updraft
85  ! ptop21        Real           In/Out       top of entraining zone
86  ! Ma1           Real           Output       mass flux adiabatic updraft
87  ! mip1          Real           Output       mass flux shed by the adiabatic
88  ! updraft
89  ! Vprecip1      Real           Output       vertical profile of
90  ! precipitations
91  ! upwd1         Real           Output       total upward mass flux
92  ! (adiab+mixed)
93  ! dnwd1         Real           Output       saturated downward mass flux
94  ! (mixed)
95  ! dnwd01        Real           Output       unsaturated downward mass flux
96  ! qcondc1       Real           Output       in-cld mixing ratio of
97  ! condensed water
98  ! wd1           Real           Output       downdraft velocity scale for
99  ! sfc fluxes
100  ! cape1         Real           Output       CAPE
101  ! cin1          Real           Output       CIN
102  ! tvp1          Real           Output       adiab lifted parcell virt temp
103  ! ftd1          Real           Output       precip temp tend
104  ! fqt1          Real           Output       precip spec hum tend
105  ! Plim11        Real           Output
106  ! Plim21        Real           Output
107  ! asupmax1      Real           Output
108  ! supmax01      Real           Output
109  ! asupmaxmin1   Real           Output
110
111  ! ftd1          Real           Output  Array of temperature tendency due to
112  ! precipitations (K/s) of dimension ND,
113  ! defined at same grid levels as T, Q, QS and P.
114
115  ! fqd1          Real           Output  Array of specific humidity
116  ! tendencies due to precipitations ((gm/gm)/s)
117  ! of dimension ND, defined at same grid levels as T, Q, QS and P.
118
119  ! wdtrainA1     Real           Output   precipitation detrained from
120  ! adiabatic draught;
121  ! used in tracer transport (cvltr)
122  ! wdtrainM1     Real           Output   precipitation detrained from mixed
123  ! draughts;
124  ! used in tracer transport (cvltr)
125  ! da1           Real           Output   used in tracer transport (cvltr)
126  ! phi1          Real           Output   used in tracer transport (cvltr)
127  ! mp1           Real           Output   used in tracer transport (cvltr)
128
129  ! phi21         Real           Output   used in tracer transport (cvltr)
130
131  ! d1a1          Real           Output   used in tracer transport (cvltr)
132  ! dam1          Real           Output   used in tracer transport (cvltr)
133
134  ! epmlmMm1      Real           Output   used in tracer transport (cvltr)
135  ! eplaMm1       Real           Output   used in tracer transport (cvltr)
136
137  ! evap1         Real           Output
138  ! ep1           Real           Output
139  ! sigij1        Real           Output
140  ! elij1         Real           Output
141
142
143  ! S. Bony, Mar 2002:
144  ! * Several modules corresponding to different physical processes
145  ! * Several versions of convect may be used:
146  ! - iflag_con=3: version lmd  (previously named convect3)
147  ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
148  ! + tard:     - iflag_con=5: version lmd with ice (previously named convectg)
149  ! S. Bony, Oct 2002:
150  ! * Vectorization of convect3 (ie version lmd)
151
152  ! ..............................END PROLOGUE.............................
153
154
155  include "dimensions.h"
156  ! cccc#include "dimphy.h"
157  include 'iniprint.h'
158
159
160  ! Input
161  INTEGER len
162  INTEGER nd
163  INTEGER ndp1
164  INTEGER ntra
165  INTEGER iflag_con
166  INTEGER iflag_mix
167  INTEGER iflag_ice_thermo
168  INTEGER iflag_clos
169  REAL delt
170  REAL t1(len, nd)
171  REAL q1(len, nd)
172  REAL qs1(len, nd)
173  REAL t1_wake(len, nd)
174  REAL q1_wake(len, nd)
175  REAL qs1_wake(len, nd)
176  REAL s1_wake(len)
177  REAL u1(len, nd)
178  REAL v1(len, nd)
179  REAL tra1(len, nd, ntra)
180  REAL p1(len, nd)
181  REAL ph1(len, ndp1)
182  REAL ale1(len)
183  REAL alp1(len)
184  REAL sig1feed1 ! pressure at lower bound of feeding layer
185  REAL sig2feed1 ! pressure at upper bound of feeding layer
186  REAL wght1(nd) ! weight density determining the feeding mixture
187
188  ! Output
189  INTEGER iflag1(len)
190  REAL ft1(len, nd)
191  REAL fq1(len, nd)
192  REAL fu1(len, nd)
193  REAL fv1(len, nd)
194  REAL ftra1(len, nd, ntra)
195  REAL precip1(len)
196  INTEGER kbas1(len)
197  INTEGER ktop1(len)
198  REAL cbmf1(len)
199  REAL plcl1(klon)
200  REAL plfc1(klon)
201  REAL wbeff1(klon)
202  REAL sig1(len, klev) !input/output
203  REAL w01(len, klev) !input/output
204  REAL ptop21(len)
205  REAL sigd1(len)
206  REAL ma1(len, nd)
207  REAL mip1(len, nd)
208  ! real Vprecip1(len,nd)
209  REAL vprecip1(len, nd+1)
210  REAL upwd1(len, nd)
211  REAL dnwd1(len, nd)
212  REAL dnwd01(len, nd)
213  REAL qcondc1(len, nd) ! cld
214  REAL wd1(len) ! gust
215  REAL cape1(len)
216  REAL cin1(len)
217  REAL tvp1(len, nd)
218
219  ! AC!
220  ! !      real da1(len,nd),phi1(len,nd,nd)
221  ! !      real da(len,nd),phi(len,nd,nd)
222  ! AC!
223  REAL ftd1(len, nd)
224  REAL fqd1(len, nd)
225  REAL plim11(len)
226  REAL plim21(len)
227  REAL asupmax1(len, nd)
228  REAL supmax01(len)
229  REAL asupmaxmin1(len)
230  INTEGER lalim_conv(len)
231  ! RomP >>>
232  REAL wdtraina1(len, nd), wdtrainm1(len, nd)
233  REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
234  REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
235  REAL evap1(len, nd), ep1(len, nd)
236  REAL sigij1(len, nd, nd), elij1(len, nd, nd)
237  REAL phi21(len, nd, nd)
238  REAL d1a1(len, nd), dam1(len, nd)
239  ! RomP <<<
240
241  ! -------------------------------------------------------------------
242  ! Prolog by Kerry Emanuel.
243  ! -------------------------------------------------------------------
244  ! --- ARGUMENTS
245  ! -------------------------------------------------------------------
246  ! --- On input:
247
248  ! t:   Array of absolute temperature (K) of dimension ND, with first
249  ! index corresponding to lowest model level. Note that this array
250  ! will be altered by the subroutine if dry convective adjustment
251  ! occurs and if IPBL is not equal to 0.
252
253  ! q:   Array of specific humidity (gm/gm) of dimension ND, with first
254  ! index corresponding to lowest model level. Must be defined
255  ! at same grid levels as T. Note that this array will be altered
256  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
257
258  ! qs:  Array of saturation specific humidity of dimension ND, with first
259  ! index corresponding to lowest model level. Must be defined
260  ! at same grid levels as T. Note that this array will be altered
261  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
262
263  ! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
264  ! of dimension ND, with first index corresponding to lowest model level.
265
266  ! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
267  ! of dimension ND, with first index corresponding to lowest model level.
268  ! Must be defined at same grid levels as T.
269
270  ! qs_wake: Array of saturation specific humidity, seen by unsaturated
271  ! draughts,
272  ! of dimension ND, with first index corresponding to lowest model level.
273  ! Must be defined at same grid levels as T.
274
275  ! s_wake: Array of fractionnal area occupied by the wakes.
276
277  ! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
278  ! index corresponding with the lowest model level. Defined at
279  ! same levels as T. Note that this array will be altered if
280  ! dry convective adjustment occurs and if IPBL is not equal to 0.
281
282  ! v:   Same as u but for meridional velocity.
283
284  ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
285  ! where NTRA is the number of different tracers. If no
286  ! convective tracer transport is needed, define a dummy
287  ! input array of dimension (ND,1). Tracers are defined at
288  ! same vertical levels as T. Note that this array will be altered
289  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
290
291  ! p:   Array of pressure (mb) of dimension ND, with first
292  ! index corresponding to lowest model level. Must be defined
293  ! at same grid levels as T.
294
295  ! ph:  Array of pressure (mb) of dimension ND+1, with first index
296  ! corresponding to lowest level. These pressures are defined at
297  ! levels intermediate between those of P, T, Q and QS. The first
298  ! value of PH should be greater than (i.e. at a lower level than)
299  ! the first value of the array P.
300
301  ! ALE:  Available lifting Energy
302
303  ! ALP:  Available lifting Power
304
305  ! nl:  The maximum number of levels to which convection can penetrate, plus
306  ! 1.
307  ! NL MUST be less than or equal to ND-1.
308
309  ! delt: The model time step (sec) between calls to CONVECT
310
311  ! ----------------------------------------------------------------------------
312  ! ---   On Output:
313
314  ! iflag: An output integer whose value denotes the following:
315  ! VALUE   INTERPRETATION
316  ! -----   --------------
317  ! 0     Moist convection occurs.
318  ! 1     Moist convection occurs, but a CFL condition
319  ! on the subsidence warming is violated. This
320  ! does not cause the scheme to terminate.
321  ! 2     Moist convection, but no precip because ep(inb) lt 0.0001
322  ! 3     No moist convection because new cbmf is 0 and old cbmf is 0.
323  ! 4     No moist convection; atmosphere is not
324  ! unstable
325  ! 6     No moist convection because ihmin le minorig.
326  ! 7     No moist convection because unreasonable
327  ! parcel level temperature or specific humidity.
328  ! 8     No moist convection: lifted condensation
329  ! level is above the 200 mb level.
330  ! 9     No moist convection: cloud base is higher
331  ! then the level NL-1.
332
333  ! ft:   Array of temperature tendency (K/s) of dimension ND, defined at
334  ! same
335  ! grid levels as T, Q, QS and P.
336
337  ! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
338  ! defined at same grid levels as T, Q, QS and P.
339
340  ! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
341  ! defined at same grid levels as T.
342
343  ! fv:   Same as FU, but for forcing of meridional velocity.
344
345  ! ftra: Array of forcing of tracer content, in tracer mixing ratio per
346  ! second, defined at same levels as T. Dimensioned (ND,NTRA).
347
348  ! precip: Scalar convective precipitation rate (mm/day).
349
350  ! wd:   A convective downdraft velocity scale. For use in surface
351  ! flux parameterizations. See convect.ps file for details.
352
353  ! tprime: A convective downdraft temperature perturbation scale (K).
354  ! For use in surface flux parameterizations. See convect.ps
355  ! file for details.
356
357  ! qprime: A convective downdraft specific humidity
358  ! perturbation scale (gm/gm).
359  ! For use in surface flux parameterizations. See convect.ps
360  ! file for details.
361
362  ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
363  ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
364  ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
365  ! by the calling program between calls to CONVECT.
366
367  ! det:   Array of detrainment mass flux of dimension ND.
368  ! -------------------------------------------------------------------
369
370  ! Local arrays
371
372
373  INTEGER i, k, n, il, j
374  INTEGER nword1, nword2, nword3, nword4
375  INTEGER icbmax
376  INTEGER nk1(klon)
377  INTEGER icb1(klon)
378  INTEGER icbs1(klon)
379
380  LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
381  LOGICAL, SAVE :: debut = .TRUE.
382  !$OMP THREADPRIVATE(debut)
383
384  REAL tnk1(klon)
385  REAL thnk1(klon)
386  REAL qnk1(klon)
387  REAL gznk1(klon)
388  REAL pnk1(klon)
389  REAL qsnk1(klon)
390  REAL unk1(klon)
391  REAL vnk1(klon)
392  REAL cpnk1(klon)
393  REAL hnk1(klon)
394  REAL pbase1(klon)
395  REAL buoybase1(klon)
396
397  REAL lf1(klon, klev), lf1_wake(klon, klev)
398  REAL lv1(klon, klev), lv1_wake(klon, klev)
399  REAL cpn1(klon, klev), cpn1_wake(klon, klev)
400  REAL tv1(klon, klev), tv1_wake(klon, klev)
401  REAL gz1(klon, klev), gz1_wake(klon, klev)
402  REAL hm1(klon, klev), hm1_wake(klon, klev)
403  REAL h1(klon, klev), h1_wake(klon, klev)
404  REAL tp1(klon, klev)
405  REAL clw1(klon, klev)
406  REAL th1(klon, klev), th1_wake(klon, klev)
407
408  REAL bid(klon, klev) ! dummy array
409
410  INTEGER ncum
411
412  INTEGER j1feed(klon)
413  INTEGER j2feed(klon)
414  REAL p1feed1(len) ! pressure at lower bound of feeding layer
415  REAL p2feed1(len) ! pressure at upper bound of feeding layer
416  REAL wghti1(len, nd) ! weights of the feeding layers
417
418  ! (local) compressed fields:
419
420  INTEGER nloc
421  ! parameter (nloc=klon) ! pour l'instant
422
423  INTEGER idcum(nloc)
424  INTEGER iflag(nloc), nk(nloc), icb(nloc)
425  INTEGER nent(nloc, klev)
426  INTEGER icbs(nloc)
427  INTEGER inb(nloc), inbis(nloc)
428
429  REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
430  REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
431  REAL t_wake(nloc, klev), q_wake(nloc, klev), qs_wake(nloc, klev)
432  REAL s_wake(nloc)
433  REAL u(nloc, klev), v(nloc, klev)
434  REAL gz(nloc, klev), h(nloc, klev), hm(nloc, klev)
435  REAL h_wake(nloc, klev), hm_wake(nloc, klev)
436  REAL lv(nloc, klev), lf(nloc, klev), cpn(nloc, klev)
437  REAL lv_wake(nloc, klev), lf_wake(nloc, klev), cpn_wake(nloc, klev)
438  REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
439  REAL tv_wake(nloc, klev)
440  REAL clw(nloc, klev)
441  REAL dph(nloc, klev)
442  REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
443  REAL th_wake(nloc, klev)
444  REAL tvp(nloc, klev)
445  REAL sig(nloc, klev), w0(nloc, klev), ptop2(nloc)
446  REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
447  REAL buoy(nloc, klev)
448  REAL cape(nloc)
449  REAL cin(nloc)
450  REAL m(nloc, klev)
451  REAL ment(nloc, klev, klev), sigij(nloc, klev, klev)
452  REAL qent(nloc, klev, klev)
453  REAL hent(nloc, klev, klev)
454  REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
455  REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
456  REAL elij(nloc, klev, klev)
457  REAL supmax(nloc, klev)
458  REAL ale(nloc), alp(nloc), coef_clos(nloc)
459  REAL sigd(nloc)
460  ! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
461  ! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
462  ! real b(nloc,klev), sigd(nloc)
463  ! save mp,qp,up,vp,wt,water,evap,b
464  REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
465  REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
466  REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
467  REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
468  !$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
469  REAL ft(nloc, klev), fq(nloc, klev)
470  REAL ftd(nloc, klev), fqd(nloc, klev)
471  REAL fu(nloc, klev), fv(nloc, klev)
472  REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
473  REAL ma(nloc, klev), mip(nloc, klev), tls(nloc, klev)
474  REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
475  REAL precip(nloc)
476  ! real Vprecip(nloc,klev)
477  REAL vprecip(nloc, klev+1)
478  REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
479  REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
480  REAL qcondc(nloc, klev) ! cld
481  REAL wd(nloc) ! gust
482  REAL plim1(nloc), plim2(nloc)
483  REAL asupmax(nloc, klev)
484  REAL supmax0(nloc)
485  REAL asupmaxmin(nloc)
486
487  REAL tnk(nloc), qnk(nloc), gznk(nloc)
488  REAL wghti(nloc, nd)
489  REAL hnk(nloc), unk(nloc), vnk(nloc)
490
491  ! RomP >>>
492  REAL wdtraina(nloc, klev), wdtrainm(nloc, klev)
493  REAL da(len, nd), phi(len, nd, nd)
494  REAL epmlmmm(nloc, klev, klev), eplamm(nloc, klev)
495  REAL phi2(len, nd, nd)
496  REAL d1a(len, nd), dam(len, nd)
497  ! RomP <<<
498
499  LOGICAL, SAVE :: first = .TRUE.
500  !$OMP THREADPRIVATE(first)
501  CHARACTER (LEN=20) :: modname = 'cva_driver'
502  CHARACTER (LEN=80) :: abort_message
503
504
505  ! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
506  ! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
507
508  ! -------------------------------------------------------------------
509  ! --- SET CONSTANTS AND PARAMETERS
510  ! -------------------------------------------------------------------
511
512  IF (first) THEN
513    ALLOCATE (mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
514    ALLOCATE (vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
515    ALLOCATE (ice(nloc,klev), fondue(nloc,klev))
516    ALLOCATE (evap(nloc,klev), b(nloc,klev))
517    ALLOCATE (frac(nloc,klev), faci(nloc,klev))
518    first = .FALSE.
519  END IF
520  ! -- set simulation flags:
521  ! (common cvflag)
522
523  CALL cv_flag(iflag_ice_thermo)
524
525  ! -- set thermodynamical constants:
526  ! (common cvthermo)
527
528  CALL cv_thermo(iflag_con)
529
530  ! -- set convect parameters
531
532  ! includes microphysical parameters and parameters that
533  ! control the rate of approach to quasi-equilibrium)
534  ! (common cvparam)
535
536  IF (iflag_con==3) THEN
537    CALL cv3_param(nd, delt)
538
539  END IF
540
541  IF (iflag_con==4) THEN
542    CALL cv_param(nd)
543  END IF
544
545  ! ---------------------------------------------------------------------
546  ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
547  ! ---------------------------------------------------------------------
548  nword1 = len
549  nword2 = len*nd
550  nword3 = len*nd*ntra
551  nword4 = len*nd*nd
552
553  iflag1(:) = 0
554  ktop1(:) = 0
555  kbas1(:) = 0
556  ft1(:, :) = 0.0
557  fq1(:, :) = 0.0
558  fu1(:, :) = 0.0
559  fv1(:, :) = 0.0
560  ftra1(:, :, :) = 0.
561  precip1(:) = 0.
562  cbmf1(:) = 0.
563  ptop21(:) = 0.
564  sigd1(:) = 0.
565  ma1(:, :) = 0.
566  mip1(:, :) = 0.
567  vprecip1(:, :) = 0.
568  upwd1(:, :) = 0.
569  dnwd1(:, :) = 0.
570  dnwd01(:, :) = 0.
571  qcondc1(:, :) = 0.
572  wd1(:) = 0.
573  cape1(:) = 0.
574  cin1(:) = 0.
575  tvp1(:, :) = 0.
576  ftd1(:, :) = 0.
577  fqd1(:, :) = 0.
578  plim11(:) = 0.
579  plim21(:) = 0.
580  asupmax1(:, :) = 0.
581  supmax01(:) = 0.
582  asupmaxmin1(:) = 0.
583
584  DO il = 1, len
585    cin1(il) = -100000.
586    cape1(il) = -1.
587  END DO
588
589  IF (iflag_con==3) THEN
590    DO il = 1, len
591      sig1(il, nd) = sig1(il, nd) + 1.
592      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
593    END DO
594  END IF
595
596  ! RomP >>>
597  wdtraina1(:, :) = 0.
598  wdtrainm1(:, :) = 0.
599  da1(:, :) = 0.
600  phi1(:, :, :) = 0.
601  epmlmmm1(:, :, :) = 0.
602  eplamm1(:, :) = 0.
603  mp1(:, :) = 0.
604  evap1(:, :) = 0.
605  ep1(:, :) = 0.
606  sigij1(:, :, :) = 0.
607  elij1(:, :, :) = 0.
608  phi21(:, :, :) = 0.
609  d1a1(:, :) = 0.
610  dam1(:, :) = 0.
611  ! RomP <<<
612  ! ---------------------------------------------------------------------
613  ! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
614  ! ---------------------------------------------------------------------
615
616  DO il = 1, nloc
617    coef_clos(il) = 1.
618  END DO
619
620  ! --------------------------------------------------------------------
621  ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
622  ! --------------------------------------------------------------------
623
624  IF (iflag_con==3) THEN
625
626    IF (debut) THEN
627      PRINT *, 'Emanuel version 3 nouvelle'
628    END IF
629    ! print*,'t1, q1 ',t1,q1
630    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
631      , lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
632
633
634    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1 & !
635                                                               ! nd->na
636      , lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, h1_wake, bid, &
637      th1_wake)
638
639  END IF
640
641  IF (iflag_con==4) THEN
642    PRINT *, 'Emanuel version 4 '
643    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
644      hm1)
645  END IF
646
647  ! --------------------------------------------------------------------
648  ! --- CONVECTIVE FEED
649  ! --------------------------------------------------------------------
650
651  ! compute feeding layer potential temperature and mixing ratio :
652
653  ! get bounds of feeding layer
654
655  ! test niveaux couche alimentation KE
656  IF (sig1feed1==sig2feed1) THEN
657    WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
658    WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
659    abort_message = ''
660    CALL abort_gcm(modname, abort_message, 1)
661  END IF
662
663  DO i = 1, len
664    p1feed1(i) = sig1feed1*ph1(i, 1)
665    p2feed1(i) = sig2feed1*ph1(i, 1)
666    ! test maf
667    ! p1feed1(i)=ph1(i,1)
668    ! p2feed1(i)=ph1(i,2)
669    ! p2feed1(i)=ph1(i,3)
670    ! testCR: on prend la couche alim des thermiques
671    ! p2feed1(i)=ph1(i,lalim_conv(i)+1)
672    ! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
673  END DO
674
675  IF (iflag_con==3) THEN
676  END IF
677  DO i = 1, len
678    ! print*,'avant cv3_feed plim',p1feed1(i),p2feed1(i)
679  END DO
680  IF (iflag_con==3) THEN
681
682    ! print*, 'IFLAG1 avant cv3_feed'
683    ! print*,'len,nd',len,nd
684    ! write(*,'(64i1)') iflag1(2:klon-1)
685
686    CALL cv3_feed(len, nd, t1, q1, u1, v1, p1, ph1, hm1, gz1 & !
687                                                               ! nd->na
688      , p1feed1, p2feed1, wght1, wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, &
689      vnk1, cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
690  END IF
691
692  ! print*, 'IFLAG1 apres cv3_feed'
693  ! print*,'len,nd',len,nd
694  ! write(*,'(64i1)') iflag1(2:klon-1)
695
696  IF (iflag_con==4) THEN
697    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
698      iflag1, tnk1, qnk1, gznk1, plcl1)
699  END IF
700
701  ! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
702
703  ! --------------------------------------------------------------------
704  ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
705  ! (up through ICB for convect4, up through ICB+1 for convect3)
706  ! Calculates the lifted parcel virtual temperature at nk, the
707  ! actual temperature, and the adiabatic liquid water content.
708  ! --------------------------------------------------------------------
709
710  IF (iflag_con==3) THEN
711
712    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1 & ! nd->na
713      , gznk1, tp1, tvp1, clw1, icbs1)
714  END IF
715
716
717  IF (iflag_con==4) THEN
718    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
719      tvp1, clw1)
720  END IF
721
722  ! -------------------------------------------------------------------
723  ! --- TRIGGERING
724  ! -------------------------------------------------------------------
725
726  ! print *,' avant triggering, iflag_con ',iflag_con
727
728  IF (iflag_con==3) THEN
729
730    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1 & !
731                                                                       ! nd->na
732      , pbase1, buoybase1, iflag1, sig1, w01)
733
734
735    ! print*, 'IFLAG1 apres cv3_triger'
736    ! print*,'len,nd',len,nd
737    ! write(*,'(64i1)') iflag1(2:klon-1)
738
739    ! call dump2d(iim,jjm-1,sig1(2)
740  END IF
741
742  IF (iflag_con==4) THEN
743    CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
744  END IF
745
746
747  ! =====================================================================
748  ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
749  ! =====================================================================
750
751  ncum = 0
752  DO i = 1, len
753    IF (iflag1(i)==0) THEN
754      ncum = ncum + 1
755      idcum(ncum) = i
756    END IF
757  END DO
758
759  ! print*,'klon, ncum = ',len,ncum
760
761  IF (ncum>0) THEN
762
763    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
764    ! --- COMPRESS THE FIELDS
765    ! (-> vectorization over convective gridpoints)
766    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
767
768    IF (iflag_con==3) THEN
769      ! print*,'ncum tv1 ',ncum,tv1
770      ! print*,'tvp1 ',tvp1
771      CALL cv3a_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
772        plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, &
773        buoybase1, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, &
774        gz1, th1, th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, &
775        tvp1, clw1, h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, &
776        w01, ptop21, ale1, alp1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, &
777        hnk, unk, vnk, wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, &
778        qs_wake, s_wake, u, v, gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, &
779        tv, tp, tvp, clw, h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, sig, &
780        w0, ptop2, ale, alp)
781
782      ! print*,'tv ',tv
783      ! print*,'tvp ',tvp
784
785    END IF
786
787    IF (iflag_con==4) THEN
788      CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
789        tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
790        tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
791        q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
792    END IF
793
794    ! -------------------------------------------------------------------
795    ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
796    ! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
797    ! ---   &
798    ! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
799    ! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
800    ! ---   &
801    ! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
802    ! -------------------------------------------------------------------
803
804    IF (iflag_con==3) THEN
805      CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
806        , tnk, qnk, gznk, hnk, t, q, qs, gz, p, h, tv, lv, lf, pbase, &
807        buoybase, plcl, inb, tp, tvp, clw, hp, ep, sigp, buoy, frac)
808
809    END IF
810
811    IF (iflag_con==4) THEN
812      CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
813        gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
814    END IF
815
816    ! -------------------------------------------------------------------
817    ! --- MIXING(1)   (if iflag_mix .ge. 1)
818    ! -------------------------------------------------------------------
819    IF (iflag_con==3) THEN
820      IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
821        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', &
822          ' but iflag_mix=', iflag_mix, '. Might as well stop here.'
823        STOP
824      END IF
825      IF (iflag_mix>=1) THEN
826        CALL zilch(supmax, nloc*klev)
827        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
828                                                                  ! na->nd
829          , ph, t, q, qs, u, v, tra, h, lv, qnk, unk, vnk, hp, tv, tvp, ep, &
830          clw, sig, ment, qent, hent, uent, vent, nent, sigij, elij, supmax, &
831          ments, qents, traent)
832        ! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
833
834      ELSE
835        CALL zilch(supmax, nloc*klev)
836      END IF
837    END IF
838    ! -------------------------------------------------------------------
839    ! --- CLOSURE
840    ! -------------------------------------------------------------------
841
842
843    IF (iflag_con==3) THEN
844      IF (iflag_clos==0) THEN
845        CALL cv3_closure(nloc, ncum, nd, icb, inb & ! na->nd
846          , pbase, p, ph, tv, buoy, sig, w0, cape, m, iflag)
847      END IF
848
849      ok_inhib = iflag_mix == 2
850
851      IF (iflag_clos==1) THEN
852        PRINT *, ' pas d appel cv3p_closure'
853        ! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              !
854        ! na->nd
855        ! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
856        ! c    :                       ,supmax
857        ! c    o                       ,sig,w0,ptop2,cape,cin,m)
858      END IF
859      IF (iflag_clos==2) THEN
860        CALL cv3p1_closure(nloc, ncum, nd, icb, inb & ! na->nd
861          , pbase, plcl, p, ph, tv, tvp, buoy, supmax, ok_inhib, ale, alp, &
862          sig, w0, ptop2, cape, cin, m, iflag, coef_clos, plim1, plim2, &
863          asupmax, supmax0, asupmaxmin, cbmf, plfc, wbeff)
864
865        PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
866      END IF
867    END IF ! iflag_con.eq.3
868
869    IF (iflag_con==4) THEN
870      CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
871        cpn, iflag, cbmf)
872    END IF
873
874    ! print *,'cv_closure-> cape ',cape(1)
875
876    ! -------------------------------------------------------------------
877    ! --- MIXING(2)
878    ! -------------------------------------------------------------------
879
880    IF (iflag_con==3) THEN
881      IF (iflag_mix==0) THEN
882        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
883                                                                 ! na->nd
884          , ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, unk, vnk, hp, tv, &
885          tvp, ep, clw, m, sig, ment, qent, uent, vent, nent, sigij, elij, &
886          ments, qents, traent)
887        CALL zilch(hent, nloc*klev*klev)
888      ELSE
889        CALL cv3_mixscale(nloc, ncum, nd, ment, m)
890        IF (debut) THEN
891          PRINT *, ' cv3_mixscale-> '
892        END IF !(debut) THEN
893      END IF
894    END IF
895
896    IF (iflag_con==4) THEN
897      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
898        h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
899        nent, sigij, elij)
900    END IF
901
902    IF (debut) THEN
903      PRINT *, ' cv_mixing ->'
904    END IF !(debut) THEN
905    ! do i = 1,klev
906    ! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
907    ! enddo
908
909    ! -------------------------------------------------------------------
910    ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
911    ! -------------------------------------------------------------------
912    IF (iflag_con==3) THEN
913      IF (debut) THEN
914        PRINT *, ' cva_driver -> cv3_unsat '
915      END IF !(debut) THEN
916
917      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag & !
918                                                                 ! na->nd
919        , t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, th_wake, tv_wake, &
920        lv_wake, lf_wake, cpn_wake, ep, sigp, clw, m, ment, elij, delt, plcl, &
921        coef_clos, mp, qp, up, vp, trap, wt, water, evap, fondue, ice, faci, &
922        b, sigd, wdtraina, wdtrainm) ! RomP
923    END IF
924
925    IF (iflag_con==4) THEN
926      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
927        ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
928    END IF
929
930    IF (debut) THEN
931      PRINT *, 'cv_unsat-> '
932    END IF !(debut) THEN
933
934    ! print *,'cv_unsat-> mp ',mp
935    ! print *,'cv_unsat-> water ',water
936    ! -------------------------------------------------------------------
937    ! --- YIELD
938    ! (tendencies, precipitation, variables of interface with other
939    ! processes, etc)
940    ! -------------------------------------------------------------------
941
942    IF (iflag_con==3) THEN
943
944      CALL cv3_yield(nloc, ncum, nd, nd, ntra & ! na->nd
945        , icb, inb, delt, t, q, t_wake, q_wake, s_wake, u, v, tra, gz, p, ph, &
946        h, hp, lv, lf, cpn, th, th_wake, ep, clw, m, tp, mp, qp, up, vp, &
947        trap, wt, water, ice, evap, fondue, faci, b, sigd, ment, qent, hent, &
948        iflag_mix, uent, vent, nent, elij, traent, sig, tv, tvp, wghti, &
949        iflag, precip, vprecip, ft, fq, fu, fv, ftra, cbmf, upwd, dnwd, &
950        dnwd0, ma, mip, tls, tps, qcondc, wd, ftd, fqd)
951    END IF
952
953    IF (debut) THEN
954      PRINT *, ' cv3_yield -> fqd(1) = ', fqd(1, 1)
955    END IF !(debut) THEN
956
957    IF (iflag_con==4) THEN
958      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
959        ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
960        evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
961        tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
962    END IF
963
964    ! AC!
965    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
966    ! --- passive tracers
967    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
968
969    IF (iflag_con==3) THEN
970      ! RomP >>>
971      CALL cv3_tracer(nloc, len, ncum, nd, nd, ment, sigij, da, phi, phi2, &
972        d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
973      ! RomP <<<
974    END IF
975
976    ! AC!
977
978    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
979    ! --- UNCOMPRESS THE FIELDS
980    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
981
982
983    IF (iflag_con==3) THEN
984      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, icb, inb, &
985        precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, ft, fq, fu, fv, &
986        ftra, sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, qcondc, wd, cape, &
987        cin, tvp, ftd, fqd, plim1, plim2, asupmax, supmax0, asupmaxmin, da, &
988        phi, mp, phi2, d1a, dam, sigij & ! RomP
989        , clw, elij, evap, ep, epmlmmm, eplamm & ! RomP
990        , wdtraina, wdtrainm &     ! RomP
991        , iflag1, kbas1, ktop1, precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, &
992        w01, ptop21, ft1, fq1, fu1, fv1, ftra1, sigd1, ma1, mip1, vprecip1, &
993        upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1, cin1, tvp1, ftd1, fqd1, &
994        plim11, plim21, asupmax1, supmax01, asupmaxmin1, da1, phi1, mp1, &
995        phi21, d1a1, dam1, sigij1 & ! RomP
996        , clw1, elij1, evap1, ep1, epmlmmm1, eplamm1 & ! RomP
997        , wdtraina1, wdtrainm1) ! RomP
998    END IF
999
1000    IF (iflag_con==4) THEN
1001      CALL cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
1002        fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
1003        ma1, qcondc1)
1004    END IF
1005
1006  END IF ! ncum>0
1007
1008  IF (debut) THEN
1009    PRINT *, ' cv_compress -> '
1010    debut = .FALSE.
1011  END IF !(debut) THEN
1012
1013  RETURN
1014END SUBROUTINE cva_driver
Note: See TracBrowser for help on using the repository browser.