source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/cva_driver.F90 @ 2174

Last change on this file since 2174 was 2007, checked in by fhourdin, 11 years ago

Modification pour garantir la conservation des espèces traces.

Modification for tracer conservation

Jean-Yves Grandpeix

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