Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

cva_driver.F90 @ 5360

Last change on this file since 5360 was 3331, checked in by acozic, 7 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 65.8 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format