source: LMDZ6/branches/Ocean_skin/libf/phylmdiso/cv_driver.F90 @ 5440

Last change on this file since 5440 was 4368, checked in by lguez, 2 years ago

Sync latest trunk changes to Ocean_skin

  • Property svn:keywords set to Id
File size: 43.2 KB
RevLine 
[3927]1
2! $Header$
3
4SUBROUTINE cv_driver(len, nd, ndp1, ntra, iflag_con, t1, q1, qs1, u1, v1, &
5    tra1, p1, ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, vprecip1, &
6    cbmf1, sig1, w01, icb1, inb1, delt, ma1, upwd1, dnwd1, dnwd01, qcondc1, &
7    wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, clw1, elij1, & !
8                                                                        ! RomP
9    evap1, ep1, epmlmmm1, eplamm1, & ! RomP
10    wdtraina1, wdtrainm1, & ! RomP
11    epmax_diag1  & ! epmax_cape
12#ifdef ISO
13     &                 ,xt1,fxt1 &
14     &                 ,xtprecip1,xtvprecip1 &
15     &             , xtevap1,xtclw1,xtwdtraina1 &
16#ifdef DIAGISO
17     &          , water1,xtwater1,qp1,xtp1 &
18     &          , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
19     &          , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1, fxt_evapprecip1 &
20     &          , f_detrainement1,q_detrainement1,xt_detrainement1 &
21#endif     
22#endif
23     &       )
24
25  USE dimphy
26#ifdef ISO
[4368]27  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso,nzone
[3927]28  USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
29#ifdef ISOVERIF
30    use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
31        iso_verif_egalite_choix,iso_verif_aberrant_choix, &
32        iso_verif_aberrant, iso_verif_positif,iso_verif_positif_nostop
33#endif
34#ifdef ISOTRAC
35    use isotrac_mod, only: option_traceurs,izone_ddft,izone_revap, &
36&        izone_poubelle, index_zone,option_tmin,izone_cond
37#ifdef ISOVERIF
38  USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
39&       iso_verif_trac_masse_vect
40    use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
41#endif
42#endif
43#endif
44  IMPLICIT NONE
45
46  ! .............................START PROLOGUE............................
47
48
49  ! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
50  ! "1" appended.
51  ! The "1" is removed for the corresponding compressed (local) variables.
52
53  ! PARAMETERS:
54  ! Name            Type         Usage            Description
55  ! ----------      ----------     -------  ----------------------------
56
57  ! len           Integer        Input        first (i) dimension
58  ! nd            Integer        Input        vertical (k) dimension
59  ! ndp1          Integer        Input        nd + 1
60  ! ntra          Integer        Input        number of tracors
61  ! iflag_con     Integer        Input        version of convect (3/4)
62  ! t1            Real           Input        temperature
63  ! q1            Real           Input        specific hum
64  ! qs1           Real           Input        sat specific hum
65  ! u1            Real           Input        u-wind
66  ! v1            Real           Input        v-wind
67  ! tra1          Real           Input        tracors
68  ! p1            Real           Input        full level pressure
69  ! ph1           Real           Input        half level pressure
70  ! iflag1        Integer        Output       flag for Emanuel conditions
71  ! ft1           Real           Output       temp tend
72  ! fq1           Real           Output       spec hum tend
73  ! fu1           Real           Output       u-wind tend
74  ! fv1           Real           Output       v-wind tend
75  ! ftra1         Real           Output       tracor tend
76  ! precip1       Real           Output       precipitation
77  ! VPrecip1      Real           Output       vertical profile of
78  ! precipitations
79  ! cbmf1         Real           Output       cloud base mass flux
80  ! sig1          Real           In/Out       section adiabatic updraft
81  ! w01           Real           In/Out       vertical velocity within adiab
82  ! updraft
83  ! delt          Real           Input        time step
84  ! Ma1           Real           Output       mass flux adiabatic updraft
85  ! upwd1         Real           Output       total upward mass flux
86  ! (adiab+mixed)
87  ! dnwd1         Real           Output       saturated downward mass flux
88  ! (mixed)
89  ! dnwd01        Real           Output       unsaturated downward mass flux
90  ! qcondc1       Real           Output       in-cld mixing ratio of
91  ! condensed water
92  ! wd1           Real           Output       downdraft velocity scale for
93  ! sfc fluxes
94  ! cape1         Real           Output       CAPE
95
96  ! wdtrainA1     Real           Output   precipitation detrained from
97  ! adiabatic draught;
98  ! used in tracer transport (cvltr)
99  ! wdtrainM1     Real           Output   precipitation detrained from mixed
100  ! draughts;
101  ! used in tracer transport (cvltr)
102  ! da1           Real           Output   used in tracer transport (cvltr)
103  ! phi1          Real           Output   used in tracer transport (cvltr)
104  ! mp1           Real           Output   used in tracer transport (cvltr)
105
106  ! phi21         Real           Output   used in tracer transport (cvltr)
107
108  ! d1a1          Real           Output   used in tracer transport (cvltr)
109  ! dam1          Real           Output   used in tracer transport (cvltr)
110
111  ! evap1         Real           Output
112  ! ep1           Real           Output
113  ! sij1        Real           Output
114  ! elij1         Real           Output
115
116  ! S. Bony, Mar 2002:
117  ! * Several modules corresponding to different physical processes
118  ! * Several versions of convect may be used:
119  ! - iflag_con=3: version lmd  (previously named convect3)
120  ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
121  ! + tard:     - iflag_con=5: version lmd with ice (previously named convectg)
122  ! S. Bony, Oct 2002:
123  ! * Vectorization of convect3 (ie version lmd)
124
125  ! ..............................END PROLOGUE.............................
126
127
128  ! Input
129  INTEGER len
130  INTEGER nd
131  INTEGER ndp1
132  INTEGER noff
133  INTEGER iflag_con
134  INTEGER ntra
135  REAL delt
136  REAL t1(len, nd)
137  REAL q1(len, nd)
138  REAL qs1(len, nd)
139  REAL u1(len, nd)
140  REAL v1(len, nd)
141  REAL tra1(len, nd, ntra)
142  REAL p1(len, nd)
143  REAL ph1(len, ndp1)
144
145  ! Output
146  INTEGER iflag1(len)
147  REAL ft1(len, nd)
148  REAL fq1(len, nd)
149  REAL fu1(len, nd)
150  REAL fv1(len, nd)
151  REAL ftra1(len, nd, ntra)
152  REAL precip1(len)
153  REAL cbmf1(len)
154  REAL sig1(klon, klev)
155  REAL w01(klon, klev)
156  REAL vprecip1(len, nd+1)
157  REAL evap1(len, nd) !RomP
158  REAL ep1(len, nd) !RomP
159  REAL ma1(len, nd)
160  REAL upwd1(len, nd)
161  REAL dnwd1(len, nd)
162  REAL dnwd01(len, nd)
163
164  REAL qcondc1(len, nd) ! cld
165  REAL wd1(len) ! gust
166  REAL cape1(len)
167
168  ! RomP >>>
169  REAL wdtraina1(len, nd), wdtrainm1(len, nd)
170  REAL sij1(len, nd, nd), elij1(len, nd, nd)
171  REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
172
173  REAL phi21(len, nd, nd)
174  REAL d1a1(len, nd), dam1(len, nd)
175  REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
176  ! RomP <<<
177  REAL epmax_diag1 (len) ! epmax_cape     
178   
179
180#ifdef ISO
181      real xt1(ntraciso,len,nd)
182      real fxt1(ntraciso,len,nd)
183      real xtprecip1(ntraciso,len)
184      real xtvprecip1(ntraciso,len,nd+1)
185      real xtevap1(ntraciso,len,nd)
186      real xtwdtraina1(ntraciso,len,nd)
187      real xtelij1(ntraciso,len, nd, nd)
188#ifdef DIAGISO
189      real water1(len,nd)
190      real xtwater1(ntraciso,len,nd)
191      real qp1(len,nd),xtp1(ntraciso,len,nd)
192      real fq_detrainement1(len,nd)
193      real f_detrainement1(len,nd)
194      real q_detrainement1(len,nd)
195      real fq_ddft1(len,nd)
196      real fq_fluxmasse1(len,nd)
197      real fq_evapprecip1(len,nd)
198      real fxt_detrainement1(ntraciso,len,nd)
199      real xt_detrainement1(ntraciso,len,nd)
200      real fxt_ddft1(ntraciso,len,nd)
201      real fxt_fluxmasse1(ntraciso,len,nd)
202      real fxt_evapprecip1(ntraciso,len,nd)
203#endif
204#ifdef ISOVERIF     
205      real deltaD
206#endif     
207#endif
208
209  ! -------------------------------------------------------------------
210  ! Original Prologue by Kerry Emanuel.
211  ! -------------------------------------------------------------------
212  ! --- ARGUMENTS
213  ! -------------------------------------------------------------------
214  ! --- On input:
215
216  ! t:   Array of absolute temperature (K) of dimension ND, with first
217  ! index corresponding to lowest model level. Note that this array
218  ! will be altered by the subroutine if dry convective adjustment
219  ! occurs and if IPBL is not equal to 0.
220
221  ! q:   Array of specific humidity (gm/gm) of dimension ND, with first
222  ! index corresponding to lowest model level. Must be defined
223  ! at same grid levels as T. Note that this array will be altered
224  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
225
226  ! qs:  Array of saturation specific humidity of dimension ND, with first
227  ! index corresponding to lowest model level. Must be defined
228  ! at same grid levels as T. Note that this array will be altered
229  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
230
231  ! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
232  ! index corresponding with the lowest model level. Defined at
233  ! same levels as T. Note that this array will be altered if
234  ! dry convective adjustment occurs and if IPBL is not equal to 0.
235
236  ! v:   Same as u but for meridional velocity.
237
238  ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
239  ! where NTRA is the number of different tracers. If no
240  ! convective tracer transport is needed, define a dummy
241  ! input array of dimension (ND,1). Tracers are defined at
242  ! same vertical levels as T. Note that this array will be altered
243  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
244
245  ! p:   Array of pressure (mb) of dimension ND, with first
246  ! index corresponding to lowest model level. Must be defined
247  ! at same grid levels as T.
248
249  ! ph:  Array of pressure (mb) of dimension ND+1, with first index
250  ! corresponding to lowest level. These pressures are defined at
251  ! levels intermediate between those of P, T, Q and QS. The first
252  ! value of PH should be greater than (i.e. at a lower level than)
253  ! the first value of the array P.
254
255  ! nl:  The maximum number of levels to which convection can penetrate, plus
256  ! 1.
257  ! NL MUST be less than or equal to ND-1.
258
259  ! delt: The model time step (sec) between calls to CONVECT
260
261  ! ----------------------------------------------------------------------------
262  ! ---   On Output:
263
264  ! iflag: An output integer whose value denotes the following:
265  ! VALUE   INTERPRETATION
266  ! -----   --------------
267  ! 0     Moist convection occurs.
268  ! 1     Moist convection occurs, but a CFL condition
269  ! on the subsidence warming is violated. This
270  ! does not cause the scheme to terminate.
271  ! 2     Moist convection, but no precip because ep(inb) lt 0.0001
272  ! 3     No moist convection because new cbmf is 0 and old cbmf is 0.
273  ! 4     No moist convection; atmosphere is not
274  ! unstable
275  ! 6     No moist convection because ihmin le minorig.
276  ! 7     No moist convection because unreasonable
277  ! parcel level temperature or specific humidity.
278  ! 8     No moist convection: lifted condensation
279  ! level is above the 200 mb level.
280  ! 9     No moist convection: cloud base is higher
281  ! then the level NL-1.
282
283  ! ft:   Array of temperature tendency (K/s) of dimension ND, defined at
284  ! same
285  ! grid levels as T, Q, QS and P.
286
287  ! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
288  ! defined at same grid levels as T, Q, QS and P.
289
290  ! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
291  ! defined at same grid levels as T.
292
293  ! fv:   Same as FU, but for forcing of meridional velocity.
294
295  ! ftra: Array of forcing of tracer content, in tracer mixing ratio per
296  ! second, defined at same levels as T. Dimensioned (ND,NTRA).
297
298  ! precip: Scalar convective precipitation rate (mm/day).
299
300  ! VPrecip: Vertical profile of convective precipitation (kg/m2/s).
301
302  ! wd:   A convective downdraft velocity scale. For use in surface
303  ! flux parameterizations. See convect.ps file for details.
304
305  ! tprime: A convective downdraft temperature perturbation scale (K).
306  ! For use in surface flux parameterizations. See convect.ps
307  ! file for details.
308
309  ! qprime: A convective downdraft specific humidity
310  ! perturbation scale (gm/gm).
311  ! For use in surface flux parameterizations. See convect.ps
312  ! file for details.
313
314  ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
315  ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
316  ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
317  ! by the calling program between calls to CONVECT.
318
319  ! det:   Array of detrainment mass flux of dimension ND.
320
321  ! -------------------------------------------------------------------
322
323  ! Local arrays
324
325
326  INTEGER i, k, n, il, j
327  INTEGER icbmax
328  INTEGER nk1(klon)
329  INTEGER icb1(klon)
330  INTEGER inb1(klon)
331  INTEGER icbs1(klon)
332
333  REAL plcl1(klon)
334  REAL tnk1(klon)
335  REAL qnk1(klon)
336  REAL gznk1(klon)
337  REAL pnk1(klon)
338  REAL qsnk1(klon)
339  REAL pbase1(klon)
340  REAL buoybase1(klon)
341
342  REAL lv1(klon, klev)
343  REAL cpn1(klon, klev)
344  REAL tv1(klon, klev)
345  REAL gz1(klon, klev)
346  REAL hm1(klon, klev)
347  REAL h1(klon, klev)
348  REAL tp1(klon, klev)
349  REAL tvp1(klon, klev)
350  REAL clw1(klon, klev)
351  REAL th1(klon, klev)
352
353#ifdef ISO
354      integer ixt
355      real xtclw1(ntraciso,klon,klev)
356      REAL xtnk1(ntraciso,klon)
357#endif
358
359  INTEGER ncum
360
361  ! (local) compressed fields:
362
363  ! ym      integer nloc
364  ! ym      parameter (nloc=klon) ! pour l'instant
365#define nloc klon
366  INTEGER idcum(nloc)
367  INTEGER iflag(nloc), nk(nloc), icb(nloc)
368  INTEGER nent(nloc, klev)
369  INTEGER icbs(nloc)
370  INTEGER inb(nloc), inbis(nloc)
371
372  REAL cbmf(nloc), plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)
373  REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
374  REAL u(nloc, klev), v(nloc, klev)
375  REAL gz(nloc, klev), h(nloc, klev), lv(nloc, klev), cpn(nloc, klev)
376  REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
377  REAL clw(nloc, klev)
378  REAL dph(nloc, klev)
379  REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
380  REAL tvp(nloc, klev)
381  REAL sig(nloc, klev), w0(nloc, klev)
382  REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
383  REAL frac(nloc), buoy(nloc, klev)
384  REAL cape(nloc)
385  REAL m(nloc, klev), ment(nloc, klev, klev), qent(nloc, klev, klev)
386  REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
387  REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
388  REAL sij(nloc, klev, klev), elij(nloc, klev, klev)
389  REAL qp(nloc, klev), up(nloc, klev), vp(nloc, klev)
390  REAL wt(nloc, klev), water(nloc, klev), evap(nloc, klev)
391  REAL b(nloc, klev), ft(nloc, klev), fq(nloc, klev)
392  REAL fu(nloc, klev), fv(nloc, klev)
393  REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
394  REAL ma(nloc, klev), mike(nloc, klev), tls(nloc, klev)
395  REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
396  REAL precip(nloc)
397  REAL vprecip(nloc, klev+1)
398  REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
399  REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
400  REAL qcondc(nloc, klev) ! cld
401  REAL wd(nloc) ! gust
402
403  ! RomP >>>
404  REAL da(nloc, klev), phi(nloc, klev, klev), mp(nloc, klev)
405  REAL epmlmmm(nloc, klev, klev), eplamm(nloc, klev)
406  REAL phi2(nloc, klev, klev)
407  REAL d1a(nloc, klev), dam(nloc, klev)
408  REAL wdtraina(nloc, klev), wdtrainm(nloc, klev)
409  REAL sigd(nloc)
410  ! RomP <<<
411  REAL epmax_diag(nloc) ! epmax_cape
412#ifdef ISO
413      real xt(ntraciso,nloc,klev)
414      real xtnk(ntraciso,nloc)
415      real xtclw(ntraciso,nloc,klev)
416      real xtp(ntraciso,nloc,klev)
417      real xtent(ntraciso,nloc,klev,klev)
418      real xtelij(ntraciso,nloc,klev,klev)
419!      real xtep(ntraciso,nloc,klev) ! le 7 mai: on supprime xtep
420      real xtwater(ntraciso,nloc,klev)
421      real xtevap(ntraciso,nloc,klev)
422      real fxt(ntraciso,nloc,klev)
423      real xtprecip(ntraciso,nloc)
424      real xtvprecip(ntraciso,nloc,klev+1)
425      real xtwdtraina(ntraciso,nloc,klev)
426#ifdef DIAGISO
427      real fxt_detrainement(ntraciso,nloc,klev)
428      real fxt_fluxmasse(ntraciso,nloc,klev)
429      real fxt_evapprecip(ntraciso,nloc,klev)
430      real fxt_ddft(ntraciso,nloc,klev)
431      real fq_detrainement(nloc,klev)
432      real f_detrainement(nloc,klev)
433      real q_detrainement(nloc,klev)
434      real xt_detrainement(ntraciso,nloc,klev)
435      real fq_fluxmasse(nloc,klev)
436      real fq_evapprecip(nloc,klev)
437      real fq_ddft(nloc,klev)
438#endif
439#ifdef ISOTRAC
440      integer iiso,ixt_ddft,ixt_poubelle,ixt_revap
441      integer izone
442!#ifdef ISOVERIF
443!      integer iso_verif_positif_nostop
444!#endif     
445#endif
446#endif
447
448
449#ifdef ISO
450        ! verif     
451#ifdef ISOVERIF
452       write(*,*) 'cv_driver 391: ENTREE dans cv_driver'
453!        write(*,*) 'nloc=',nloc
454       if (iso_eau.gt.0) then
455        do k = 1, klev
456         do i = 1, nloc         
457            call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
458     &           'cv_driver 343',errmax,errmaxrel)           
459         enddo
460        enddo
461       endif !if (iso_eau.gt.0) then
462       if (iso_HDO.gt.0) then
463        do k = 1, klev
464         do i = 1, nloc 
465           if (q1(i,k).gt.ridicule) then       
466            call iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
467     &           'cv_driver 362')     
468           endif !if (q1(i,k).gt.ridicule) then       
469         enddo
470        enddo
471       endif !if (iso_eau.gt.0) then
472#ifdef ISOTRAC
473        do k = 1, klev
474        do i = 1, klon 
475           call iso_verif_traceur(xt1(1,i,k),'cv_driver 413')
476        enddo
477        enddo
478#endif 
479#endif
480       ! end verif       
481#endif
482
483
484  nent(:, :) = 0
485  ! -------------------------------------------------------------------
486  ! --- SET CONSTANTS AND PARAMETERS
487  ! -------------------------------------------------------------------
488  ! print *, '-> cv_driver'      !jyg
489  ! -- set simulation flags:
490  ! (common cvflag)
491
492  CALL cv_flag(0)
493
494  ! -- set thermodynamical constants:
495  ! (common cvthermo)
496
497  CALL cv_thermo(iflag_con)
498
499  ! -- set convect parameters
500
501  ! includes microphysical parameters and parameters that
502  ! control the rate of approach to quasi-equilibrium)
503  ! (common cvparam)
504
505
506  IF (iflag_con==30) THEN
507    CALL cv30_param(nd, delt)
508  END IF
509
510  IF (iflag_con==4) THEN
511    CALL cv_param(nd)
512#ifdef ISO
[4368]513       write(*,*) 'cv_driver 454: isos pas prevus ici'
[3927]514       stop
515#endif
516  END IF
517
518  ! ---------------------------------------------------------------------
519  ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
520  ! ---------------------------------------------------------------------
521
522  inb(:) = 0.0
523  inb1(:) = 0.0
524  icb1(:) = 0.0
525
526  ft1(:, :) = 0.0
527  fq1(:, :) = 0.0
528  fu1(:, :) = 0.0
529  fv1(:, :) = 0.0
530  tvp1(:, :) = 0.0
531  tp1(:, :) = 0.0
532  clw1(:, :) = 0.0
533  ! ym
534  clw(:, :) = 0.0
535  gz1(:, :) = 0.
536  vprecip1(:, :) = 0.
537  ma1(:, :) = 0.0
538  upwd1(:, :) = 0.0
539  dnwd1(:, :) = 0.0
540  dnwd01(:, :) = 0.0
541  qcondc1(:, :) = 0.0
542
543  ftra1(:, :, :) = 0.0
544
545  elij1(:, :, :) = 0.0
546  sij1(:, :, :) = 0.0
547
548  precip1(:) = 0.0
549  iflag1(:) = 0
550  wd1(:) = 0.0
551  cape1(:) = 0.0
552  epmax_diag1(:) = 0.0 ! epmax_cape
553
554
555#ifdef ISOVERIF
556#ifdef ISOTRAC     
557        do k=1,klev       
558         do i=1,klon       
559           call iso_verif_traceur(xt1(1,i,k),'cv_driver 510')
560         enddo
561       enddo
562#endif
563#endif         
564
565#ifdef ISO
566      fxt1(:,:,:)=0.0
567      xtclw1(:,:,:)=0.0
568      xtclw(:,:,:)=0.0
569      xtvprecip1(:,:,:) = 0.   
570      xtelij1(:, :, :, :) = 0.0     
571#endif
572
573  IF (iflag_con==30) THEN
574    DO il = 1, len
575      sig1(il, nd) = sig1(il, nd) + 1.
576      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
577    END DO
578  END IF
579
580  ! RomP >>>
581  wdtraina1(:, :) = 0.
582  wdtrainm1(:, :) = 0.
583  da1(:, :) = 0.
584  phi1(:, :, :) = 0.
585  epmlmmm1(:, :, :) = 0.
586  eplamm1(:, :) = 0.
587  mp1(:, :) = 0.
588  evap1(:, :) = 0.
589  ep1(:, :) = 0.
590  sij1(:, :, :) = 0.
591  elij1(:, :, :) = 0.
592  phi21(:, :, :) = 0.
593  d1a1(:, :) = 0.
594  dam1(:, :) = 0.
595  ! RomP <<<
596#ifdef ISO
597  xtwdtraina1(:,:,:)=0.0
598  xtevap1(:,:,:)=0.0
599  xtelij1(:,:,:,:)=0.0
600#ifdef DIAGISO 
601  xtwater1(:,:,:)=0.0
602  fxt_detrainement1(:,:,:)=0.0
603  xt_detrainement1(:,:,:)=0.0
604  fxt_ddft1(:,:,:)=0.0
605  fxt_fluxmasse1(:,:,:)=0.0
606  fxt_evapprecip1(:,:,:)=0.0
607  xtp1(:,:,:)=0.0
608  water1(:,:)=0.0
609  qp1(:,:)=0.0
610  fq_detrainement1(:,:)=0.0
611  fq_ddft1(:,:)=0.0
612  fq_fluxmasse1(:,:)=0.0
613  fq_evapprecip1(:,:)=0.0
614#endif
615#endif
616  ! --------------------------------------------------------------------
617  ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
618  ! --------------------------------------------------------------------
619
620  IF (iflag_con==30) THEN
621
622    ! print*,'Emanuel version 30 '
623    CALL cv30_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
624      , lv1, cpn1, tv1, gz1, h1, hm1, th1)
625  END IF
626
627  IF (iflag_con==4) THEN
628    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
629      hm1)
630  END IF
631
632  ! --------------------------------------------------------------------
633  ! --- CONVECTIVE FEED
634  ! --------------------------------------------------------------------
635
636  IF (iflag_con==30) THEN
637    CALL cv30_feed(len, nd, t1, q1, qs1, p1, ph1, hm1, gz1 & !
638                                                             ! nd->na
639      , nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1 &
640#ifdef ISO
641      ,xt1,xtnk1 &   
642#endif
643    )
644  END IF
645
646  IF (iflag_con==4) THEN
647    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
648      iflag1, tnk1, qnk1, gznk1, plcl1)
649  END IF
650
651  ! --------------------------------------------------------------------
652  ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
653  ! (up through ICB for convect4, up through ICB+1 for convect3)
654  ! Calculates the lifted parcel virtual temperature at nk, the
655  ! actual temperature, and the adiabatic liquid water content.
656  ! --------------------------------------------------------------------
657
658  IF (iflag_con==30) THEN
659
660#ifdef ISOVERIF
661       write(*,*) 'cv_driver 593: avant cv3_undilute1'
662       do k=1,klev       
663         do i=1,klon
664          if (iso_HDO.gt.0) then
665           if (q1(i,k).gt.ridicule) then
666            call iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
667     &            'cv_driver 502')
668            endif ! if (q1(i,k).gt.ridicule) then
669            endif !if (iso_HDO.gt.0) then
670#ifdef ISOTRAC
671           call iso_verif_traceur(xt1(1,i,k),'cv_driver 601')
672#endif     
673         enddo
674       enddo       
675#endif
676
677
678    CALL cv30_undilute1(len, nd, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1 & ! nd->na
679      , tp1, tvp1, clw1, icbs1 &
680#ifdef ISO
681     &        ,xt1,xtclw1 &
682#endif
683     &        )
684
685
686#ifdef ISO
687!c--debug
688#ifdef ISOVERIF
[4368]689       write(*,*) 'cv_driver 621: apres cv3_undilute1'
[3927]690       do k = 1, klev
691        do i = 1, klon
692         if (iso_eau.gt.0) then
693         call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
694     &           'undil1',errmax,errmaxrel)
695         call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
696     &           'undil1',errmax,errmaxrel)
697         endif !if (iso_eau.gt.0) then
698#ifdef ISOTRAC
699           call iso_verif_traceur(xt1(1,i,k),'cv_driver 623')
700#endif           
701        enddo
702       enddo
703#endif
704       !write(*,*) 'SORTIE DE CV3_UNDILUTE1'
705#endif
706
707  END IF
708
709  IF (iflag_con==4) THEN
710    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
711      tvp1, clw1)
712  END IF
713
714  ! -------------------------------------------------------------------
715  ! --- TRIGGERING
716  ! -------------------------------------------------------------------
717
718  IF (iflag_con==30) THEN
719    CALL cv30_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1 & !
720                                                                 ! nd->na
721      , pbase1, buoybase1, iflag1, sig1, w01)
722  END IF
723
724  IF (iflag_con==4) THEN
725    CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
726  END IF
727
728  ! =====================================================================
729  ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
730  ! =====================================================================
731
732  ncum = 0
733  DO i = 1, len
734    IF (iflag1(i)==0) THEN
735      ncum = ncum + 1
736      idcum(ncum) = i
737    END IF
738  END DO
739
740  ! print*,'cv_driver : klon, ncum = ',len,ncum
741
742  IF (ncum>0) THEN
743
744    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
745    ! --- COMPRESS THE FIELDS
746    ! (-> vectorization over convective gridpoints)
747    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
748
749    IF (iflag_con==30) THEN
750#ifdef ISO
751#ifdef ISOVERIF
752        !write(*,*) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
753        !write(*,*) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1)
754       do k = 1, klev
755        do i = 1, nloc
756        if (iso_eau.gt.0) then
757            call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
758     &            'cv_driver 541a',errmax,errmaxrel)
759            call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
760     &            'cv_driver 541b',errmax,errmaxrel)
761        endif !  if (iso_eau.gt.0) then
762#ifdef ISOTRAC
763           call iso_verif_traceur(xt1(1,i,k),'cv_driver 689')
764#endif             
765        enddo
766       enddo   
767#endif
768#endif
769
770      CALL cv30_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
771        plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, &
772        gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, &
773        w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, &
774        q, qs, u, v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, &
775        w0 &
776#ifdef ISO
777     &    ,xtnk1,xt1,xtclw1 &
778     &    ,xtnk,xt,xtclw &
779#endif
780     &    )
781
782#ifdef ISO
783#ifdef ISOVERIF
[4368]784       write(*,*) 'cv_driver 720: apres cv3_compress'           
[3927]785       do k = 1, klev
786        do i = 1, ncum
787         if (iso_eau.gt.0) then
788            call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
789     &            'cv_driver 598',errmax,errmaxrel)
790            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
791     &            'cv_driver 600',errmax,errmaxrel)
792         endif !  if (iso_eau.gt.0) then
793         if (iso_HDO.gt.0) then   
794              call iso_verif_aberrant_choix( &
795     &            xt(iso_HDO,i,k),q(i,k), &
796     &            ridicule,deltalim,'cv_driver 735, apres compress')
797         endif !if (iso_HDO.gt.0) then
798#ifdef ISOTRAC
799           call iso_verif_traceur(xt(1,i,k),'cv_driver 726')
800#endif                   
801        enddo
802       enddo
803       if (iso_eau.gt.0) then
804       do i = 1, ncum
805            call iso_verif_egalite_choix(xtnk(iso_eau,i),qnk(i), &
806     &            'cv_driver 834',errmax,errmaxrel)
807       enddo
808       endif !if (iso_eau.gt.0) then
809#endif
810#endif
811
812    END IF
813
814    IF (iflag_con==4) THEN
815      CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
816        tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
817        tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
818        q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
819    END IF
820
821    ! -------------------------------------------------------------------
822    ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
823    ! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
824    ! ---   &
825    ! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
826    ! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
827    ! ---   &
828    ! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
829    ! -------------------------------------------------------------------
830
831    IF (iflag_con==30) THEN
832      CALL cv30_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
833        , tnk, qnk, gznk, t, q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, &
834        inb, tp, tvp, clw, hp, ep, sigp, buoy &
835#ifdef ISO
836     &  ,xtnk,xt,xtclw &
837#endif
838     &   )
839
840#ifdef ISO
841#ifdef ISOVERIF
842        write(*,*) 'cv_driver 863: apres call cv30_undilute2'
843       do k = 1, klev
844        do i = 1, ncum
845         if (iso_eau.gt.0) then
846            call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
847     &            'cv_driver 650',errmax,errmaxrel)
848            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
849     &            'cv_driver 652',errmax,errmaxrel)
850         endif !  if (iso_eau.gt.0) then
851         if (iso_HDO.gt.0) then   
852              call iso_verif_aberrant_choix( &
853     &            xt(iso_HDO,i,k),q(i,k), &
854     &            ridicule,deltalim,'cv_driver 794, apres undilute2')
855         endif !if (iso_HDO.gt.0) then 
856#ifdef ISOTRAC
857           call iso_verif_traceur(xt(1,i,k),'cv_driver 780trac')
858           call iso_verif_traceur(xtclw(1,i,k),'cv_driver 781trac')
859#endif               
860        enddo
861       enddo
862#endif
863       !write(*,*) 'SORTIE CV3_UNDILUTE2'
864#endif
865    END IF
866
867    IF (iflag_con==4) THEN
868      CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
869        gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
870    END IF
871
872    ! -------------------------------------------------------------------
873    ! --- CLOSURE
874    ! -------------------------------------------------------------------
875
876    IF (iflag_con==30) THEN
877      CALL cv30_closure(nloc, ncum, nd, icb, inb & ! na->nd
878        , pbase, p, ph, tv, buoy, sig, w0, cape, m)
879
880      ! epmax_cape
881      call cv30_epmax_fn_cape(nloc,ncum,nd &
882                ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
883                ,epmax_diag)
884        ! on écrase ep et recalcule hp
885    END IF
886
887    IF (iflag_con==4) THEN
888      CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
889        cpn, iflag, cbmf)
890    END IF
891   
892
893    ! -------------------------------------------------------------------
894    ! --- MIXING
895    ! -------------------------------------------------------------------
896
897    IF (iflag_con==30) THEN
898      CALL cv30_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
899                                                                ! na->nd
900        , ph, t, q, qs, u, v, tra, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, &
901        ment, qent, uent, vent, sij, elij, ments, qents, traent &
902#ifdef ISO
903     &                     ,xt,xtnk,xtclw &
904     &                     ,xtent,xtelij &
905#endif
906     &    )
907
908
909#ifdef ISO
910#ifdef ISOVERIF
[4368]911       write(*,*) 'cv_driver 837: apres cv3_mixing'
[3927]912       do k = 1, klev
913       do j = 1, klev
914        do i = 1, ncum
915         if (iso_eau.gt.0) then
916            call iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
917     &            elij(i,j,k),'cv_driver 881',errmax,errmaxrel)
918            call iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
919     &            qent(i,j,k),'cv_driver 882',errmax,errmaxrel)
920         endif !  if (iso_eau.gt.0) then
921#ifdef ISOTRAC
922           call iso_verif_traceur_justmass(xtent(1,i,j,k), &
923     &           'cv_driver 846')
924           call iso_verif_traceur_justmass(xtelij(1,i,j,k), &
925     &           'cv_driver 847')
[4368]926           ! on ne verifie pas le deltaD ici car peut depasser le seuil
927           ! raisonable pour temperatures tres froides.
[3927]928#endif               
929        enddo
930       enddo
931       enddo !do k = 1, klev
932       do k = 1, klev
933        do i = 1, ncum
934         if (iso_eau.gt.0) then
935            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
936     &            'cv_driver 709',errmax,errmaxrel)
937         endif !  if (iso_eau.gt.0) then
938#ifdef ISOTRAC
939           call iso_verif_traceur(xt(1,i,k),'cv_driver 856')
940           if (option_tmin.eq.1) then
[4368]941             if (iso_verif_positif_nostop(xtclw(itZonIso( &
[3927]942     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
943     &           ,'cv_driver 909').eq.1) then
944               write(*,*) 'i,k=',i,k
945               write(*,*) 'xtclw=',xtclw(:,i,k)
946               stop
[4368]947             endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
[3927]948           endif !if ((option_traceurs.eq.17).or.
949#endif 
950        enddo
951       enddo !do k = 1, klev 
952   
953#endif
954#endif
955
956    END IF
957
958    IF (iflag_con==4) THEN
959      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
960        h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
961        nent, sij, elij)
962    END IF
963
964    ! -------------------------------------------------------------------
965    ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
966    ! -------------------------------------------------------------------
967
968    IF (iflag_con==30) THEN
969
970#ifdef ISO
971#ifdef ISOVERIF
972       do k = 1, klev
973        do i = 1, ncum
974         if (iso_eau.gt.0) then
975            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
976     &            'cv_driver 753',errmax,errmaxrel)
977         endif !  if (iso_eau.gt.0) then
978#ifdef ISOTRAC
979           call iso_verif_traceur(xt(1,i,k),'cv_driver 885')           
980#endif               
981        enddo
982       enddo !do k = 1, klev     
983#endif
984#endif
985
986      ! RomP >>>
987      CALL cv30_unsat(nloc, ncum, nd, nd, ntra, icb, inb & ! na->nd
988        , t, q, qs, gz, u, v, tra, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, &
989        ment, elij, delt, plcl, mp, qp, up, vp, trap, wt, water, evap, b, &
990        wdtraina, wdtrainm &
991#ifdef ISO
992     &               ,xt,xtclw,xtelij &
993     &               ,xtp,xtwater,xtevap,xtwdtraina &
994#endif
995     &               )
996      ! RomP <<<
997
998#ifdef ISO
999       write(*,*) 'klev=',klev
1000#ifdef ISOVERIF
[4368]1001       write(*,*) 'cv_driver 930: apres cv3_unsat'
[3927]1002       do k = 1, klev
1003        do i = 1, ncum
1004         if (iso_eau.gt.0) then
1005            !    write(*,*) 'i,k=',i,k
1006            call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1007     &            'cv_driver 778',errmax,errmaxrel)
1008            call iso_verif_egalite_choix(xtp(iso_eau,i,k), &
1009     &            qp(i,k),'cv_driver 780',errmax,errmaxrel)
1010            call iso_verif_egalite_choix( &
1011     &             xtwater(iso_eau,i,k),water(i,k), &
1012     &            'cv_driver 782',errmax,errmaxrel)
1013            call iso_verif_egalite_choix(xtevap(iso_eau,i,k), &
1014     &            evap(i,k),'cv_driver 784',errmax,errmaxrel)
1015         endif !  if (iso_eau.gt.0) then
1016#ifdef ISOTRAC
1017           call iso_verif_traceur(xt(1,i,k),'cv_driver 939')
1018           call iso_verif_traceur(xtp(1,i,k),'cv_driver 940')
1019           call iso_verif_traceur(xtwater(1,i,k),'cv_driver 941')
1020           call iso_verif_traceur_justmass(xtevap(1,i,k), &
1021     &           'cv_driver 942')
1022           if (bidouille_anti_divergence) then
1023             call iso_verif_traceur_pbidouille( &
1024     &           xtp(1,i,k),'cv_driver 956')
1025             call iso_verif_traceur_pbidouille( &
1026     &           xtwater(1,i,k),'cv_driver 958')
1027           endif
1028#endif             
1029        enddo !do i = 1, ncum
1030       enddo !do k = 1, klev     
1031#endif
1032#endif
1033
1034    END IF
1035
1036    IF (iflag_con==4) THEN
1037      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
1038        ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
1039    END IF
1040
1041
1042#ifdef ISO
1043#ifdef ISOTRAC
1044      if (option_traceurs.eq.6) then
1045          ! on colorie les ddfts en rouge, le reste est en blanc.
1046          do k = 1, klev
1047            do i = 1, ncum
1048               do iiso=1,niso
[4368]1049                  ixt_ddft=itZonIso(izone_ddft,iiso)
1050                  ixt_poubelle=itZonIso(izone_poubelle,iiso)
[3927]1051                  xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
1052     &                    +xtp(ixt_poubelle,i,k)
1053                  xtp(ixt_poubelle,i,k)=0.0
1054               enddo !do iiso=1,niso
1055#ifdef ISOVERIF
1056               call iso_verif_traceur(xtp(1,i,k),'cv_driver 990')
1057#endif               
1058            enddo !do i = 1, ncum
1059          enddo !do k = 1, klev
1060      else if (option_traceurs.eq.19) then
1061          ! on colorie les ddfts, mais on sauve la revap
1062          do k = 1, klev
1063            do i = 1, ncum
[4368]1064               do izone=1,nzone
[3927]1065                 if (izone.eq.izone_ddft) then
1066                   do iiso=1,niso
[4368]1067                     ixt_ddft=itZonIso(izone,iiso)
1068                     ixt_revap=itZonIso(izone_revap,iiso)
[3927]1069                     xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
1070                   enddo !do iiso=1,niso
1071                 elseif (izone.eq.izone_ddft) then
[4368]1072                    ! rien a faire
[3927]1073                 else !if (izone.eq.izone_ddft) then
1074                   do iiso=1,niso
[4368]1075                     ixt=itZonIso(izone,iiso)
[3927]1076                     xtp(ixt,i,k)=0.0
1077                   enddo !do iiso=1,niso
1078                 endif !if (izone.eq.izone_ddft) then
[4368]1079               enddo !do izone=1,nzone
[3927]1080#ifdef ISOVERIF
1081               call iso_verif_traceur(xtp(1,i,k),'cv_driver 1059')
1082#endif               
1083            enddo !do i = 1, ncum
1084          enddo !do k = 1, klev
1085      endif !if (option_traceurs.eq.6) then
1086#endif
1087#endif   
1088
1089    ! -------------------------------------------------------------------
1090    ! --- YIELD
1091    ! (tendencies, precipitation, variables of interface with other
1092    ! processes, etc)
1093    ! -------------------------------------------------------------------
1094
1095    IF (iflag_con==30) THEN
1096      CALL cv30_yield(nloc, ncum, nd, nd, ntra & ! na->nd
1097        , icb, inb, delt, t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th, ep, &
1098        clw, m, tp, mp, qp, up, vp, trap, wt, water, evap, b, ment, qent, &
1099        uent, vent, nent, elij, traent, sig, tv, tvp, iflag, precip, vprecip, &
1100        ft, fq, fu, fv, ftra, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, &
1101        wd &
1102#ifdef ISO
1103     &                     ,xt,xtclw,xtp,xtwater,xtevap &
1104     &                     ,xtent,xtelij,xtprecip,fxt,xtVPrecip &
1105#ifdef DIAGISO
1106     &         ,fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip  &
1107     &         ,fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
1108     &         ,f_detrainement,q_detrainement,xt_detrainement  &
1109#endif       
1110#endif
1111     &      )
1112
1113#ifdef ISOVERIF
1114      DO k = 1, nd
1115       DO i = 1, ncum     
1116        if (iso_eau.gt.0) then
1117             call iso_verif_egalite_choix(fxt(iso_eau,i,k), &
1118     &           fq(i,k),'cv_driver 1086',errmax,errmaxrel)
1119        endif !if (iso_HDO.gt.0) then
1120        if (iso_HDO.gt.0) then
1121          if (q(i,k).gt.ridicule) then
1122            call iso_verif_aberrant( &
1123     &          (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
1124     &          /(q(i,k)+delt*fq(i,k)),'cv_driver 855')
1125          endif
1126         endif
1127#ifdef ISOTRAC
1128           call iso_verif_traceur(xt(1,i,k),'cv_driver 1008')
1129#endif       
1130        enddo
1131       enddo
1132#endif
1133
1134    END IF
1135
1136    IF (iflag_con==4) THEN
1137      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
1138        ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
1139        evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
1140        tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1141    END IF
1142
1143    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1144    ! --- passive tracers
1145    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1146
1147    IF (iflag_con==30) THEN
1148      ! RomP >>>
1149      CALL cv30_tracer(nloc, len, ncum, nd, nd, ment, sij, da, phi, phi2, &
1150        d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
1151      ! RomP <<<
1152    END IF
1153
1154    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1155    ! --- UNCOMPRESS THE FIELDS
1156    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1157    ! set iflag1 =42 for non convective points
1158    DO i = 1, len
1159      iflag1(i) = 42
1160    END DO
1161
1162    IF (iflag_con==30) THEN
1163      CALL cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
1164        vprecip, evap, ep, sig, w0 & !RomP
1165        , ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
1166        da, phi, mp, phi2, d1a, dam, sij & !RomP
1167        , elij, clw, epmlmmm, eplamm & !RomP
1168        , wdtraina, wdtrainm,epmax_diag &     !RomP
1169        , iflag1, precip1, vprecip1, evap1, ep1, sig1, w01 & !RomP
1170        , ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, dnwd01, &
1171        qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1 & !RomP
1172        , elij1, clw1, epmlmmm1, eplamm1 & !RomP
1173        , wdtraina1, wdtrainm1,epmax_diag1 & !RomP
1174#ifdef ISO
1175     &          ,xtprecip,fxt,xtVPrecip,xtevap,xtclw,xtwdtraina   & 
1176     &         ,xtprecip1,fxt1,xtVPrecip1,xtevap1,xtclw1,xtwdtraina1 &
1177#ifdef DIAGISO
1178     &         , water,xtwater,qp,xtp &
1179     &         , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
1180     &         , fxt_detrainement,fxt_ddft,fxt_fluxmasse, fxt_evapprecip &
1181     &         , f_detrainement,q_detrainement,xt_detrainement &
1182     &         , water1,xtwater1,qp1,xtp1 &
1183     &         , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1  &
1184     &         , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1, fxt_evapprecip1 &
1185     &         , f_detrainement1,q_detrainement1,xt_detrainement1 &
1186#endif       
1187#endif
1188     &          ) !RomP
1189
1190#ifdef ISO       
1191#ifdef ISOVERIF
1192      DO k = 1, nd
1193       DO i = 1, len       
1194        if (iso_eau.gt.0) then
1195             call iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
1196     &          fq1(i,k),'cv_driver 1170',errmax,errmaxrel)
1197        endif !if (iso_HDO.gt.0) then
1198        if (iso_HDO.gt.0) then
1199          if (q1(i,k).gt.ridicule) then
1200            call iso_verif_aberrant( &
1201     &          (xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
1202     &          /(q1(i,k)+delt*fq1(i,k)),'cv_driver 2554')
1203          endif
1204         endif         
1205        enddo !DO i = 1, len
1206       enddo !DO k = 1, nd
1207#ifdef ISOTRAC       
1208           call iso_verif_trac_masse_vect(fxt1,len,nd, &
1209     &           'cv_driver 1200',errmax,errmaxrel)   
1210#endif             
1211#endif
1212#endif
1213
1214    END IF
1215
1216    IF (iflag_con==4) THEN
1217      CALL cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
1218        fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
1219        ma1, qcondc1)
1220    END IF
1221
1222  END IF ! ncum>0
1223
1224  ! print *, 'fin cv_driver ->'      !jyg
1225  RETURN
1226END SUBROUTINE cv_driver
1227
1228! ==================================================================
1229SUBROUTINE cv_flag(iflag_ice_thermo)
1230
1231  USE ioipsl_getin_p_mod, ONLY : getin_p
1232
1233  IMPLICIT NONE
1234
1235  ! Argument : iflag_ice_thermo : ice thermodynamics is taken into account if
1236  ! iflag_ice_thermo >=1
1237  INTEGER iflag_ice_thermo
1238
1239  include "cvflag.h"
1240
1241  ! -- si .TRUE., on rend la gravite plus explicite et eventuellement
1242  ! differente de 10.0 dans convect3:
1243  cvflag_grav = .TRUE.
1244  cvflag_ice = iflag_ice_thermo >= 1
1245  !
1246! si icvflag_Tpa=0, alors la fraction de glace dans l'ascendance adiabatique est
1247  ! fonction de la temperature de l'environnement et la temperature de l'ascendance est
[4368]1248  ! calculee en deux iterations, une en supposant qu'il n'y a pas de glace et l'autre
1249  ! en ajoutant la glace (ancien schema d'Arnaud Jam).
[3927]1250! si icvflag_Tpa=1, alors la fraction de glace dans l'ascendance adiabatique est
1251  ! fonction de la temperature de l'environnement et la temperature de l'ascendance est
1252  ! calculee en une seule iteration.
1253! si icvflag_Tpa=2, alors la fraction de glace dans l'ascendance adiabatique est
1254  ! fonction de la temperature de l'ascendance et la temperature de l'ascendance est
1255  ! calculee en une seule iteration.
1256  icvflag_Tpa=0 
1257  call getin_p('icvflag_Tpa', icvflag_Tpa)
1258
1259  RETURN
1260END SUBROUTINE cv_flag
1261
1262! ==================================================================
1263SUBROUTINE cv_thermo(iflag_con)
1264  IMPLICIT NONE
1265
1266  ! -------------------------------------------------------------
1267  ! Set thermodynamical constants for convectL
1268  ! -------------------------------------------------------------
1269
1270  include "YOMCST.h"
1271  include "cvthermo.h"
1272
1273  INTEGER iflag_con
1274
1275
1276  ! original set from convect:
1277  IF (iflag_con==4) THEN
1278    cpd = 1005.7
1279    cpv = 1870.0
1280    cl = 4190.0
1281    rrv = 461.5
1282    rrd = 287.04
1283    lv0 = 2.501E6
1284    g = 9.8
1285    t0 = 273.15
1286    grav = g
1287  ELSE
1288
1289    ! constants consistent with LMDZ:
1290    cpd = rcpd
1291    cpv = rcpv
1292    cl = rcw
1293    ci = rcs
1294    rrv = rv
1295    rrd = rd
1296    lv0 = rlvtt
1297    lf0 = rlstt - rlvtt
1298    g = rg ! not used in convect3
1299    ! ori      t0  = RTT
1300    t0 = 273.15 ! convect3 (RTT=273.16)
1301    ! maf       grav= 10.    ! implicitely or explicitely used in convect3
1302    grav = g ! implicitely or explicitely used in convect3
1303  END IF
1304
1305  rowl = 1000.0 !(a quelle variable de YOMCST cela correspond-il?)
1306
1307  clmcpv = cl - cpv
1308  clmcpd = cl - cpd
1309  clmci = cl - ci
1310  cpdmcp = cpd - cpv
1311  cpvmcpd = cpv - cpd
1312  cpvmcl = cl - cpv ! for convect3
1313  eps = rrd/rrv
1314  epsi = 1.0/eps
1315  epsim1 = epsi - 1.0
1316  ! ginv=1.0/g
1317  ginv = 1.0/grav
1318  hrd = 0.5*rrd
1319
1320  RETURN
1321END SUBROUTINE cv_thermo
Note: See TracBrowser for help on using the repository browser.