source: LMDZ5/branches/testing/libf/phylmd/cva_driver.F90 @ 2272

Last change on this file since 2272 was 2220, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2186:2216 into testing branch

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