source: LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/cv3a_driver.f90 @ 3758

Last change on this file since 3758 was 3758, checked in by adurocher, 4 years ago

Refactoring and cleaning cv3a_driver
  • 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: 37.7 KB
RevLine 
[3757]1module cv3a_driver_mod
[3758]2contains
[1992]3
[2007]4! -------------------------------------------------------------------
5! Prolog by Kerry Emanuel.
6! -------------------------------------------------------------------
7! --- ARGUMENTS
8! -------------------------------------------------------------------
9! --- On input:
[3758]10!
[2007]11! t:   Array of absolute temperature (K) of dimension ND, with first
12! index corresponding to lowest model level. Note that this array
13! will be altered by the subroutine if dry convective adjustment
14! occurs and if IPBL is not equal to 0.
[3758]15!
[2007]16! q:   Array of specific humidity (gm/gm) of dimension ND, with first
17! index corresponding to lowest model level. Must be defined
18! at same grid levels as T. Note that this array will be altered
19! if dry convective adjustment occurs and if IPBL is not equal to 0.
[3758]20!
[2007]21! qs:  Array of saturation specific humidity of dimension ND, with first
22! index corresponding to lowest model level. Must be defined
23! at same grid levels as T. Note that this array will be altered
24! if dry convective adjustment occurs and if IPBL is not equal to 0.
[3758]25!
[2007]26! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
27! of dimension ND, with first index corresponding to lowest model level.
[3758]28!
[2007]29! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
30! of dimension ND, with first index corresponding to lowest model level.
31! Must be defined at same grid levels as T.
[3758]32!
[2007]33! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
34! of dimension ND, with first index corresponding to lowest model level.
35! Must be defined at same grid levels as T.
[3758]36!
[2007]37! s_wake: Array of fractionnal area occupied by the wakes.
[3758]38!
[2007]39! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
40! index corresponding with the lowest model level. Defined at
41! same levels as T. Note that this array will be altered if
42! dry convective adjustment occurs and if IPBL is not equal to 0.
[3758]43!
[2007]44! v:   Same as u but for meridional velocity.
[3758]45!
[2007]46! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
47! where NTRA is the number of different tracers. If no
48! convective tracer transport is needed, define a dummy
49! input array of dimension (ND,1). Tracers are defined at
50! same vertical levels as T. Note that this array will be altered
51! if dry convective adjustment occurs and if IPBL is not equal to 0.
[3758]52!
[2007]53! p:   Array of pressure (mb) of dimension ND, with first
54! index corresponding to lowest model level. Must be defined
55! at same grid levels as T.
[3758]56!
[2007]57! ph:  Array of pressure (mb) of dimension ND+1, with first index
58! corresponding to lowest level. These pressures are defined at
59! levels intermediate between those of P, T, Q and QS. The first
60! value of PH should be greater than (i.e. at a lower level than)
61! the first value of the array P.
[3758]62!
[2007]63! ALE:  Available lifting Energy
[3758]64!
[2007]65! ALP:  Available lifting Power
[3758]66!
[2007]67! nl:  The maximum number of levels to which convection can penetrate, plus 1.
68!       NL MUST be less than or equal to ND-1.
[3758]69!
[2007]70! delt: The model time step (sec) between calls to CONVECT
[3758]71!
[2007]72! ----------------------------------------------------------------------------
73! ---   On Output:
[3758]74!
[2007]75! iflag: An output integer whose value denotes the following:
76!       VALUE   INTERPRETATION
77!       -----   --------------
78!         0     Moist convection occurs.
79!         1     Moist convection occurs, but a CFL condition
80!               on the subsidence warming is violated. This
81!               does not cause the scheme to terminate.
82!         2     Moist convection, but no precip because ep(inb) lt 0.0001
83!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
84!         4     No moist convection; atmosphere is not
85!               unstable
86!         6     No moist convection because ihmin le minorig.
87!         7     No moist convection because unreasonable
88!               parcel level temperature or specific humidity.
89!         8     No moist convection: lifted condensation
90!               level is above the 200 mb level.
91!         9     No moist convection: cloud base is higher
92!               then the level NL-1.
[2761]93!        10     No moist convection: cloud top is too warm.
94!
[3758]95!
[2007]96! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
97!       grid levels as T, Q, QS and P.
[3758]98!
[2007]99! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
100!       defined at same grid levels as T, Q, QS and P.
[3758]101!
[2007]102! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
103!      defined at same grid levels as T.
[3758]104!
[2007]105! fv:   Same as FU, but for forcing of meridional velocity.
[3758]106!
[2007]107! ftra: Array of forcing of tracer content, in tracer mixing ratio per
108!       second, defined at same levels as T. Dimensioned (ND,NTRA).
[3758]109!
[2007]110! precip: Scalar convective precipitation rate (mm/day).
[3758]111!
[2007]112! wd:   A convective downdraft velocity scale. For use in surface
113!       flux parameterizations. See convect.ps file for details.
[3758]114!
[2007]115! tprime: A convective downdraft temperature perturbation scale (K).
116!         For use in surface flux parameterizations. See convect.ps
117!         file for details.
[3758]118!
[2007]119! qprime: A convective downdraft specific humidity
120!         perturbation scale (gm/gm).
121!         For use in surface flux parameterizations. See convect.ps
122!         file for details.
[1992]123
[2007]124! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
125!       BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
126!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
127!       by the calling program between calls to CONVECT.
[3758]128!
[2007]129! det:   Array of detrainment mass flux of dimension ND.
130! -------------------------------------------------------------------
[3758]131! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41
132! S. Bony, Mar 2002:
133! * Several modules corresponding to different physical processes
134! * Several versions of convect may be used:
135!         - iflag_con=3: version lmd  (previously named convect3)
136!         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
137! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
138! S. Bony, Oct 2002:
139! * Vectorization of convect3 (ie version lmd)
140  SUBROUTINE cv3a_driver(len, nd, ndp1, ntra, nloc, k_upper, &
141                         iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
142                         delt, &
143                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
144                         u1, v1, &
145                         p1, ph1, &
146                         Ale1, Alp1, omega1, &
147                         sig1feed1, sig2feed1, wght1, &
148                         iflag1, ft1, fq1, fu1, fv1, ftra1, &
149                         precip1, kbas1, ktop1, &
150                         cbmf1, plcl1, plfc1, wbeff1, &
151                         sig1, w01, & !input/output
152                         ptop21, sigd1, &
153                         ma1, mip1, Vprecip1, Vprecipi1, upwd1, dnwd1, dnwd01, &
154                         qcondc1, wd1, &
155                         cape1, cin1, tvp1, &
156                         ftd1, fqd1, &
157                         Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
158                         da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, &
159                         qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &
160                         wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &
161                         coefw_cld_cv, &
162                         epmax_diag1)
[1992]163
[3758]164    USE print_control_mod, ONLY: prt_level, lunout
165    USE cv3a_compress_mod
166    USE cv3p_mixing_mod, ONLY : cv3p_mixing
167    IMPLICIT NONE
168! Input
169    INTEGER, INTENT(IN)                               :: len ! first (i) dimension
170    INTEGER, INTENT(IN)                               :: nd ! vertical (k) dimension
171    INTEGER, INTENT(IN)                               :: ndp1 ! nd + 1
172    INTEGER, INTENT(IN)                               :: ntra ! number of tracors
173    INTEGER, INTENT(IN)                                :: nloc ! dimension of arrays for compressed fields (nloc=len) pour l'instant
174    INTEGER, INTENT(IN)                               :: k_upper ! upmost level for vertical loops
175    INTEGER, INTENT(IN)                               :: iflag_con ! version of convect (3)
176    INTEGER, INTENT(IN)                               :: iflag_mix ! version of mixing  (0/1/2)
177    INTEGER, INTENT(IN)                               :: iflag_ice_thermo ! accounting for ice thermodynamics (0/1)
178    INTEGER, INTENT(IN)                               :: iflag_clos ! version of closure (0/1)
179    LOGICAL, INTENT(IN)                               :: ok_conserv_q ! when true corrections for water conservation are swtiched on
180    REAL, INTENT(IN)                                  :: tau_cld_cv ! characteristic time of dissipation of mixing fluxes
181    REAL, INTENT(IN)                                  :: coefw_cld_cv ! coefficient for updraft velocity in convection
182    REAL, INTENT(IN)                                  :: delt ! time step
183    REAL, DIMENSION(len, nd), INTENT(IN)             :: t1 ! temperature (sat draught envt)
184    REAL, DIMENSION(len, nd), INTENT(IN)             :: q1 ! specific hum (sat draught envt)
185    REAL, DIMENSION(len, nd), INTENT(IN)             :: qs1 ! sat specific hum (sat draught envt)
186    REAL, DIMENSION(len, nd), INTENT(IN)             :: t1_wake ! temperature (unsat draught envt)
187    REAL, DIMENSION(len, nd), INTENT(IN)             :: q1_wake ! specific hum(unsat draught envt)
188    REAL, DIMENSION(len, nd), INTENT(IN)             :: qs1_wake ! sat specific hum(unsat draughts envt)
189    REAL, DIMENSION(len), INTENT(IN)                 :: s1_wake ! fractionnal area covered by wakes
190    REAL, DIMENSION(len, nd), INTENT(IN)             :: u1 ! u-wind
191    REAL, DIMENSION(len, nd), INTENT(IN)             :: v1 ! v-wind
192    REAL, DIMENSION(len, nd), INTENT(IN)             :: p1 ! full level pressure
193    REAL, DIMENSION(len, ndp1), INTENT(IN)           :: ph1 ! half level pressure
194    REAL, DIMENSION(len), INTENT(IN)                 :: Ale1 ! Available lifting Energy
195    REAL, DIMENSION(len), INTENT(IN)                 :: Alp1 ! Available lifting Power
196    REAL, DIMENSION(len, nd), INTENT(IN)             :: omega1
197    REAL, INTENT(IN)                                  :: sig1feed1 ! sigma coord/pressure at lower bound of feeding layer
198    REAL, INTENT(IN)                                  :: sig2feed1 ! sigma coord/pressure at upper bound of feeding layer
199    REAL, DIMENSION(nd), INTENT(IN)                  :: wght1     ! weight density determining the feeding mixture
[1992]200
[3758]201! Input/Output
202    REAL, DIMENSION(len, nd), INTENT(INOUT)          :: sig1 ! section adiabatic updraft
203    REAL, DIMENSION(len, nd), INTENT(INOUT)          :: w01 ! vertical velocity within adiab updraft
[1992]204
[3758]205! Output
206    INTEGER, DIMENSION(len), INTENT(OUT)             :: iflag1 ! flag for Emanuel conditions
207    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ft1 ! temp tend
208    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fq1 ! spec hum tend
209    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fu1 ! u-wind tend
210    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fv1 ! v-wind tend
211    REAL, DIMENSION(len, nd, ntra), INTENT(OUT)      :: ftra1 ! tracor tend
212    REAL, DIMENSION(len), INTENT(OUT)                :: precip1 ! precipitation
213    INTEGER, DIMENSION(len), INTENT(OUT)             :: kbas1 ! cloud base level
214    INTEGER, DIMENSION(len), INTENT(OUT)             :: ktop1 ! cloud top level
215    REAL, DIMENSION(len), INTENT(OUT)                :: cbmf1 ! cloud base mass flux
216    REAL, DIMENSION(len), INTENT(OUT)                :: plcl1
217    REAL, DIMENSION(len), INTENT(OUT)                :: plfc1
218    REAL, DIMENSION(len), INTENT(OUT)                :: wbeff1
219    REAL, DIMENSION(len), INTENT(OUT)                :: ptop21 ! top of entraining zone
220    REAL, DIMENSION(len), INTENT(OUT)                :: sigd1
221    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ma1        ! mass flux adiabatic updraft (staggered grid)
222    REAL, DIMENSION(len, nd), INTENT(OUT)            :: mip1       ! mass flux shed by the adiabatic updraft (extensive)
223    REAL, DIMENSION(len, ndp1), INTENT(OUT)          :: vprecip1   ! vertical profile of total precipitation (staggered grid)
224    REAL, DIMENSION(len, ndp1), INTENT(OUT)          :: vprecipi1  ! vertical profile of ice precipitation (staggered grid)
225    REAL, DIMENSION(len, nd), INTENT(OUT)            :: upwd1      ! total upward mass flux (adiab+mixed) (staggered grid)
226    REAL, DIMENSION(len, nd), INTENT(OUT)            :: dnwd1      ! saturated downward mass flux (mixed) (staggered grid)
227    REAL, DIMENSION(len, nd), INTENT(OUT)            :: dnwd01     ! unsaturated downward mass flux (staggered grid)
228    REAL, DIMENSION(len, nd), INTENT(OUT)            :: qcondc1    ! in-cld mixing ratio of condensed water (intensive)
229    REAL, DIMENSION(len), INTENT(OUT)                :: wd1        ! downdraft velocity scale for sfc fluxes
230    REAL, DIMENSION(len), INTENT(OUT)                :: cape1
231    REAL, DIMENSION(len), INTENT(OUT)                :: cin1
232    REAL, DIMENSION(len, nd), INTENT(OUT)            :: tvp1       ! adiab lifted parcell virt temp
233    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ftd1       ! temperature tendency due to precipitations (K/s)
234    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fqd1       ! specific humidity tendencies due to precipitations ((gm/gm)/s)
235    REAL, DIMENSION(len), INTENT(OUT)                :: Plim11
236    REAL, DIMENSION(len), INTENT(OUT)                :: Plim21
237    REAL, DIMENSION(len, nd), INTENT(OUT)            :: asupmax1   ! Highest mixing fraction of mixed updraughts
238    REAL, DIMENSION(len), INTENT(OUT)                :: supmax01
239    REAL, DIMENSION(len), INTENT(OUT)                :: asupmaxmin1
240    REAL, DIMENSION(len, nd), INTENT(OUT)            :: qtc1    ! in cloud water content / specific humidity in convection (intensive)
241    REAL, DIMENSION(len, nd), INTENT(OUT)            :: sigt1   ! surface fraction in adiabatic updrafts / fract. cloud area (intensive)
242    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wdtrainA1 ! precipitation ejected from adiabatic draught
243    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wdtrainS1 ! precipitation detrained from shedding of adiabatic draught
244    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wdtrainM1 ! precipitation detrained from mixed draughts
245    REAL, DIMENSION(len, nd), INTENT(OUT)            :: mp1  ! unsat. mass flux (staggered grid)
246    REAL, DIMENSION(len, nd), INTENT(OUT)            :: da1  ! detrained mass flux of adiab. asc. air (extensive)
247    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
248    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: epmlmMm1  ! (extensive)
249    REAL, DIMENSION(len, nd), INTENT(OUT)            :: eplaMm1   ! (extensive)
250    REAL, DIMENSION(len, nd), INTENT(OUT)            :: evap1 ! evaporation rate in precip. downdraft. (intensive)
251    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ep1
252    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
253    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: elij1! cond. water per unit mass of mixed draughts (intensive)
254    REAL, DIMENSION(len, nd), INTENT(OUT)            :: qta1 ! total water per unit mass of the adiab. asc. (intensive)
255    REAL, DIMENSION(len, nd), INTENT(OUT)            :: clw1 ! condensed water content of the adiabatic updraught / cond. water per unit mass of the adiab. asc. (intensive)
256    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wghti1   ! final weight of the feeding layers (extensive)
257    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: phi21    ! (extensive)
258    REAL, DIMENSION(len, nd), INTENT(OUT)            :: d1a1     ! (extensive)
259    REAL, DIMENSION(len, nd), INTENT(OUT)            :: dam1     ! (extensive)
260    REAL, DIMENSION(len), INTENT(OUT)               :: epmax_diag1
[1992]261
[3758]262! Local (non compressed) arrays
263    INTEGER i, k, il
264    INTEGER icbmax
265    INTEGER nk1(len)
266    INTEGER icb1(len)
267    INTEGER icbs1(len)
[1992]268
[3758]269    LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
270    LOGICAL, SAVE :: debut = .TRUE.
271!$omp THREADPRIVATE(debut)
[1992]272
[3758]273    REAL tnk1(len)
274    REAL thnk1(len)
275    REAL qnk1(len)
276    REAL gznk1(len)
277    REAL qsnk1(len)
278    REAL unk1(len)
279    REAL vnk1(len)
280    REAL cpnk1(len)
281    REAL hnk1(len)
282    REAL pbase1(len)
283    REAL buoybase1(len)
[1992]284
[3758]285    REAL lf1(len, nd), lf1_wake(len, nd)
286    REAL lv1(len, nd), lv1_wake(len, nd)
287    REAL cpn1(len, nd), cpn1_wake(len, nd)
288    REAL tv1(len, nd), tv1_wake(len, nd)
289    REAL gz1(len, nd), gz1_wake(len, nd)
290    REAL hm1(len, nd)
291    REAL h1(len, nd), h1_wake(len, nd)
292    REAL tp1(len, nd)
293    REAL th1(len, nd), th1_wake(len, nd)
[1992]294
[3758]295    REAL bid(len, nd) ! dummy array
[1992]296
[3758]297    INTEGER ncum
[1992]298
[3758]299    REAL p1feed1(len) ! pressure at lower bound of feeding layer
300    REAL p2feed1(len) ! pressure at upper bound of feeding layer
301
[2007]302! (local) compressed fields:
[3758]303    LOGICAL compress    ! True if compression occurs
304    INTEGER iflag(nloc), nk(nloc), icb(nloc)
305    INTEGER nent(nloc, nd)
306    INTEGER icbs(nloc)
307    INTEGER inb(nloc)
[1992]308
[3758]309    REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
310    REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
311    REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
312    REAL s_wake(nloc)
313    REAL u(nloc, nd), v(nloc, nd)
314    REAL gz(nloc, nd), h(nloc, nd)
315    REAL h_wake(nloc, nd)
316    REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
317    REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
318    REAL p(nloc, nd), ph(nloc, nd + 1), tv(nloc, nd), tp(nloc, nd)
319    REAL tv_wake(nloc, nd)
320    REAL clw(nloc, nd)
321    REAL, DIMENSION(nloc, nd)    :: qta, qpreca
322    REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
323    REAL th_wake(nloc, nd)
324    REAL tvp(nloc, nd)
325    REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
326    REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
327    REAL buoy(nloc, nd)
328    REAL cape(nloc)
329    REAL cin(nloc)
330    REAL m(nloc, nd)
331    REAL mm(nloc, nd)
332    REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
333    REAL qent(nloc, nd, nd)
334    REAL hent(nloc, nd, nd)
335    REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
336    REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
337    REAL elij(nloc, nd, nd)
338    REAL supmax(nloc, nd)
339    REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
340    REAL omega(nloc, nd)
341    REAL sigd(nloc)
342    REAL, DIMENSION(len, nd)     :: mp, qp, up, vp
343    REAL, DIMENSION(len, nd)     :: wt, water, evap
344    REAL, DIMENSION(len, nd)     :: ice, fondue, b
345    REAL, DIMENSION(len, nd)     :: frac_a, frac_s, faci
346    REAL ft(nloc, nd), fq(nloc, nd)
347    REAL ftd(nloc, nd), fqd(nloc, nd)
348    REAL fu(nloc, nd), fv(nloc, nd)
349    REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
350    REAL ma(nloc, nd), mip(nloc, nd)
351    REAL precip(nloc)
352    REAL vprecip(nloc, nd + 1)
353    REAL vprecipi(nloc, nd + 1)
354    REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
355    REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
356    REAL qcondc(nloc, nd)
357    REAL wd(nloc)
358    REAL Plim1(nloc), plim2(nloc)
359    REAL asupmax(nloc, nd)
360    REAL supmax0(nloc)
361    REAL asupmaxmin(nloc)
[1992]362
[3758]363    REAL tnk(nloc), qnk(nloc), gznk(nloc)
364    REAL wghti(nloc, nd)
365    REAL hnk(nloc), unk(nloc), vnk(nloc)
[1992]366
[3758]367    REAL qtc(nloc, nd)
368    REAL sigt(nloc, nd)
[1992]369
[3758]370    REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd)
371    REAL da(len, nd), phi(len, nd, nd)
372    REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
373    REAL phi2(len, nd, nd)
374    REAL d1a(len, nd), dam(len, nd)
375    REAL epmax_diag(nloc) ! epmax_cape
[1992]376
[3758]377    CHARACTER(LEN=20) :: modname = 'cva_driver'
378    CHARACTER(LEN=80) :: abort_message
[1992]379
[3758]380    INTEGER, SAVE :: igout = 1
381!$omp THREADPRIVATE(igout)
[1992]382
[3758]383    type(compress_data_t) :: compress_data
384    type(array_list) :: cv3a_compress_list, cv3a_uncompress_list
[1992]385
[3758]386    if (iflag_con /= 3) call abort_physic("cv3a_driver", "iflag_con must be 3", 1)
[2374]387
[2007]388! -------------------------------------------------------------------
389! --- SET CONSTANTS AND PARAMETERS
390! -------------------------------------------------------------------
391! -- set simulation flags:
[3758]392! (common cvflag
393    CALL cv_flag(iflag_ice_thermo)
[2007]394! -- set thermodynamical constants:
395! (common cvthermo)
[3758]396    CALL cv_thermo(iflag_con)
[2007]397! -- set convect parameters
398! includes microphysical parameters and parameters that
399! control the rate of approach to quasi-equilibrium)
400! (common cvparam)
[2259]401    CALL cv3_param(nd, k_upper, delt)
[1992]402
[3758]403    CALL cv3_incrcount(len, nd, delt, sig1)
[1992]404
[2007]405! ---------------------------------------------------------------------
406! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
407! ---------------------------------------------------------------------
[1992]408
[3758]409    DO il = 1, nloc
410      coef_clos(il) = 1.
411    END DO
[1992]412
[2007]413! --------------------------------------------------------------------
414! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
415! --------------------------------------------------------------------
[1992]416
[3758]417    IF (debut) PRINT *, 'Emanuel version 3 nouvelle'
[1992]418
[3758]419    call driver_log('cv3_prelim')
420    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
[2007]421                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
[1992]422
[3758]423    call driver_log('cv3_prelim')
424    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, &
[2007]425                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
426                    h1_wake, bid, th1_wake)
[1992]427
[2007]428! --------------------------------------------------------------------
429! --- CONVECTIVE FEED
430! --------------------------------------------------------------------
431! compute feeding layer potential temperature and mixing ratio :
432! get bounds of feeding layer
433! test niveaux couche alimentation KE
[3758]434    IF (sig1feed1 == sig2feed1) THEN
435      WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
436      WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
437      abort_message = ''
438      CALL abort_physic(modname, abort_message, 1)
439    END IF
[1992]440
[3758]441    DO i = 1, len
442      p1feed1(i) = sig1feed1*ph1(i, 1)
443      p2feed1(i) = sig2feed1*ph1(i, 1)
444    END DO
[1992]445
[3758]446    call driver_log('cv3_feed')
[1992]447
[3758]448    ! GLITCHY : arrays are set to zero but are intent(out) in call to cv3_feed
449    iflag1(:) = 0
450    plcl1(:) = 0.
451    wghti1(:, :) = 0.
452    CALL cv3_feed(len, nd, ok_conserv_q, &
453                  t1, q1, u1, v1, p1, ph1, h1, gz1, &
[2007]454                  p1feed1, p2feed1, wght1, &
455                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
456                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
[1992]457
[2007]458! --------------------------------------------------------------------
459! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
460! (up through ICB for convect4, up through ICB+1 for convect3)
461! Calculates the lifted parcel virtual temperature at nk, the
462! actual temperature, and the adiabatic liquid water content.
463! --------------------------------------------------------------------
[3758]464    call driver_log('cv3_undilute1')
465    ! GLITCHY : arrays are set to zero but are intent(out) in call to cv3_feed
466    tvp1(:, :) = 0.
467    clw1(:, :) = 0.
[2007]468    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
469                       gznk1, tp1, tvp1, clw1, icbs1)
[1992]470
[2007]471! -------------------------------------------------------------------
472! --- TRIGGERING
473! -------------------------------------------------------------------
[1992]474
[3758]475    call driver_log('cv3_trigger')
[2007]476    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
[3758]477                     pbase1, buoybase1, iflag1, sig1, w01)
[1992]478
[2007]479! =====================================================================
480! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
481! =====================================================================
[1992]482
[2007]483! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
484! --- COMPRESS THE FIELDS
485!       (-> vectorization over convective gridpoints)
486! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[3758]487    compress = .true.
488    if (compress) then
489      compress_mode = COMPRESS_MODE_COMPRESS
490    else
491      compress_mode = COMPRESS_MODE_COPY
492    endif
[1992]493
[3758]494    call driver_log('cv3a_compress')
[1992]495
[3758]496    call add_array_i1(cv3a_compress_list, iflag1, iflag)
497    call add_array_i1(cv3a_compress_list, nk1, nk)
498    call add_array_i1(cv3a_compress_list, icb1, icb)
499    call add_array_i1(cv3a_compress_list, icbs1, icbs)
500    call add_array_r1(cv3a_compress_list, plcl1, plcl)
501    call add_array_r1(cv3a_compress_list, tnk1, tnk)
502    call add_array_r1(cv3a_compress_list, qnk1, qnk)
503    call add_array_r1(cv3a_compress_list, gznk1, gznk)
504    call add_array_r1(cv3a_compress_list, hnk1, hnk)
505    call add_array_r1(cv3a_compress_list, unk1, unk)
506    call add_array_r1(cv3a_compress_list, vnk1, vnk)
507    call add_array_r2(cv3a_compress_list, wghti1, wghti)
508    call add_array_r1(cv3a_compress_list, pbase1, pbase)
509    call add_array_r1(cv3a_compress_list, buoybase1, buoybase)
510    call add_array_r2(cv3a_compress_list, th1, th)
511    call add_array_r2(cv3a_compress_list, t1, t)
512    call add_array_r2(cv3a_compress_list, q1, q)
513    call add_array_r2(cv3a_compress_list, qs1, qs)
514    call add_array_r2(cv3a_compress_list, t1_wake, t_wake)
515    call add_array_r2(cv3a_compress_list, q1_wake, q_wake)
516    call add_array_r2(cv3a_compress_list, qs1_wake, qs_wake)
517    call add_array_r1(cv3a_compress_list, s1_wake, s_wake)
518    call add_array_r2(cv3a_compress_list, u1, u)
519    call add_array_r2(cv3a_compress_list, v1, v)
520    call add_array_r2(cv3a_compress_list, gz1, gz)
521    call add_array_r2(cv3a_compress_list, h1, h)
522    call add_array_r2(cv3a_compress_list, th1_wake, th_wake)
523    call add_array_r2(cv3a_compress_list, lv1, lv)
524    call add_array_r2(cv3a_compress_list, lf1, lf)
525    call add_array_r2(cv3a_compress_list, cpn1, cpn)
526    call add_array_r2(cv3a_compress_list, p1, p)
527    call add_array_r2(cv3a_compress_list, ph1, ph)
528    call add_array_r2(cv3a_compress_list, tv1, tv)
529    call add_array_r2(cv3a_compress_list, tp1, tp)
530    call add_array_r2(cv3a_compress_list, tvp1, tvp)
531    call add_array_r2(cv3a_compress_list, clw1, clw)
532    call add_array_r2(cv3a_compress_list, h1_wake, h_wake)
533    call add_array_r2(cv3a_compress_list, lv1_wake, lv_wake)
534    call add_array_r2(cv3a_compress_list, lf1_wake, lf_wake)
535    call add_array_r2(cv3a_compress_list, cpn1_wake, cpn_wake)
536    call add_array_r2(cv3a_compress_list, tv1_wake, tv_wake)
537    call add_array_r2(cv3a_compress_list, sig1, sig)
538    call add_array_r1(cv3a_compress_list, sig1(:, nd), sig(:, nd))
539    call add_array_r2(cv3a_compress_list, w01, w0)
540    call add_array_r1(cv3a_compress_list, Ale1, Ale)
541    call add_array_r1(cv3a_compress_list, Alp1, Alp)
542    call add_array_r2(cv3a_compress_list, omega1, omega)
[3707]543
[3758]544    call cv3a_compress(len, (iflag1 == 0), cv3a_compress_list, compress_data)
545    ncum = compress_data%ncum
[3707]546
[3758]547    IF (ncum > 0) THEN
[3707]548
[2007]549! -------------------------------------------------------------------
550! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
551! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
552! ---   &
553! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
554! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
555! ---   &
556! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
557! -------------------------------------------------------------------
[1992]558
[3758]559      call driver_log('cv3_undilute2')
560      CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &
[2007]561                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
[2420]562                         p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
[2007]563                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
[3758]564                         frac_a, frac_s, qpreca, qta)
[1992]565
[3758]566! epmax_cape
567! on recalcule ep et hp
568      call driver_log('cv3_epmax_cape')
569      call cv3_epmax_fn_cape(nloc, ncum, nd &
570                             , ep, hp, icb, inb, clw, nk, t, h, hnk, lv, lf, frac_s &
571                             , pbase, p, ph, tv, buoy, sig, w0, iflag &
572                             , epmax_diag)
[1992]573
[2007]574! -------------------------------------------------------------------
575! --- MIXING(1)   (if iflag_mix .ge. 1)
576! -------------------------------------------------------------------
[3758]577
578      IF (iflag_mix >= 1) THEN
[2853]579        CALL zilch(supmax, nloc*nd)
[3758]580        call driver_log('cv3p_mixing')
581        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &
582                         ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, &
[2007]583                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
584                         ment, qent, hent, uent, vent, nent, &
585                         sigij, elij, supmax, ments, qents, traent)
[1992]586      ELSE
[2853]587        CALL zilch(supmax, nloc*nd)
[1992]588      END IF
[3758]589
[2007]590! -------------------------------------------------------------------
591! --- CLOSURE
592! -------------------------------------------------------------------
[1992]593
[3758]594      ptop2(:) = 0
595      IF (iflag_clos == 0) THEN
596        call driver_log('cv3_closure')
597        CALL cv3_closure(nloc, ncum, nd, icb, inb, &
[2007]598                         pbase, p, ph, tv, buoy, &
599                         sig, w0, cape, m, iflag)
[2374]600      END IF   ! iflag_clos==0
[1992]601
602      ok_inhib = iflag_mix == 2
603
[3758]604      IF (iflag_clos == 1) PRINT *, ' pas d appel cv3p_closure'
[2374]605
[3758]606      IF (iflag_clos == 2) THEN
607        call driver_log('cv3p1_closure')
608        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &
[2007]609                           pbase, plcl, p, ph, tv, tvp, buoy, &
[2201]610                           supmax, ok_inhib, Ale, Alp, omega, &
[2007]611                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
612                           Plim1, plim2, asupmax, supmax0, &
613                           asupmaxmin, cbmf, plfc, wbeff)
[3758]614        if (prt_level >= 10) PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
615      END IF ! iflag_clos==2
[1992]616
[3758]617      IF (iflag_clos == 3) THEN
618        call driver_log('cv3p2_closure')
619        CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &
[2374]620                           pbase, plcl, p, ph, tv, tvp, buoy, &
621                           supmax, ok_inhib, Ale, Alp, omega, &
622                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
623                           Plim1, plim2, asupmax, supmax0, &
624                           asupmaxmin, cbmf, plfc, wbeff)
[3758]625        if (prt_level >= 10) PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
626      END IF ! iflag_clos==3
[2374]627
[2007]628! -------------------------------------------------------------------
629! --- MIXING(2)
630! -------------------------------------------------------------------
[1992]631
[3758]632      IF (iflag_mix == 0) THEN
633        call driver_log('cv3_mixing')
[2007]634        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
[3496]635                        ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, &
[2007]636                        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
637                        ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
[2853]638        CALL zilch(hent, nloc*nd*nd)
[1992]639      ELSE
[3758]640        mm(:, :) = m(:, :)
[3496]641        CALL cv3_mixscale(nloc, ncum, nd, ment, mm)
[3758]642        IF (debut) PRINT *, ' cv3_mixscale-> '
[1992]643      END IF
644
[3758]645      IF (debut) PRINT *, ' cv_mixing ->'
[1992]646
[2007]647! -------------------------------------------------------------------
648! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
649! -------------------------------------------------------------------
[3758]650      IF (debut) PRINT *, ' cva_driver -> cv3_unsat '
[1992]651
[3758]652      call driver_log('cv3_unsat')
653      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &
[2007]654                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
655                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
[3758]656                     ep, sigp, clw, frac_s, qpreca, frac_a, qta, &
[2007]657                     m, ment, elij, delt, plcl, coef_clos, &
658                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
659                     faci, b, sigd, &
[3758]660                     wdtrainA, wdtrainS, wdtrainM)
[2374]661      IF (prt_level >= 10) THEN
662        Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
[3758]663        DO k = 1, nd
664          write (6, '(i4,5(1x,e13.6))'), &
665            k, mp(igout, k), water(igout, k), ice(igout, k), &
666            evap(igout, k), fondue(igout, k)
[2374]667        ENDDO
[3758]668        Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM '
669        DO k = 1, nd
670          write (6, '(i4,3(1x,e13.6))'), &
671            k, wdtrainA(igout, k), wdtrainS(igout, k), wdtrainM(igout, k)
[2374]672        ENDDO
673      ENDIF
[1992]674
[3758]675      IF (debut) PRINT *, 'cv_unsat-> '
[2007]676! -------------------------------------------------------------------
[3758]677! YIELD
678! (tendencies, precipitation, variables of interface with other processes, etc)
[2007]679! -------------------------------------------------------------------
[1992]680
[3758]681      call driver_log('cv3_yield')
682      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &
[2007]683                     icb, inb, delt, &
684                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
685                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
[3496]686                     ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, &
[2007]687                     wt, water, ice, evap, fondue, faci, b, sigd, &
688                     ment, qent, hent, iflag_mix, uent, vent, &
689                     nent, elij, traent, sig, &
690                     tv, tvp, wghti, &
[3758]691                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &
[2007]692                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
[2259]693                     qcondc, wd, &
[3758]694                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv)
695
696      ! Test conseravtion de l'eau
697      IF (debut) PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
[2374]698      IF (prt_level >= 10) THEN
699        Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
[3758]700          ft(igout, 1), ftd(igout, 1)
[2374]701        Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
[3758]702          fq(igout, 1), fqd(igout, 1)
[2374]703      ENDIF
[1992]704
[2007]705!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
706!--- passive tracers
707!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]708
[3758]709      call driver_log('cv3_tracer')
[2007]710      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
[3758]711                      ment, sigij, da, phi, phi2, d1a, dam, &
712                      ep, vprecip, elij, clw, epmlmMm, eplaMm, &
713                      icb, inb)
714    END IF ! ncum>0
[1992]715
[2007]716! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
717! --- UNCOMPRESS THE FIELDS
718! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[3758]719    call driver_log('cv3a_uncompress')
720    call add_array_i1(cv3a_uncompress_list, iflag, iflag1, init=.false.)
721    call add_array_i1(cv3a_uncompress_list, icb, kbas1)
722    call add_array_i1(cv3a_uncompress_list, inb, ktop1)
723    call add_array_r1(cv3a_uncompress_list, precip, precip1)
724    call add_array_r1(cv3a_uncompress_list, cbmf, cbmf1)
725    call add_array_r1(cv3a_uncompress_list, plcl, plcl1, init=.false.)
726    call add_array_r1(cv3a_uncompress_list, plfc, plfc1)
727    call add_array_r1(cv3a_uncompress_list, wbeff, wbeff1)
728    call add_array_r2(cv3a_uncompress_list, sig, sig1)
729    call add_array_r2(cv3a_uncompress_list, w0, w01)
730    call add_array_r1(cv3a_uncompress_list, ptop2, ptop21)
731    call add_array_r2(cv3a_uncompress_list, ft, ft1)
732    call add_array_r2(cv3a_uncompress_list, fq, fq1)
733    call add_array_r2(cv3a_uncompress_list, fu, fu1)
734    call add_array_r2(cv3a_uncompress_list, fv, fv1)
735    call add_array_r1(cv3a_uncompress_list, sigd, sigd1)
736    call add_array_r2(cv3a_uncompress_list, ma, ma1)
737    call add_array_r2(cv3a_uncompress_list, mip, mip1)
738    call add_array_r2(cv3a_uncompress_list, vprecip, vprecip1)
739    call add_array_r2(cv3a_uncompress_list, vprecipi, vprecipi1)
740    call add_array_r2(cv3a_uncompress_list, upwd, upwd1)
741    call add_array_r2(cv3a_uncompress_list, dnwd, dnwd1)
742    call add_array_r2(cv3a_uncompress_list, dnwd0, dnwd01)
743    call add_array_r2(cv3a_uncompress_list, qcondc, qcondc1)
744    call add_array_r1(cv3a_uncompress_list, wd, wd1)
745    cape1(:) = -1.
746    call add_array_r1(cv3a_uncompress_list, cape, cape1, init=.false.)
747    cin1(:) = -100000.
748    call add_array_r1(cv3a_uncompress_list, cin, cin1, init=.false.)
749    call add_array_r2(cv3a_uncompress_list, tvp, tvp1, init=.false.)
750    call add_array_r2(cv3a_uncompress_list, ftd, ftd1)
751    call add_array_r2(cv3a_uncompress_list, fqd, fqd1)
752    call add_array_r1(cv3a_uncompress_list, Plim1, Plim11)
753    call add_array_r1(cv3a_uncompress_list, plim2, plim21)
754    call add_array_r2(cv3a_uncompress_list, asupmax, asupmax1)
755    call add_array_r1(cv3a_uncompress_list, supmax0, supmax01)
756    call add_array_r1(cv3a_uncompress_list, asupmaxmin, asupmaxmin1)
757    call add_array_r2(cv3a_uncompress_list, da, da1)
758    call add_array_r3(cv3a_uncompress_list, phi, phi1)
759    call add_array_r2(cv3a_uncompress_list, mp, mp1)
760    call add_array_r3(cv3a_uncompress_list, phi2, phi21)
761    call add_array_r2(cv3a_uncompress_list, d1a, d1a1)
762    call add_array_r2(cv3a_uncompress_list, dam, dam1)
763    call add_array_r3(cv3a_uncompress_list, sigij, sigij1)
764    call add_array_r2(cv3a_uncompress_list, qta, qta1)
765    call add_array_r2(cv3a_uncompress_list, clw, clw1, init=.false.)
766    call add_array_r3(cv3a_uncompress_list, elij, elij1)
767    call add_array_r2(cv3a_uncompress_list, evap, evap1)
768    call add_array_r2(cv3a_uncompress_list, ep, ep1)
769    call add_array_r3(cv3a_uncompress_list, epmlmMm, epmlmMm1)
770    call add_array_r2(cv3a_uncompress_list, eplaMm, eplaMm1)
771    call add_array_r2(cv3a_uncompress_list, wdtrainA, wdtrainA1)
772    call add_array_r2(cv3a_uncompress_list, wdtrainS, wdtrainS1)
773    call add_array_r2(cv3a_uncompress_list, wdtrainM, wdtrainM1)
774    call add_array_r2(cv3a_uncompress_list, qtc, qtc1)
775    call add_array_r2(cv3a_uncompress_list, sigt, sigt1)
776    call add_array_r1(cv3a_uncompress_list, epmax_diag, epmax_diag1)
777    call add_array_r1(cv3a_uncompress_list, sig(:, nd), sig1(:, nd))
778    call cv3a_uncompress(len, compress_data, cv3a_uncompress_list)
[1992]779
[3758]780    IF (prt_level >= 10) THEN
781      Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
782        ft1(igout, 1), ftd1(igout, 1)
783      Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
784        fq1(igout, 1), fqd1(igout, 1)
785    ENDIF
786    IF (debut) THEN
787      PRINT *, ' cv_uncompress -> '
788      debut = .FALSE.
[1992]789    END IF
790
[3758]791    ftra1(:,:,:) = 0
[1992]792
[3758]793  END SUBROUTINE
[1992]794
[3758]795  subroutine driver_log(message)
796    use print_control_mod, only: prt_level
797    character(*) :: message
798    if (prt_level >= 9) PRINT *, 'cva_driver ->', message
799  end subroutine
800end module
Note: See TracBrowser for help on using the repository browser.