source: LMDZ6/trunk/libf/phylmdiso/cva_driver.F90 @ 3929

Last change on this file since 3929 was 3927, checked in by Laurent Fairhead, 3 years ago

Initial import of the physics wih isotopes from Camille Risi
CR

File size: 69.4 KB
RevLine 
[3927]1
2! $Id: cva_driver.F90 3670 2020-04-27 08:49:09Z jyg $
3
4SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, k_upper, &
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, &  ! jyg
7                      delt, comp_threshold, &                                      ! jyg
8                      t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &          ! jyg
9                      u1, v1, tra1, &
10                      p1, ph1, &
11                      Ale1, Alp1, omega1, &
12                      sig1feed1, sig2feed1, wght1, &
13                      iflag1, ft1, fq1, fu1, fv1, ftra1, &
14                      precip1, kbas1, ktop1, &
15                      cbmf1, plcl1, plfc1, wbeff1, &
16                      sig1, w01, & !input/output
17                      ptop21, sigd1, &
18                      ma1, mip1, Vprecip1, Vprecipi1, upwd1, dnwd1, dnwd01, &      ! jyg
19                      qcondc1, wd1, &
20                      cape1, cin1, tvp1, &
21                      ftd1, fqd1, &
22                      Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
23                      lalim_conv1, &
24!!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
25!!                      elij1,evap1,ep1,epmlmMm1,eplaMm1, &                ! RomP
26                      da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
27                      qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP, RL
28                      wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &     !!jygprl
29                      coefw_cld_cv, &                                      ! RomP, AJ
30                      epmax_diag1 &  ! epmax_cape
31#ifdef ISO
32     &                  ,xt1,xt1_wake,fxt1, xtprecip1 &
33     &                  ,xtVprecip1,xtVprecipi1 &
34     &                  ,xtclw1,fxtd1,xtevap1,xtwdtrainA1 &
35#ifdef DIAGISO
36     &          , water1,xtwater1,qp1,xtp1 &
37     &          , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
38     &          , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1,fxt_evapprecip1 &
39     &          , f_detrainement1,q_detrainement1,xt_detrainement1 &
40#endif     
41#endif
42     &         )  ! epmax_cape
43! **************************************************************
44! *
45! CV_DRIVER                                                   *
46! *
47! *
48! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
49! modified by :                                               *
50! **************************************************************
51! **************************************************************
52
53  USE print_control_mod, ONLY: prt_level, lunout
54  USE add_phys_tend_mod, ONLY: fl_cor_ebil
55#ifdef ISO
56  USE infotrac_phy, ONLY: ntraciso,niso,niso,index_trac,ntraceurs_zone
57  USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
58#ifdef ISOVERIF
59    use isotopes_verif_mod
60!, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
61!&       iso_verif_egalite_choix,iso_verif_aberrant_choix,iso_verif_aberrant, &
62!&       iso_verif_egalite,iso_verif_noNaN,iso_verif_positif_nostop,iso_verif_noNaN_nostop
63#endif
64#ifdef ISOTRAC
65    use isotrac_mod, only: option_traceurs,izone_ddft,izone_revap, &
66&       izone_poubelle, index_zone,option_tmin,izone_cond
67#ifdef ISOVERIF
68  USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
69&       iso_verif_trac_masse_vect
70    use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
71#endif
72#endif
73#endif
74  IMPLICIT NONE
75
76! .............................START PROLOGUE............................
77
78
79! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
80! The "1" is removed for the corresponding compressed variables.
81! PARAMETERS:
82! Name            Type         Usage            Description
83! ----------      ----------     -------  ----------------------------
84
85! len           Integer        Input        first (i) dimension
86! nd            Integer        Input        vertical (k) dimension
87! ndp1          Integer        Input        nd + 1
88! ntra          Integer        Input        number of tracors
89! nloc          Integer        Input        dimension of arrays for compressed fields
90! k_upper       Integer        Input        upmost level for vertical loops
91! iflag_con     Integer        Input        version of convect (3/4)
92! iflag_mix     Integer        Input        version of mixing  (0/1/2)
93! iflag_ice_thermo Integer        Input        accounting for ice thermodynamics (0/1)
94! iflag_clos    Integer        Input        version of closure (0/1)
95! tau_cld_cv    Real           Input        characteristic time of dissipation of mixing fluxes
96! coefw_cld_cv  Real           Input        coefficient for updraft velocity in convection
97! ok_conserv_q  Logical        Input        when true corrections for water conservation are swtiched on
98! delt          Real           Input        time step
99! comp_threshold Real           Input       threshold on the fraction of convective points below which
100!                                            fields  are compressed
101! t1            Real           Input        temperature (sat draught envt)
102! q1            Real           Input        specific hum (sat draught envt)
103! qs1           Real           Input        sat specific hum (sat draught envt)
104! t1_wake       Real           Input        temperature (unsat draught envt)
105! q1_wake       Real           Input        specific hum(unsat draught envt)
106! qs1_wake      Real           Input        sat specific hum(unsat draughts envt)
107! s1_wake       Real           Input        fractionnal area covered by wakes
108! u1            Real           Input        u-wind
109! v1            Real           Input        v-wind
110! tra1          Real           Input        tracors
111! p1            Real           Input        full level pressure
112! ph1           Real           Input        half level pressure
113! ALE1          Real           Input        Available lifting Energy
114! ALP1          Real           Input        Available lifting Power
115! sig1feed1     Real           Input        sigma coord at lower bound of feeding layer
116! sig2feed1     Real           Input        sigma coord at upper bound of feeding layer
117! wght1         Real           Input        weight density determining the feeding mixture
118! iflag1        Integer        Output       flag for Emanuel conditions
119! ft1           Real           Output       temp tend
120! fq1           Real           Output       spec hum tend
121! fu1           Real           Output       u-wind tend
122! fv1           Real           Output       v-wind tend
123! ftra1         Real           Output       tracor tend
124! precip1       Real           Output       precipitation
125! kbas1         Integer        Output       cloud base level
126! ktop1         Integer        Output       cloud top level
127! cbmf1         Real           Output       cloud base mass flux
128! sig1          Real           In/Out       section adiabatic updraft
129! w01           Real           In/Out       vertical velocity within adiab updraft
130! ptop21        Real           In/Out       top of entraining zone
131! Ma1           Real           Output       mass flux adiabatic updraft
132! mip1          Real           Output       mass flux shed by the adiabatic updraft
133! Vprecip1      Real           Output       vertical profile of total precipitation
134! Vprecipi1     Real           Output       vertical profile of ice precipitation
135! upwd1         Real           Output       total upward mass flux (adiab+mixed)
136! dnwd1         Real           Output       saturated downward mass flux (mixed)
137! dnwd01        Real           Output       unsaturated downward mass flux
138! qcondc1       Real           Output       in-cld mixing ratio of condensed water
139! wd1           Real           Output       downdraft velocity scale for sfc fluxes
140! cape1         Real           Output       CAPE
141! cin1          Real           Output       CIN
142! tvp1          Real           Output       adiab lifted parcell virt temp
143! ftd1          Real           Output       precip temp tend
144! fqt1          Real           Output       precip spec hum tend
145! Plim11        Real           Output
146! Plim21        Real           Output
147! asupmax1      Real           Output
148! supmax01      Real           Output
149! asupmaxmin1   Real           Output
150
151! ftd1          Real           Output  Array of temperature tendency due to precipitations (K/s) of dimension ND,
152!                                      defined at same grid levels as T, Q, QS and P.
153
154! fqd1          Real           Output  Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
155!                                      of dimension ND, defined at same grid levels as T, Q, QS and P.
156
157! wdtrainA1     Real           Output   precipitation ejected from adiabatic draught;
158!                                         should be used in tracer transport (cvltr)
159! wdtrainS1     Real           Output   precipitation detrained from shedding of adiabatic draught;
160!                                         used in tracer transport (cvltr)
161! wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
162!                                         used in tracer transport (cvltr)
163! da1           Real           Output     used in tracer transport (cvltr)
164! phi1          Real           Output     used in tracer transport (cvltr)
165! mp1           Real           Output     used in tracer transport (cvltr)
166! qtc1          Real           Output     specific humidity in convection
167! sigt1         Real           Output     surface fraction in adiabatic updrafts                                         
168! phi21         Real           Output     used in tracer transport (cvltr)
169                                         
170! d1a1          Real           Output     used in tracer transport (cvltr)
171! dam1          Real           Output     used in tracer transport (cvltr)
172                                         
173! epmlmMm1      Real           Output     used in tracer transport (cvltr)
174! eplaMm1       Real           Output     used in tracer transport (cvltr)
175                                         
176! evap1         Real           Output   
177! ep1           Real           Output   
178! sigij1        Real           Output     used in tracer transport (cvltr)
179! clw1          Real           Output   condensed water content of the adiabatic updraught
180! elij1         Real           Output
181! wghti1        Real           Output   final weight of the feeding layers,
182!                                         used in tracer transport (cvltr)
183
184
185! S. Bony, Mar 2002:
186! * Several modules corresponding to different physical processes
187! * Several versions of convect may be used:
188!         - iflag_con=3: version lmd  (previously named convect3)
189!         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
190! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
191! S. Bony, Oct 2002:
192! * Vectorization of convect3 (ie version lmd)
193
194! ..............................END PROLOGUE.............................
195
196
197
198! Input
199  INTEGER, INTENT (IN)                               :: len
200  INTEGER, INTENT (IN)                               :: nd
201  INTEGER, INTENT (IN)                               :: ndp1
202  INTEGER, INTENT (IN)                               :: ntra
203  INTEGER, INTENT(IN)                                :: nloc ! (nloc=len)  pour l'instant
204  INTEGER, INTENT (IN)                               :: k_upper
205  INTEGER, INTENT (IN)                               :: iflag_con
206  INTEGER, INTENT (IN)                               :: iflag_mix
207  INTEGER, INTENT (IN)                               :: iflag_ice_thermo
208  INTEGER, INTENT (IN)                               :: iflag_clos
209  LOGICAL, INTENT (IN)                               :: ok_conserv_q
210  REAL, INTENT (IN)                                  :: tau_cld_cv
211  REAL, INTENT (IN)                                  :: coefw_cld_cv
212  REAL, INTENT (IN)                                  :: delt
213  REAL, INTENT (IN)                                  :: comp_threshold
214  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1
215  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1
216  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1
217  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake
218  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1_wake
219  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1_wake
220  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
221  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1
222  REAL, DIMENSION (len, nd), INTENT (IN)             :: v1
223  REAL, DIMENSION (len, nd, ntra), INTENT (IN)       :: tra1
224  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
225  REAL, DIMENSION (len, ndp1), INTENT (IN)           :: ph1
226  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1
227  REAL, DIMENSION (len), INTENT (IN)                 :: Alp1
228  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
229  REAL, INTENT (IN)                                  :: sig1feed1 ! pressure at lower bound of feeding layer
230  REAL, INTENT (IN)                                  :: sig2feed1 ! pressure at upper bound of feeding layer
231  REAL, DIMENSION (nd), INTENT (IN)                  :: wght1     ! weight density determining the feeding mixture
232  INTEGER, DIMENSION (len), INTENT (IN)              :: lalim_conv1
233
234! Input/Output
235  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: sig1
236  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: w01
237
238! Output
239  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1
240  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1
241  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fq1
242  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fu1
243  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fv1
244  REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
245  REAL, DIMENSION (len), INTENT (OUT)                :: precip1
246  INTEGER, DIMENSION (len), INTENT (OUT)             :: kbas1
247  INTEGER, DIMENSION (len), INTENT (OUT)             :: ktop1
248  REAL, DIMENSION (len), INTENT (OUT)                :: cbmf1
249  REAL, DIMENSION (len), INTENT (OUT)                :: plcl1
250  REAL, DIMENSION (len), INTENT (OUT)                :: plfc1
251  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
252  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
253  REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
254  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1        ! adiab. asc. mass flux (staggered grid)
255  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mip1       ! mass flux shed from adiab. ascent (extensive)
256! real Vprecip1(len,nd)
257  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecip1   ! tot precipitation flux (staggered grid)
258  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecipi1  ! ice precipitation flux (staggered grid)
259  REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1      ! upwd sat. mass flux (staggered grid)
260  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd1      ! dnwd sat. mass flux (staggered grid)
261  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd01     ! unsat. mass flux (staggered grid)
262  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1    ! max cloud condensate (intensive)  ! cld
263  REAL, DIMENSION (len), INTENT (OUT)                :: wd1             ! gust
264  REAL, DIMENSION (len), INTENT (OUT)                :: cape1
265  REAL, DIMENSION (len), INTENT (OUT)                :: cin1
266  REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1       ! Virt. temp. in the adiab. ascent
267
268!AC!
269!!      real da1(len,nd),phi1(len,nd,nd)
270!!      real da(len,nd),phi(len,nd,nd)
271!AC!
272  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1       ! Temp. tendency due to the sole unsat. drafts
273  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqd1       ! Moist. tendency due to the sole unsat. drafts
274  REAL, DIMENSION (len), INTENT (OUT)                :: Plim11
275  REAL, DIMENSION (len), INTENT (OUT)                :: Plim21
276  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1   ! Highest mixing fraction of mixed updraughts
277  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01
278  REAL, DIMENSION (len), INTENT (OUT)                :: asupmaxmin1
279  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1    ! in cloud water content (intensive)   ! cld
280  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1   ! fract. cloud area (intensive)        ! cld
281
282! RomP >>>
283  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainS1, wdtrainM1 ! precipitation sources (extensive)
284  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mp1  ! unsat. mass flux (staggered grid)
285  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1  ! detrained mass flux of adiab. asc. air (extensive)
286  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
287  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1  ! (extensive)
288  REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplaMm1   ! (extensive)
289  REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1 ! evaporation rate in precip. downdraft. (intensive)
290  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ep1
291  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
292  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: elij1! cond. water per unit mass of mixed draughts (intensive)
293  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qta1 ! total water per unit mass of the adiab. asc. (intensive)
294  REAL, DIMENSION (len, nd), INTENT (OUT)            :: clw1 ! cond. water per unit mass of the adiab. asc. (intensive)
295!JYG,RL
296  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti1   ! final weight of the feeding layers (extensive)
297!JYG,RL
298  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21    ! (extensive)
299  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1     ! (extensive)
300  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dam1     ! (extensive)
301! RomP <<<
302  REAL, DIMENSION (len ), INTENT (OUT)               :: epmax_diag1       
303#ifdef ISO
304      real, DIMENSION(ntraciso,len,nd), INTENT (IN)    :: xt1
305      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: fxt1
306      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: xt1_wake
307      real, DIMENSION(ntraciso,len), INTENT (OUT)      :: xtprecip1
308      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)   :: fxtd1
309      real, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecip1
310      real, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecipi1
311      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtwdtrainA1
312      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtevap1
313      REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT)            :: xtclw1
314      REAL, DIMENSION (ntraciso,len, nd, nd)        :: xtelij1  ! pas besoin de le sortir?
315#ifdef DIAGISO
316      real, DIMENSION(len,nd), INTENT (OUT)             ::   water1
317      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xtwater1
318      real, DIMENSION(len,nd), INTENT (OUT)             ::   qp1
319      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)    ::   xtp1
320      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_detrainement1
321      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_ddft1
322      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_fluxmasse1
323      real, DIMENSION(len,nd), INTENT (OUT)             ::   fq_evapprecip1
324      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_detrainement1
325      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_ddft1
326      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_fluxmasse1
327      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   fxt_evapprecip1
328      real, DIMENSION(len,nd), INTENT (OUT)             ::   f_detrainement1
329      real, DIMENSION(len,nd), INTENT (OUT)             ::   q_detrainement1
330      real, DIMENSION(ntraciso,len,nd), INTENT (OUT)        ::   xt_detrainement1
331!      real mentbas1(len,nd)
332!      real qentbas1(len,nd), xtentbas1(niso,len,nd)
333#endif
334#endif
335
336
337! -------------------------------------------------------------------
338! Prolog by Kerry Emanuel.
339! -------------------------------------------------------------------
340! --- ARGUMENTS
341! -------------------------------------------------------------------
342! --- On input:
343
344! t:   Array of absolute temperature (K) of dimension ND, with first
345! index corresponding to lowest model level. Note that this array
346! will be altered by the subroutine if dry convective adjustment
347! occurs and if IPBL is not equal to 0.
348
349! q:   Array of specific humidity (gm/gm) of dimension ND, with first
350! index corresponding to lowest model level. Must be defined
351! at same grid levels as T. Note that this array will be altered
352! if dry convective adjustment occurs and if IPBL is not equal to 0.
353
354! qs:  Array of saturation specific humidity of dimension ND, with first
355! index corresponding to lowest model level. Must be defined
356! at same grid levels as T. Note that this array will be altered
357! if dry convective adjustment occurs and if IPBL is not equal to 0.
358
359! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
360! of dimension ND, with first index corresponding to lowest model level.
361
362! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
363! of dimension ND, with first index corresponding to lowest model level.
364! Must be defined at same grid levels as T.
365
366! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
367! of dimension ND, with first index corresponding to lowest model level.
368! Must be defined at same grid levels as T.
369
370! s_wake: Array of fractionnal area occupied by the wakes.
371
372! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
373! index corresponding with the lowest model level. Defined at
374! same levels as T. Note that this array will be altered if
375! dry convective adjustment occurs and if IPBL is not equal to 0.
376
377! v:   Same as u but for meridional velocity.
378
379! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
380! where NTRA is the number of different tracers. If no
381! convective tracer transport is needed, define a dummy
382! input array of dimension (ND,1). Tracers are defined at
383! same vertical levels as T. Note that this array will be altered
384! if dry convective adjustment occurs and if IPBL is not equal to 0.
385
386! p:   Array of pressure (mb) of dimension ND, with first
387! index corresponding to lowest model level. Must be defined
388! at same grid levels as T.
389
390! ph:  Array of pressure (mb) of dimension ND+1, with first index
391! corresponding to lowest level. These pressures are defined at
392! levels intermediate between those of P, T, Q and QS. The first
393! value of PH should be greater than (i.e. at a lower level than)
394! the first value of the array P.
395
396! ALE:  Available lifting Energy
397
398! ALP:  Available lifting Power
399
400! nl:  The maximum number of levels to which convection can penetrate, plus 1.
401!       NL MUST be less than or equal to ND-1.
402
403! delt: The model time step (sec) between calls to CONVECT
404
405! ----------------------------------------------------------------------------
406! ---   On Output:
407
408! iflag: An output integer whose value denotes the following:
409!       VALUE   INTERPRETATION
410!       -----   --------------
411!         0     Moist convection occurs.
412!         1     Moist convection occurs, but a CFL condition
413!               on the subsidence warming is violated. This
414!               does not cause the scheme to terminate.
415!         2     Moist convection, but no precip because ep(inb) lt 0.0001
416!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
417!         4     No moist convection; atmosphere is not
418!               unstable
419!         6     No moist convection because ihmin le minorig.
420!         7     No moist convection because unreasonable
421!               parcel level temperature or specific humidity.
422!         8     No moist convection: lifted condensation
423!               level is above the 200 mb level.
424!         9     No moist convection: cloud base is higher
425!               then the level NL-1.
426!        10     No moist convection: cloud top is too warm.
427!        14     No moist convection; atmosphere is very
428!               stable (=> no computation)
429!
430
431! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
432!       grid levels as T, Q, QS and P.
433
434! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
435!       defined at same grid levels as T, Q, QS and P.
436
437! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
438!      defined at same grid levels as T.
439
440! fv:   Same as FU, but for forcing of meridional velocity.
441
442! ftra: Array of forcing of tracer content, in tracer mixing ratio per
443!       second, defined at same levels as T. Dimensioned (ND,NTRA).
444
445! precip: Scalar convective precipitation rate (mm/day).
446
447! wd:   A convective downdraft velocity scale. For use in surface
448!       flux parameterizations. See convect.ps file for details.
449
450! tprime: A convective downdraft temperature perturbation scale (K).
451!         For use in surface flux parameterizations. See convect.ps
452!         file for details.
453
454! qprime: A convective downdraft specific humidity
455!         perturbation scale (gm/gm).
456!         For use in surface flux parameterizations. See convect.ps
457!         file for details.
458
459! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
460!       BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
461!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
462!       by the calling program between calls to CONVECT.
463
464! det:   Array of detrainment mass flux of dimension ND.
465! -------------------------------------------------------------------
466
467! Local (non compressed) arrays
468
469
470  INTEGER i, k, il
471  INTEGER nword1, nword2, nword3, nword4
472  INTEGER icbmax
473  INTEGER nk1(len)
474  INTEGER icb1(len)
475  INTEGER icbs1(len)
476
477  LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
478  LOGICAL, SAVE :: debut = .TRUE.
479!$OMP THREADPRIVATE(debut)
480
481  REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
482  REAL tnk1(len)
483  REAL thnk1(len)
484  REAL qnk1(len)
485  REAL gznk1(len)
486  REAL qsnk1(len)
487  REAL unk1(len)
488  REAL vnk1(len)
489  REAL cpnk1(len)
490  REAL hnk1(len)
491  REAL pbase1(len)
492  REAL buoybase1(len)
493
494  REAL lf1(len, nd), lf1_wake(len, nd)
495  REAL lv1(len, nd), lv1_wake(len, nd)
496  REAL cpn1(len, nd), cpn1_wake(len, nd)
497  REAL tv1(len, nd), tv1_wake(len, nd)
498  REAL gz1(len, nd), gz1_wake(len, nd)
499  REAL hm1(len, nd)
500  REAL h1(len, nd), h1_wake(len, nd)
501  REAL tp1(len, nd)
502  REAL th1(len, nd), th1_wake(len, nd)
503
504  REAL bid(len, nd) ! dummy array
505
506#ifdef ISO
507      integer ixt
508      real xtnk1(ntraciso,len)
509#endif
510
511
512  INTEGER ncum
513
514  REAL p1feed1(len) ! pressure at lower bound of feeding layer
515  REAL p2feed1(len) ! pressure at upper bound of feeding layer
516!JYG,RL
517!!      real wghti1(len,nd) ! weights of the feeding layers
518!JYG,RL
519
520! (local) compressed fields:
521
522
523  INTEGER idcum(nloc)
524!jyg<
525  LOGICAL compress    ! True if compression occurs
526!>jyg
527  INTEGER iflag(nloc), nk(nloc), icb(nloc)
528  INTEGER nent(nloc, nd)
529  INTEGER icbs(nloc)
530  INTEGER inb(nloc), inbis(nloc)
531
532  REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
533  REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
534  REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
535  REAL s_wake(nloc)
536  REAL u(nloc, nd), v(nloc, nd)
537  REAL gz(nloc, nd), h(nloc, nd)
538  REAL h_wake(nloc, nd)
539  REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
540  REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
541  REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
542  REAL tv_wake(nloc, nd)
543  REAL clw(nloc, nd)
544  REAL, DIMENSION(nloc, nd)    :: qta, qpreca                       !!jygprl
545  REAL dph(nloc, nd)
546  REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
547  REAL th_wake(nloc, nd)
548  REAL tvp(nloc, nd)
549  REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
550  REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
551  REAL buoy(nloc, nd)
552  REAL cape(nloc)
553  REAL cin(nloc)
554  REAL m(nloc, nd)
555  REAL mm(nloc, nd)
556  REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
557  REAL qent(nloc, nd, nd)
558  REAL hent(nloc, nd, nd)
559  REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
560  REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
561  REAL elij(nloc, nd, nd)
562  REAL supmax(nloc, nd)
563  REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
564  REAL omega(nloc,nd)
565  REAL sigd(nloc)
566! real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
567! real wt(nloc,nd), water(nloc,nd), evap(nloc,nd), ice(nloc,nd)
568! real b(nloc,nd), sigd(nloc)
569! save mp,qp,up,vp,wt,water,evap,b
570  REAL, DIMENSION(len,nd)     :: mp, qp, up, vp
571  REAL, DIMENSION(len,nd)     :: wt, water, evap
572  REAL, DIMENSION(len,nd)     :: ice, fondue, b
573  REAL, DIMENSION(len,nd)     :: frac_a, frac_s, faci               !!jygprl
574  REAL ft(nloc, nd), fq(nloc, nd)
575  REAL ftd(nloc, nd), fqd(nloc, nd)
576  REAL fu(nloc, nd), fv(nloc, nd)
577  REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
578  REAL ma(nloc, nd), mip(nloc, nd)
579!!  REAL tls(nloc, nd), tps(nloc, nd)                 ! unused . jyg
580  REAL qprime(nloc), tprime(nloc)
581  REAL precip(nloc)
582! real Vprecip(nloc,nd)
583  REAL vprecip(nloc, nd+1)
584  REAL vprecipi(nloc, nd+1)
585  REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
586  REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
587  REAL qcondc(nloc, nd)      ! cld
588  REAL wd(nloc)                ! gust
589  REAL Plim1(nloc), plim2(nloc)
590  REAL asupmax(nloc, nd)
591  REAL supmax0(nloc)
592  REAL asupmaxmin(nloc)
593
594  REAL tnk(nloc), qnk(nloc), gznk(nloc)
595  REAL wghti(nloc, nd)
596  REAL hnk(nloc), unk(nloc), vnk(nloc)
597
598  REAL qtc(nloc, nd)         ! cld
599  REAL sigt(nloc, nd)        ! cld
600 
601! RomP >>>
602  REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd)   !!jygprl
603  REAL da(len, nd), phi(len, nd, nd)
604  REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
605  REAL phi2(len, nd, nd)
606  REAL d1a(len, nd), dam(len, nd)
607! RomP <<<
608  REAL epmax_diag(nloc) ! epmax_cape
609
610  CHARACTER (LEN=20) :: modname = 'cva_driver'
611  CHARACTER (LEN=80) :: abort_message
612
613  REAL, PARAMETER    :: Cin_noconv = -100000.
614  REAL, PARAMETER    :: Cape_noconv = -1.
615
616  INTEGER,SAVE                                       :: igout=1
617!$OMP THREADPRIVATE(igout)
618
619#ifdef ISO
620      real xt(ntraciso,nloc,nd)
621      REAL, DIMENSION(ntraciso,nloc, nd)    :: xtta
622      real xt_wake(ntraciso,nloc,nd)
623      real xtclw(ntraciso,nloc,nd)
624      real xtp(ntraciso,nloc,nd)
625      real xtent(ntraciso,nloc,nd,nd)
626      real xtelij(ntraciso,nloc,nd,nd)
627      real xtwater(ntraciso,nloc,nd)
628      real xtice(ntraciso,nloc,nd)
629      real xtevap(ntraciso,nloc,nd)
630      real fxt(ntraciso,nloc,nd)
631      real fxtd(ntraciso,nloc,nd)
632      real xtprecip(ntraciso,nloc)
633      real xtnk(ntraciso,nloc)
634      real xtVprecip(ntraciso,nloc,nd+1)
635      real xtVprecipi(ntraciso,nloc,nd+1)
636      real xtwdtrainA(niso,nloc,nd)
637#ifdef DIAGISO
638      real fxt_detrainement(niso,nloc,nd)
639      real fxt_fluxmasse(niso,nloc,nd)
640      real fxt_evapprecip(niso,nloc,nd)
641      real fxt_ddft(niso,nloc,nd)
642      real fq_detrainement(nloc,nd)
643      real fq_fluxmasse(nloc,nd)
644      real fq_evapprecip(nloc,nd)
645      real fq_ddft(nloc,nd)
646      real f_detrainement(nloc,nd)
647      real q_detrainement(nloc,nd)
648      real xt_detrainement(niso,nloc,nd)
649#endif
650#ifdef ISOTRAC
651      integer iiso,ixt_ddft,ixt_poubelle,ixt_revap
652      integer izone
653#endif
654#ifdef ISOVERIF
655      integer j
656#endif
657#endif 
658
659
660! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd)
661! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
662
663! -------------------------------------------------------------------
664! --- SET CONSTANTS AND PARAMETERS
665! -------------------------------------------------------------------
666
667! -- set simulation flags:
668! (common cvflag)
669
670  CALL cv_flag(iflag_ice_thermo)
671
672! -- set thermodynamical constants:
673! (common cvthermo)
674
675  CALL cv_thermo(iflag_con)
676
677! -- set convect parameters
678
679! includes microphysical parameters and parameters that
680! control the rate of approach to quasi-equilibrium)
681! (common cvparam)
682
683  IF (iflag_con==3) THEN
684    CALL cv3_param(nd, k_upper, delt)
685
686  END IF
687
688  IF (iflag_con==4) THEN
689    CALL cv_param(nd)
690#ifdef ISO
691       CALL abort_physic('cva_driver 555', 'isos pas prevus ici', 1)
692#endif
693  END IF
694
695! ---------------------------------------------------------------------
696! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
697! ---------------------------------------------------------------------
698  nword1 = len
699  nword2 = len*nd
700  nword3 = len*nd*ntra
701  nword4 = len*nd*nd
702
703  iflag1(:) = 0
704  ktop1(:) = 0
705  kbas1(:) = 0
706  ft1(:, :) = 0.0
707  fq1(:, :) = 0.0
708  fu1(:, :) = 0.0
709  fv1(:, :) = 0.0
710  ftra1(:, :, :) = 0.
711  precip1(:) = 0.
712  cbmf1(:) = 0.
713  plcl1(:) = 0.
714  plfc1(:) = 0.
715  wbeff1(:) = 0.
716  ptop21(:) = 0.
717  sigd1(:) = 0.
718  ma1(:, :) = 0.
719  mip1(:, :) = 0.
720  vprecip1(:, :) = 0.
721  vprecipi1(:, :) = 0.
722  upwd1(:, :) = 0.
723  dnwd1(:, :) = 0.
724  dnwd01(:, :) = 0.
725  qcondc1(:, :) = 0.
726  wd1(:) = 0.
727  cape1(:) = 0.
728  cin1(:) = 0.
729  tvp1(:, :) = 0.
730  ftd1(:, :) = 0.
731  fqd1(:, :) = 0.
732  Plim11(:) = 0.
733  Plim21(:) = 0.
734  asupmax1(:, :) = 0.
735  supmax01(:) = 0.
736  asupmaxmin1(:) = 0.
737#ifdef ISO
738  xtprecip1(:, :) = 0.
739  fxt1(:,:,  :) = 0.0
740  xtvprecip1(:,:, :) = 0.
741  xtvprecipi1(:,:, :) = 0.
742  fxtd1(:,:, :) = 0.
743#endif
744
745  tvp(:, :) = 0. !ym missing init, need to have a look by developpers
746  tv(:, :) = 0. !ym missing init, need to have a look by developpers
747
748  DO il = 1, len
749!!    cin1(il) = -100000.
750!!    cape1(il) = -1.
751    cin1(il) = Cin_noconv
752    cape1(il) = Cape_noconv
753  END DO
754
755!!  IF (iflag_con==3) THEN
756!!    DO il = 1, len
757!!      sig1(il, nd) = sig1(il, nd) + 1.
758!!      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
759!!    END DO
760!!  END IF
761
762  IF (iflag_con==3) THEN
763      CALL cv3_incrcount(len,nd,delt,sig1)
764  END IF  ! (iflag_con==3)
765
766! RomP >>>
767  sigt1(:, :) = 0.
768  qtc1(:, :) = 0.
769  wdtrainA1(:, :) = 0.
770  wdtrainS1(:, :) = 0.
771  wdtrainM1(:, :) = 0.
772  da1(:, :) = 0.
773  phi1(:, :, :) = 0.
774  epmlmMm1(:, :, :) = 0.
775  eplaMm1(:, :) = 0.
776  mp1(:, :) = 0.
777  evap1(:, :) = 0.
778  ep1(:, :) = 0.
779  sigij1(:, :, :) = 0.
780  elij1(:, :, :) = 0.
781  qta1(:,:) = 0.
782  clw1(:,:) = 0.
783  wghti1(:,:) = 0.
784  phi21(:, :, :) = 0.
785  d1a1(:, :) = 0.
786  dam1(:, :) = 0.
787  m(:,:)=0. ! C Risi
788#ifdef ISO
789  xtwdtrainA1(:,:, :) = 0.
790  xtevap1(:,:, :) = 0.
791  xtelij1(:,:, :, :) = 0.
792  xtclw1(:,:,:) = 0.
793  q(:,:)=0.0 ! securite pour check plus bas
794  xt(:,:,:)=0.0 ! securite pour check plus bas
795  q_wake(:,:)=0.0 ! securite pour check plus bas
796  xt_wake(:,:,:)=0.0 ! securite pour check plus bas
797  clw(:,:)=0.0 ! securite pour check plus bas
798  xtclw(:,:,:)=0.0 ! securite pour check plus bas
799#endif
800! RomP <<<
801! ---------------------------------------------------------------------
802! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
803! ---------------------------------------------------------------------
804
805  DO il = 1, nloc
806    coef_clos(il) = 1.
807  END DO
808
809! --------------------------------------------------------------------
810! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
811! --------------------------------------------------------------------
812
813  IF (iflag_con==3) THEN
814
815    IF (debut) THEN
816      PRINT *, 'Emanuel version 3 nouvelle'
817    END IF
818! print*,'t1, q1 ',t1,q1
819        if (prt_level >= 9) &
820             PRINT *, 'cva_driver -> cv3_prelim'
821    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
822                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
823
824
825        if (prt_level >= 9) &
826             PRINT *, 'cva_driver -> cv3_prelim'
827    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
828                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
829                    h1_wake, bid, th1_wake)
830
831  END IF
832
833  IF (iflag_con==4) THEN
834    PRINT *, 'Emanuel version 4 '
835        if (prt_level >= 9) &
836             PRINT *, 'cva_driver -> cv_prelim'
837    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
838                   lv1, cpn1, tv1, gz1, h1, hm1)
839  END IF
840
841! --------------------------------------------------------------------
842! --- CONVECTIVE FEED
843! --------------------------------------------------------------------
844
845! compute feeding layer potential temperature and mixing ratio :
846
847! get bounds of feeding layer
848
849! test niveaux couche alimentation KE
850  IF (sig1feed1==sig2feed1) THEN
851    WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
852    WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
853    abort_message = ''
854    CALL abort_physic(modname, abort_message, 1)
855  END IF
856
857  DO i = 1, len
858    p1feed1(i) = sig1feed1*ph1(i, 1)
859    p2feed1(i) = sig2feed1*ph1(i, 1)
860!test maf
861!   p1feed1(i)=ph1(i,1)
862!   p2feed1(i)=ph1(i,2)
863!   p2feed1(i)=ph1(i,3)
864!testCR: on prend la couche alim des thermiques
865!   p2feed1(i)=ph1(i,lalim_conv1(i)+1)
866!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
867  END DO
868
869  IF (iflag_con==3) THEN
870  END IF
871  DO i = 1, len
872! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
873  END DO
874  IF (iflag_con==3) THEN
875
876! print*, 'IFLAG1 avant cv3_feed'
877! print*,'len,nd',len,nd
878! write(*,'(64i1)') iflag1(2:len-1)
879
880        if (prt_level >= 9) &
881             PRINT *, 'cva_driver -> cv3_feed'
882    CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
883                  t1, q1, u1, v1, p1, ph1, h1, gz1, &
884                  p1feed1, p2feed1, wght1, &
885                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
886                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1 &
887#ifdef ISO
888     &                  ,xt1,xtnk1   &
889#endif     
890     &   )
891  END IF
892
893! print*, 'IFLAG1 apres cv3_feed'
894! print*,'len,nd',len,nd
895! write(*,'(64i1)') iflag1(2:len-1)
896
897  IF (iflag_con==4) THEN
898        if (prt_level >= 9) &
899             PRINT *, 'cva_driver -> cv_feed'
900    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
901                 nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
902  END IF
903
904! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
905
906! --------------------------------------------------------------------
907! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
908! (up through ICB for convect4, up through ICB+1 for convect3)
909! Calculates the lifted parcel virtual temperature at nk, the
910! actual temperature, and the adiabatic liquid water content.
911! --------------------------------------------------------------------
912
913  IF (iflag_con==3) THEN
914
915        if (prt_level >= 9) &
916             PRINT *, 'cva_driver -> cv3_undilute1'
917
918#ifdef ISO
919#ifdef ISOVERIF
920       write(*,*) 'cva_driver 593: avant cv3_undilute1'
921       if (iso_HDO.gt.0) then   
922       do k=1,nd       
923         do i=1,len           
924           if (q1(i,k).gt.ridicule) then
925            call iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
926     &            'cva_driver 502')
927           endif ! if (q1(i,k).gt.ridicule) then
928          enddo !do i=1,len
929        enddo !do k=1,nd   
930        endif !if (iso_HDO.gt.0) then
931        if (iso_eau.gt.0) then                     
932          do i=1,len
933            do k=1,nd
934              call iso_verif_egalite(xt1(iso_eau,i,k),q1(i,k), &
935     &            'cva_driver 764')
936              call iso_verif_egalite(xt1_wake(iso_eau,i,k),q1_wake(i,k), &
937     &            'cva_driver 766')
938            enddo !do k=1,nd                     
939            call iso_verif_egalite(xtnk1(iso_eau,i),qnk1(i), &
940     &            'cva_driver 777')
941            do ixt=1,ntraciso
942             call iso_verif_noNaN(xtnk1(ixt,i),'cva_driver 784')
943            enddo ! do ixt=1,ntraciso
944           enddo !do i=1,len
945         endif !if (iso_eau.gt.0) then
946#ifdef ISOTRAC
947         do k=1,nd       
948          do i=1,len
949           call iso_verif_traceur(xt1(1,i,k),'cva_driver 601')
950          enddo !do i=1,len
951         enddo !do k=1,nd
952#endif     
953#endif
954#endif
955
956    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
957                       gznk1, tp1, tvp1, clw1, icbs1 &
958#ifdef ISO
959     &                        ,xtnk1,xtclw1 &
960#endif
961     &                   )
962
963#ifdef ISO
964#ifdef ISOVERIF
965       write(*,*) 'cva_driver 621: après cv3_undilute1'
966       do k=1,nd
967        do i = 1, len
968         if (iso_eau.gt.0) then
969         call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
970     &           'cva_driver 798',errmax,errmaxrel)
971         call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
972     &           'cva_driver 800',errmax,errmaxrel)
973         endif !if (iso_eau.gt.0) then
974         do ixt=1,ntraciso
975           call iso_verif_noNaN(xt1(ixt,i,k),'cva_driver 815')
976         enddo ! do ixt=1,ntraciso
977#ifdef ISOTRAC
978           call iso_verif_traceur(xt1(1,i,k),'cva_driver 623')
979#endif           
980        enddo !do i = 1, len
981       enddo !do k=1,nd
982       do i = 1, len
983         do ixt=1,ntraciso
984           call iso_verif_noNaN(xtnk1(ixt,i),'cva_driver 824')
985         enddo ! do ixt=1,ntraciso
986       enddo !do i = 1, len
987#endif
988       !write(*,*) 'SORTIE DE CV3_UNDILUTE1'
989#endif
990
991  END IF
992
993
994  IF (iflag_con==4) THEN
995        if (prt_level >= 9) &
996             PRINT *, 'cva_driver -> cv_undilute1'
997    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
998                      tp1, tvp1, clw1)
999  END IF
1000
1001! -------------------------------------------------------------------
1002! --- TRIGGERING
1003! -------------------------------------------------------------------
1004
1005! print *,' avant triggering, iflag_con ',iflag_con
1006
1007  IF (iflag_con==3) THEN
1008
1009        if (prt_level >= 9) &
1010             PRINT *, 'cva_driver -> cv3_trigger'
1011    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
1012                      pbase1, buoybase1, iflag1, sig1, w01)
1013
1014
1015! print*, 'IFLAG1 apres cv3_triger'
1016! print*,'len,nd',len,nd
1017! write(*,'(64i1)') iflag1(2:len-1)
1018
1019! call dump2d(iim,jjm-1,sig1(2)
1020  END IF
1021
1022  IF (iflag_con==4) THEN
1023        if (prt_level >= 9) &
1024             PRINT *, 'cva_driver -> cv_trigger'
1025    CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
1026  END IF
1027
1028
1029! =====================================================================
1030! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
1031! =====================================================================
1032
1033!  Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
1034!  gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
1035!  elsewhere).
1036  ncum = 0
1037  coef_convective(:) = 0.
1038  DO i = 1, len
1039    IF (iflag1(i)==0) THEN
1040      coef_convective(i) = 1.
1041      ncum = ncum + 1
1042      idcum(ncum) = i
1043    END IF
1044  END DO
1045
1046! print*,'len, ncum = ',len,ncum
1047
1048  IF (ncum>0) THEN
1049
1050! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1051! --- COMPRESS THE FIELDS
1052!       (-> vectorization over convective gridpoints)
1053! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1054
1055    IF (iflag_con==3) THEN
1056! print*,'ncum tv1 ',ncum,tv1
1057! print*,'tvp1 ',tvp1
1058!jyg<
1059!   If the fraction of convective points is larger than comp_threshold, then compression
1060!   is assumed useless.
1061!
1062  compress = ncum .lt. len*comp_threshold
1063!
1064  IF (.not. compress) THEN
1065    DO i = 1,len
1066      idcum(i) = i
1067    ENDDO
1068  ENDIF
1069!
1070#ifdef ISO
1071#ifdef ISOVERIF
1072       do k=1,nd
1073        do i = 1, nloc
1074        if (iso_eau.gt.0) then
1075            call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
1076     &            'cva_driver 541a',errmax,errmaxrel)
1077            call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
1078     &            'cva_driver 541b',errmax,errmaxrel)
1079        endif !  if (iso_eau.gt.0) then
1080#ifdef ISOTRAC
1081           call iso_verif_traceur(xt1(1,i,k),'cva_driver 689')
1082#endif             
1083        enddo
1084       enddo   
1085#endif
1086#endif
1087
1088!>jyg
1089        if (prt_level >= 9) &
1090             PRINT *, 'cva_driver -> cv3a_compress'
1091      CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
1092                         iflag1, nk1, icb1, icbs1, &
1093                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
1094                         wghti1, pbase1, buoybase1, &
1095                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
1096                         u1, v1, gz1, th1, th1_wake, &
1097                         tra1, &
1098                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
1099                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
1100                         sig1, w01, ptop21, &
1101                         Ale1, Alp1, omega1, &
1102                         iflag, nk, icb, icbs, &
1103                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
1104                         wghti, pbase, buoybase, &
1105                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
1106                         u, v, gz, th, th_wake, &
1107                         tra, &
1108                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
1109                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
1110                         sig, w0, ptop2, &
1111                         Ale, Alp, omega &
1112#ifdef ISO
1113     &    ,xtnk1,xt1,xt1_wake,xtclw1 &
1114     &    ,xtnk,xt,xt_wake,xtclw &
1115#endif
1116     &    )
1117
1118! print*,'tv ',tv
1119! print*,'tvp ',tvp
1120
1121#ifdef ISO
1122#ifdef ISOVERIF
1123       write(*,*) 'cva_driver 720: après cv3_compress'
1124       write(*,*) 'len, nloc, ncum,nd=',len, nloc, ncum,nd
1125       do k=1,nd
1126        do i = 1, ncum
1127         if (iso_eau.gt.0) then
1128            call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
1129     &            'cva_driver 598',errmax,errmaxrel)
1130            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1131     &            'cva_driver 600',errmax,errmaxrel)
1132            call iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
1133     &            'cva_driver 602',errmax,errmaxrel)
1134         endif !  if (iso_eau.gt.0) then
1135         if (iso_HDO.gt.0) then   
1136              call iso_verif_aberrant_choix( &
1137     &            xt(iso_HDO,i,k),q(i,k), &
1138     &            ridicule,deltalim,'cva_driver 735, apres compress')
1139         endif !if (iso_HDO.gt.0) then
1140#ifdef ISOTRAC
1141           call iso_verif_traceur(xt(1,i,k),'cva_driver 726')
1142#endif               
1143        enddo
1144       enddo
1145       do i = 1, ncum
1146        do k=1,nd
1147         call iso_verif_positif(q(i,k),'cva_driver 966a')     
1148        enddo !do k=1,nd
1149         call iso_verif_positif(qnk(i),'cva_driver 966b') 
1150       enddo !do i = 1, ncum
1151       write(*,*) 'cva_driver 1142: après cv3_compress OK'
1152#endif
1153#endif
1154
1155    END IF
1156
1157    IF (iflag_con==4) THEN
1158        if (prt_level >= 9) &
1159             PRINT *, 'cva_driver -> cv_compress'
1160      CALL cv_compress(len, nloc, ncum, nd, &
1161                       iflag1, nk1, icb1, &
1162                       cbmf1, plcl1, tnk1, qnk1, gznk1, &
1163                       t1, q1, qs1, u1, v1, gz1, &
1164                       h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
1165                       iflag, nk, icb, &
1166                       cbmf, plcl, tnk, qnk, gznk, &
1167                       t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
1168                       dph)
1169    END IF
1170
1171! -------------------------------------------------------------------
1172! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
1173! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
1174! ---   &
1175! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
1176! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
1177! ---   &
1178! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
1179! -------------------------------------------------------------------
1180
1181    IF (iflag_con==3) THEN
1182        if (prt_level >= 9) &
1183             PRINT *, 'cva_driver -> cv3_undilute2'
1184      CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &        !na->nd
1185                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
1186                         p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
1187                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
1188                         frac_a, frac_s, qpreca, qta &                        !!jygprl
1189#ifdef ISO
1190     &                   ,xtnk,xt,xtclw,xtta &
1191#endif
1192     &   )
1193#ifdef ISO
1194#ifdef ISOVERIF
1195       do k=1,nd
1196        do i = 1, ncum
1197         if (iso_eau.gt.0) then
1198            call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
1199     &            'cva_driver 650',errmax,errmaxrel)
1200            call iso_verif_egalite_choix(xtta(iso_eau,i,k),qta(i,k), &
1201     &            'cva_driver 651',errmax,errmaxrel)
1202            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1203     &            'cva_driver 652',errmax,errmaxrel)
1204         endif !  if (iso_eau.gt.0) then
1205         if (iso_HDO.gt.0) then   
1206              call iso_verif_aberrant_choix( &
1207     &            xt(iso_HDO,i,k),q(i,k), &
1208     &            ridicule,deltalim,'cva_driver 794, apres undilute2')
1209         endif !if (iso_HDO.gt.0) then 
1210#ifdef ISOTRAC
1211           call iso_verif_traceur(xt(1,i,k),'cva_driver 780')
1212           call iso_verif_traceur(xtclw(1,i,k),'cva_driver 781')
1213#endif               
1214        enddo
1215       enddo !do k=1,nd
1216#ifdef VERIFNEGATIF
1217       do i = 1, ncum
1218        do k=1,nd
1219         call iso_verif_positif(q(i,k),'cva_driver 1052')     
1220        enddo !do k=1,nd
1221         call iso_verif_positif(qnk(i),'cva_driver 1054') 
1222       enddo !do i = 1, ncum
1223#endif     
1224#endif
1225       !write(*,*) 'SORTIE CV3_UNDILUTE2'
1226#endif
1227
1228    END IF
1229
1230    IF (iflag_con==4) THEN
1231        if (prt_level >= 9) &
1232             PRINT *, 'cva_driver -> cv_undilute2'
1233      CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
1234                        tnk, qnk, gznk, t, q, qs, gz, &
1235                        p, dph, h, tv, lv, &
1236                        inb, inbis, tp, tvp, clw, hp, ep, sigp, frac_s)
1237    END IF
1238
1239    ! epmax_cape
1240    ! on recalcule ep et hp   
1241        if (prt_level >= 9) &
1242             PRINT *, 'cva_driver -> cv3_epmax_cape'
1243    call cv3_epmax_fn_cape(nloc,ncum,nd &
1244                , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac_s &
1245                , pbase, p, ph, tv, buoy, sig, w0,iflag &
1246                , epmax_diag)
1247
1248! -------------------------------------------------------------------
1249! --- MIXING(1)   (if iflag_mix .ge. 1)
1250! -------------------------------------------------------------------
1251    IF (iflag_con==3) THEN
1252!      IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
1253!        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
1254!          '. Might as well stop here.'
1255!        STOP
1256!      END IF
1257      IF (iflag_mix>=1) THEN
1258        CALL zilch(supmax, nloc*nd)
1259        if (prt_level >= 9) &
1260             PRINT *, 'cva_driver -> cv3p_mixing'
1261        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
1262!!                         ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
1263                         ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, &      !!jygprl
1264                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
1265                         ment, qent, hent, uent, vent, nent, &
1266                         sigij, elij, supmax, ments, qents, traent &
1267#ifdef ISO
1268     &                   ,xt,xtta,xtclw,xtent,xtelij  &     
1269#endif         
1270     &                   )
1271! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
1272
1273      ELSE
1274        CALL zilch(supmax, nloc*nd)
1275      END IF
1276    END IF
1277! -------------------------------------------------------------------
1278! --- CLOSURE
1279! -------------------------------------------------------------------
1280
1281
1282    IF (iflag_con==3) THEN
1283      IF (iflag_clos==0) THEN
1284        if (prt_level >= 9) &
1285             PRINT *, 'cva_driver -> cv3_closure'
1286        CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
1287                         pbase, p, ph, tv, buoy, &
1288                         sig, w0, cape, m, iflag)
1289      END IF   ! iflag_clos==0
1290
1291      ok_inhib = iflag_mix == 2
1292
1293      IF (iflag_clos==1) THEN
1294        PRINT *, ' pas d appel cv3p_closure'
1295! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              ! na->nd
1296! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
1297! c    :                       ,supmax
1298! c    o                       ,sig,w0,ptop2,cape,cin,m)
1299      END IF   ! iflag_clos==1
1300
1301      IF (iflag_clos==2) THEN
1302        if (prt_level >= 9) &
1303             PRINT *, 'cva_driver -> cv3p1_closure'
1304        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
1305                           pbase, plcl, p, ph, tv, tvp, buoy, &
1306                           supmax, ok_inhib, Ale, Alp, omega, &
1307                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1308                           Plim1, plim2, asupmax, supmax0, &
1309                           asupmaxmin, cbmf, plfc, wbeff)
1310        if (prt_level >= 10) &
1311             PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1312      END IF   ! iflag_clos==2
1313
1314      IF (iflag_clos==3) THEN
1315        if (prt_level >= 9) &
1316             PRINT *, 'cva_driver -> cv3p2_closure'
1317        CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
1318                           pbase, plcl, p, ph, tv, tvp, buoy, &
1319                           supmax, ok_inhib, Ale, Alp, omega, &
1320                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1321                           Plim1, plim2, asupmax, supmax0, &
1322                           asupmaxmin, cbmf, plfc, wbeff)
1323        if (prt_level >= 10) &
1324             PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1325      END IF   ! iflag_clos==3
1326    END IF ! iflag_con==3
1327
1328    IF (iflag_con==4) THEN
1329        if (prt_level >= 9) &
1330             PRINT *, 'cva_driver -> cv_closure'
1331      CALL cv_closure(nloc, ncum, nd, nk, icb, &
1332                         tv, tvp, p, ph, dph, plcl, cpn, &
1333                         iflag, cbmf)
1334    END IF
1335
1336! print *,'cv_closure-> cape ',cape(1)
1337
1338! -------------------------------------------------------------------
1339! --- MIXING(2)
1340! -------------------------------------------------------------------
1341
1342    IF (iflag_con==3) THEN
1343      IF (iflag_mix==0) THEN
1344        if (prt_level >= 9) &
1345             PRINT *, 'cva_driver -> cv3_mixing'
1346        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
1347                        ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, &
1348                        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
1349                        ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent &
1350#ifdef ISO
1351     &                     ,xt,xtnk,xtclw &
1352     &                     ,xtent,xtelij &
1353#endif
1354     &    )
1355        CALL zilch(hent, nloc*nd*nd)
1356
1357#ifdef ISO
1358#ifdef ISOVERIF
1359       write(*,*) 'cva_driver 837: après cv3_mixing'
1360       write(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
1361       do k=1,nd
1362       do j = 1, nd
1363        do i = 1, ncum
1364         if (iso_eau.gt.0) then
1365            call iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
1366     &            elij(i,j,k),'cva_driver 881',errmax,errmaxrel)
1367            call iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
1368     &            qent(i,j,k),'cva_driver 882',errmax,errmaxrel)
1369         endif !  if (iso_eau.gt.0) then
1370#ifdef ISOTRAC
1371           call iso_verif_traceur_justmass(xtent(1,i,j,k), &
1372     &           'cva_driver 846')
1373           call iso_verif_traceur_justmass(xtelij(1,i,j,k), &
1374     &           'cva_driver 847')
1375           ! on ne vérfier pas le deltaD ici car peut dépasser le seuil
1376           ! raisonable pour températures très froides.
1377#endif               
1378        enddo !do i = 1, ncum
1379       enddo !do j = 1, nd
1380       enddo !do k=1,nd
1381       do k=1,nd
1382        do i = 1, ncum
1383         if (iso_eau.gt.0) then
1384            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1385     &            'cva_driver 709',errmax,errmaxrel)
1386         endif !  if (iso_eau.gt.0) then
1387#ifdef ISOTRAC
1388           call iso_verif_traceur(xt(1,i,k),'cva_driver 856')
1389           if (option_tmin.eq.1) then
1390             if (iso_verif_positif_nostop(xtclw(index_trac( &
1391     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
1392     &           ,'cva_driver 909').eq.1) then
1393               write(*,*) 'i,k=',i,k
1394               write(*,*) 'xtclw=',xtclw(:,i,k)
1395               stop
1396             endif !if (iso_verif_positif_nostop(xtclw(index_trac(
1397           endif !if ((option_traceurs.eq.17).or.
1398#endif 
1399        enddo
1400       enddo !do k=1,nd     
1401#endif
1402#endif
1403
1404      ELSE
1405!!jyg:  Essais absurde pour voir
1406!!        mm(:,1) = 0.
1407!!        DO  i = 2,nd
1408!!          mm(:,i) = m(:,i)*(1.-qta(:,i-1))
1409!!        ENDDO
1410        mm(:,:) = m(:,:)
1411        CALL cv3_mixscale(nloc, ncum, nd, ment, mm)
1412        IF (debut) THEN
1413          PRINT *, ' cv3_mixscale-> '
1414        END IF !(debut) THEN
1415      END IF
1416    END IF
1417
1418    IF (iflag_con==4) THEN
1419        if (prt_level >= 9) &
1420             PRINT *, 'cva_driver -> cv_mixing'
1421      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
1422                     ph, t, q, qs, u, v, h, lv, qnk, &
1423                     hp, tv, tvp, ep, clw, cbmf, &
1424                     m, ment, qent, uent, vent, nent, sigij, elij)
1425    END IF                                                                                         
1426
1427    IF (debut) THEN
1428      PRINT *, ' cv_mixing ->'
1429    END IF !(debut) THEN
1430! do i = 1,nd
1431! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
1432! enddo
1433
1434! -------------------------------------------------------------------
1435! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1436! -------------------------------------------------------------------
1437    IF (iflag_con==3) THEN
1438      IF (debut) THEN
1439        PRINT *, ' cva_driver -> cv3_unsat '
1440      END IF !(debut) THEN
1441#ifdef ISO
1442#ifdef ISOVERIF
1443       do k=1,nd
1444        do i = 1, ncum
1445         if (iso_eau.gt.0) then
1446            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1447     &            'cva_driver 753a',errmax,errmaxrel)
1448            call iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
1449     &            'cva_driver 753b',errmax,errmaxrel)
1450         endif !  if (iso_eau.gt.0) then
1451#ifdef ISOTRAC
1452           call iso_verif_traceur(xt(1,i,k),'cva_driver 885')           
1453#endif               
1454        enddo
1455       enddo !do k=1,nd     
1456#endif
1457#endif
1458
1459        if (prt_level >= 9) &
1460             PRINT *, 'cva_driver -> cv3_unsat'
1461      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
1462                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
1463                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
1464                     ep, sigp, clw, frac_s, qpreca, frac_a, qta, &                    !!jygprl
1465                     m, ment, elij, delt, plcl, coef_clos, &
1466                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
1467                     faci, b, sigd, &
1468!!                     wdtrainA, wdtrainM)                                       ! RomP
1469                     wdtrainA, wdtrainS, wdtrainM &  !!jygprl
1470#ifdef ISO
1471     &               ,xt_wake,xtclw,xtelij &
1472     &               ,xtp,xtwater,xtevap,xtice,xtwdtrainA &
1473#endif
1474     &               )                             
1475!
1476      IF (prt_level >= 10) THEN
1477        Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
1478        DO k = 1,nd
1479        write (6, '(i4,5(1x,e13.6))'), &
1480          k, mp(igout,k), water(igout,k), ice(igout,k), &
1481           evap(igout,k), fondue(igout,k)
1482        ENDDO
1483        Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM '     !!jygprl
1484        DO k = 1,nd
1485        write (6, '(i4,3(1x,e13.6))'), &
1486           k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k)            !!jygprl
1487        ENDDO
1488      ENDIF
1489!
1490    END IF  !(iflag_con==3)
1491
1492    IF (iflag_con==4) THEN
1493        if (prt_level >= 9) &
1494             PRINT *, 'cva_driver -> cv_unsat'
1495      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1496                     h, lv, ep, sigp, clw, m, ment, elij, &
1497                     iflag, mp, qp, up, vp, wt, water, evap)
1498    END IF
1499
1500    IF (debut) THEN
1501      PRINT *, 'cv_unsat-> '
1502    END IF !(debut) THEN
1503
1504#ifdef ISO
1505#ifdef ISOTRAC
1506      if (option_traceurs.eq.6) then
1507          ! on colorie les ddfts en rouge, le reste est en blanc.
1508          do k=1,nd
1509            do i = 1, ncum
1510               do iiso=1,niso
1511                  ixt_ddft=index_trac(izone_ddft,iiso)
1512                  ixt_poubelle=index_trac(izone_poubelle,iiso)
1513                  xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
1514     &                    +xtp(ixt_poubelle,i,k)
1515                  xtp(ixt_poubelle,i,k)=0.0
1516               enddo !do iiso=1,niso
1517#ifdef ISOVERIF
1518               call iso_verif_traceur(xtp(1,i,k),'cva_driver 990')
1519#endif               
1520            enddo !do i = 1, ncum
1521          enddo !do k=1,nd
1522      else if (option_traceurs.eq.19) then
1523          ! on colorie les ddfts, mais on sauve la revap
1524          do k=1,nd
1525            do i = 1, ncum
1526               do izone=1,ntraceurs_zone
1527                 if (izone.eq.izone_ddft) then
1528                   do iiso=1,niso
1529                     ixt_ddft=index_trac(izone,iiso)
1530                     ixt_revap=index_trac(izone_revap,iiso)
1531                     xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
1532                   enddo !do iiso=1,niso
1533                 elseif (izone.eq.izone_ddft) then
1534                    ! rien à faire
1535                 else !if (izone.eq.izone_ddft) then
1536                   do iiso=1,niso
1537                     ixt=index_trac(izone,iiso)
1538                     xtp(ixt,i,k)=0.0
1539                   enddo !do iiso=1,niso
1540                 endif !if (izone.eq.izone_ddft) then
1541               enddo !do izone=1,ntraceurs_zone
1542#ifdef ISOVERIF
1543               call iso_verif_traceur(xtp(1,i,k),'cva_driver 1059')
1544#endif               
1545            enddo !do i = 1, ncum
1546          enddo !do k=1,nd
1547      endif !if (option_traceurs.eq.6) then
1548#endif
1549#endif   
1550
1551! print *,'cv_unsat-> mp ',mp
1552! print *,'cv_unsat-> water ',water
1553! -------------------------------------------------------------------
1554! --- YIELD
1555! (tendencies, precipitation, variables of interface with other
1556! processes, etc)
1557! -------------------------------------------------------------------
1558
1559    IF (iflag_con==3) THEN
1560
1561        if (prt_level >= 9) &
1562             PRINT *, 'cva_driver -> cv3_yield'
1563      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
1564                     icb, inb, delt, &
1565                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
1566                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1567                     ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, &
1568                     wt, water, ice, evap, fondue, faci, b, sigd, &
1569                     ment, qent, hent, iflag_mix, uent, vent, &
1570                     nent, elij, traent, sig, &
1571                     tv, tvp, wghti, &
1572                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &      ! jyg
1573                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
1574!!                     tls, tps, &                            ! useless . jyg
1575                     qcondc, wd, &
1576!!                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1577                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv &  !!jygprl
1578#ifdef ISO
1579     &                     ,xt,xt_wake,xtclw,xtp,xtwater,xtice,xtevap &
1580     &                     ,xtent,xtelij,xtprecip,fxt,fxtd,xtVprecip,xtVprecipi &
1581#ifdef DIAGISO
1582     &         ,fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
1583     &         ,fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip  &
1584     &         ,f_detrainement,q_detrainement,xt_detrainement  &
1585#endif       
1586#endif
1587     &      )       
1588!
1589!         Test conseravtion de l'eau
1590!
1591
1592#ifdef ISOVERIF
1593      DO k = 1, nd
1594       DO i = 1, ncum
1595        if (iso_HDO.gt.0) then
1596          if (q(i,k)+delt*fq(i,k).gt.ridicule) then
1597            call iso_verif_aberrant( &
1598     &          (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
1599     &          /(q(i,k)+delt*fq(i,k)),'cva_driver 855')
1600          endif
1601         endif
1602         if (iso_eau.gt.0) then
1603             call iso_verif_egalite_choix(fxt(iso_eau,i,k), &
1604     &          fq(i,k),'cva_driver 1305',errmax,errmaxrel)
1605         endif       
1606#ifdef ISOTRAC
1607           call iso_verif_traceur(xt(1,i,k),'cva_driver 1008')
1608#endif       
1609        enddo
1610       enddo
1611#endif
1612      IF (debut) THEN
1613        PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
1614      END IF !(debut) THEN
1615!   
1616      IF (prt_level >= 10) THEN
1617        Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
1618                    ft(igout,1), ftd(igout,1)
1619        Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
1620                    fq(igout,1), fqd(igout,1)
1621      ENDIF
1622!   
1623    END IF
1624
1625    IF (iflag_con==4) THEN
1626        if (prt_level >= 9) &
1627             PRINT *, 'cva_driver -> cv_yield'
1628      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1629                     t, q, u, v, &
1630                     gz, p, ph, h, hp, lv, cpn, &
1631                     ep, clw, frac_s, m, mp, qp, up, vp, &
1632                     wt, water, evap, &
1633                     ment, qent, uent, vent, nent, elij, &
1634                     tv, tvp, &
1635                     iflag, wd, qprime, tprime, &
1636                     precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1637    END IF
1638
1639!AC!
1640!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1641!--- passive tracers
1642!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1643
1644    IF (iflag_con==3) THEN
1645!RomP >>>
1646        if (prt_level >= 9) &
1647             PRINT *, 'cva_driver -> cv3_tracer'
1648      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1649                     ment, sigij, da, phi, phi2, d1a, dam, &
1650                     ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1651                     icb, inb)
1652!RomP <<<
1653    END IF
1654
1655!AC!
1656
1657! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1658! --- UNCOMPRESS THE FIELDS
1659! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1660
1661
1662    IF (iflag_con==3) THEN
1663        if (prt_level >= 9) &
1664             PRINT *, 'cva_driver -> cv3a_uncompress'
1665      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1666                           iflag, icb, inb, &
1667                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1668                           ft, fq, fu, fv, ftra, &
1669                           sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1670                           qcondc, wd, cape, cin, &
1671                           tvp, &
1672                           ftd, fqd, &
1673                           Plim1, plim2, asupmax, supmax0, &
1674                           asupmaxmin, &
1675                           da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
1676                           qta, clw, elij, evap, ep, epmlmMm, eplaMm, &  ! RomP
1677                           wdtrainA, wdtrainS, wdtrainM, &                         ! RomP
1678                           qtc, sigt, epmax_diag, & ! epmax_cape
1679                           iflag1, kbas1, ktop1, &
1680                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1681                           ft1, fq1, fu1, fv1, ftra1, &
1682                           sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1683                           qcondc1, wd1, cape1, cin1, &
1684                           tvp1, &
1685                           ftd1, fqd1, &
1686                           Plim11, plim21, asupmax1, supmax01, &
1687                           asupmaxmin1, &
1688                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  &       ! RomP
1689                           qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1690                           wdtrainA1, wdtrainS1, wdtrainM1,                  & ! RomP
1691                           qtc1, sigt1, epmax_diag1 & ! epmax_cape
1692#ifdef ISO
1693     &          ,xtprecip,fxt,fxtd, xtVprecip,xtVprecipi, xtclw,xtevap,xtwdtraina       &
1694     &         ,xtprecip1,fxt1,fxtd1, xtVprecip1, xtVprecipi1, xtclw1,xtevap1,xtwdtraina1 &
1695#ifdef DIAGISO
1696     &         , water,xtwater,qp,xtp &
1697     &         , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
1698     &         , fxt_detrainement,fxt_ddft,fxt_fluxmasse, fxt_evapprecip &
1699     &         , f_detrainement,q_detrainement,xt_detrainement &
1700     &         , water1,xtwater1,qp1,xtp1 &
1701     &         , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1  &
1702     &         , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1, fxt_evapprecip1 &
1703     &         , f_detrainement1,q_detrainement1,xt_detrainement1 &
1704#endif       
1705#endif
1706     &          )
1707
1708
1709#ifdef ISOVERIF
1710      DO k = 1, nd
1711       DO i = 1, len
1712        if (iso_HDO.gt.0) then
1713          if (q1(i,k).gt.ridicule) then
1714            call iso_verif_aberrant( &
1715     &          (xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
1716     &          /(q1(i,k)+delt*fq1(i,k)),'cva_driver 2554')
1717          endif
1718         endif !if (iso_HDO.gt.0) then
1719         if (iso_eau.gt.0) then
1720             call iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
1721     &          fq1(i,k),'cva_driver 1383',errmax,errmaxrel)
1722         endif     
1723         do ixt=1,ntraciso
1724           if (iso_verif_noNaN_nostop(fxtd1(ixt,i,k), &
1725     &           'cva_driver 1447').eq.1) then
1726              write(*,*) 'i,k=', i,k
1727              stop
1728           endif !if (iso_verif_noNaN_nostop(fxtd1(ixt,i,k),
1729         enddo
1730        enddo
1731       enddo
1732#endif
1733
1734!   
1735      IF (prt_level >= 10) THEN
1736        Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
1737                    ft1(igout,1), ftd1(igout,1)
1738        Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
1739                    fq1(igout,1), fqd1(igout,1)
1740      ENDIF
1741!   
1742    END IF
1743
1744    IF (iflag_con==4) THEN
1745        if (prt_level >= 9) &
1746             PRINT *, 'cva_driver -> cv_uncompress'
1747      CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1748                           iflag, &
1749                           precip, cbmf, &
1750                           ft, fq, fu, fv, &
1751                           ma, qcondc, &
1752                           iflag1, &
1753                           precip1,cbmf1, &
1754                           ft1, fq1, fu1, fv1, &
1755                           ma1, qcondc1)
1756    END IF
1757
1758  END IF ! ncum>0
1759!
1760!
1761  DO i = 1,len
1762    IF (iflag1(i) == 14) THEN
1763      Cin1(i) = Cin_noconv
1764      Cape1(i) = Cape_noconv
1765    ENDIF
1766  ENDDO
1767
1768!
1769! In order take into account the possibility of changing the compression,
1770! reset m, sig and w0 to zero for non-convective points.
1771  DO k = 1,nd-1
1772        sig1(:, k) = sig1(:, k)*coef_convective(:)
1773        w01(:, k)  = w01(:, k)*coef_convective(:)
1774  ENDDO
1775
1776  IF (debut) THEN
1777    PRINT *, ' cv_uncompress -> '
1778    debut = .FALSE.
1779  END IF  !(debut) THEN
1780
1781
1782  RETURN
1783END SUBROUTINE cva_driver
Note: See TracBrowser for help on using the repository browser.