Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

cv30_routines.F90 @ 5517

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

Rev	Line
[3331]	1
	2	! $Id: cv30_routines.F90 2520 2016-05-23 08:32:55Z lguez $
	3
	4
	5
	6	SUBROUTINE cv30_param(nd, delt)
	7	IMPLICIT NONE
	8
	9	! ------------------------------------------------------------
	10	! Set parameters for convectL for iflag_con = 3
	11	! ------------------------------------------------------------
	12
	13
	14	! * PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE *
	15	! * PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO *
	16	! * PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. *
	17	! * EFFICIENCY IS ASSUMED TO BE UNITY *
	18	! * SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT *
	19	! * SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE *
	20	! * OF CLOUD *
	21
	22	! [TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
	23	! * ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF *
	24	! * APPROACH TO QUASI-EQUILIBRIUM *
	25	! * (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) *
	26	! * (BETA MUST BE LESS THAN OR EQUAL TO 1) *
	27
	28	! * DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE *
	29	! * APPROACH TO QUASI-EQUILIBRIUM *
	30	! * IT MUST BE LESS THAN 0 *
	31
	32	include "cv30param.h"
	33	include "conema3.h"
	34
	35	INTEGER nd
	36	REAL delt ! timestep (seconds)
	37
	38	! noff: integer limit for convection (nd-noff)
	39	! minorig: First level of convection
	40
	41	! -- limit levels for convection:
	42
	43	noff = 1
	44	minorig = 1
	45	nl = nd - noff
	46	nlp = nl + 1
	47	nlm = nl - 1
	48
	49	! -- "microphysical" parameters:
	50
	51	sigd = 0.01
	52	spfac = 0.15
	53	pbcrit = 150.0
	54	ptcrit = 500.0
	55	! IM cf. FH epmax = 0.993
	56
	57	omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
	58
	59	! -- misc:
	60
	61	dtovsh = -0.2 ! dT for overshoot
	62	dpbase = -40. ! definition cloud base (400m above LCL)
	63	dttrig = 5. ! (loose) condition for triggering
	64
	65	! -- rate of approach to quasi-equilibrium:
	66
	67	dtcrit = -2.0
	68	tau = 8000.
	69	beta = 1.0 - delt/tau
	70	alpha = 1.5E-3*delt/tau
	71	! increase alpha to compensate W decrease:
	72	alpha = alpha*1.5
	73
	74	! -- interface cloud parameterization:
	75
	76	delta = 0.01 ! cld
	77
	78	! -- interface with boundary-layer (gust factor): (sb)
	79
	80	betad = 10.0 ! original value (from convect 4.3)
	81
	82	RETURN
	83	END SUBROUTINE cv30_param
	84
	85	SUBROUTINE cv30_prelim(len, nd, ndp1, t, q, p, ph, lv, cpn, tv, gz, h, hm, &
	86	th)
	87	IMPLICIT NONE
	88
	89	! =====================================================================
	90	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	91	! "ori": from convect4.3 (vectorized)
	92	! "convect3": to be exactly consistent with convect3
	93	! =====================================================================
	94
	95	! inputs:
	96	INTEGER len, nd, ndp1
	97	REAL t(len, nd), q(len, nd), p(len, nd), ph(len, ndp1)
	98
	99	! outputs:
	100	REAL lv(len, nd), cpn(len, nd), tv(len, nd)
	101	REAL gz(len, nd), h(len, nd), hm(len, nd)
	102	REAL th(len, nd)
	103
	104	! local variables:
	105	INTEGER k, i
	106	REAL rdcp
	107	REAL tvx, tvy ! convect3
	108	REAL cpx(len, nd)
	109
	110	include "cvthermo.h"
	111	include "cv30param.h"
	112
	113
	114	! ori do 110 k=1,nlp
	115	DO k = 1, nl ! convect3
	116	DO i = 1, len
	117	! debug lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
	118	lv(i, k) = lv0 - clmcpv*(t(i,k)-273.15)
	119	cpn(i, k) = cpd(1.0-q(i,k)) + cpvq(i, k)
	120	cpx(i, k) = cpd(1.0-q(i,k)) + clq(i, k)
	121	! ori tv(i,k)=t(i,k)(1.0+q(i,k)epsim1)
	122	tv(i, k) = t(i, k)*(1.0+q(i,k)/eps-q(i,k))
	123	rdcp = (rrd(1.-q(i,k))+q(i,k)rrv)/cpn(i, k)
	124	th(i, k) = t(i, k)(1000.0/p(i,k))*rdcp
	125	END DO
	126	END DO
	127
	128	! gz = phi at the full levels (same as p).
	129
	130	DO i = 1, len
	131	gz(i, 1) = 0.0
	132	END DO
	133	! ori do 140 k=2,nlp
	134	DO k = 2, nl ! convect3
	135	DO i = 1, len
	136	tvx = t(i, k)*(1.+q(i,k)/eps-q(i,k)) !convect3
	137	tvy = t(i, k-1)*(1.+q(i,k-1)/eps-q(i,k-1)) !convect3
	138	gz(i, k) = gz(i, k-1) + 0.5rrd(tvx+tvy) & !convect3
	139	*(p(i,k-1)-p(i,k))/ph(i, k) !convect3
	140
	141	! ori gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
	142	! ori & *(p(i,k-1)-p(i,k))/ph(i,k)
	143	END DO
	144	END DO
	145
	146	! h = phi + cpT (dry static energy).
	147	! hm = phi + cp(T-Tbase)+Lq
	148
	149	! ori do 170 k=1,nlp
	150	DO k = 1, nl ! convect3
	151	DO i = 1, len
	152	h(i, k) = gz(i, k) + cpn(i, k)*t(i, k)
	153	hm(i, k) = gz(i, k) + cpx(i, k)(t(i,k)-t(i,1)) + lv(i, k)q(i, k)
	154	END DO
	155	END DO
	156
	157	RETURN
	158	END SUBROUTINE cv30_prelim
	159
	160	SUBROUTINE cv30_feed(len, nd, t, q, qs, p, ph, hm, gz, nk, icb, icbmax, &
	161	iflag, tnk, qnk, gznk, plcl &
	162	#ifdef ISO
	163	,xt,xtnk &
	164	#endif
	165	)
	166	#ifdef ISO
	167	USE infotrac_phy, ONLY: ntraciso
	168	#endif
	169	IMPLICIT NONE
	170
	171	! ================================================================
	172	! Purpose: CONVECTIVE FEED
	173
	174	! Main differences with cv_feed:
	175	! - ph added in input
	176	! - here, nk(i)=minorig
	177	! - icb defined differently (plcl compared with ph instead of p)
	178
	179	! Main differences with convect3:
	180	! - we do not compute dplcldt and dplcldr of CLIFT anymore
	181	! - values iflag different (but tests identical)
	182	! - A,B explicitely defined (!...)
	183	! ================================================================
	184
	185	include "cv30param.h"
	186
	187	! inputs:
	188	INTEGER len, nd
	189	REAL t(len, nd), q(len, nd), qs(len, nd), p(len, nd)
	190	REAL hm(len, nd), gz(len, nd)
	191	REAL ph(len, nd+1)
	192	#ifdef ISO
	193	real xt(ntraciso,len,nd)
	194	#endif
	195
	196
	197	! outputs:
	198	INTEGER iflag(len), nk(len), icb(len), icbmax
	199	REAL tnk(len), qnk(len), gznk(len), plcl(len)
	200	#ifdef ISO
	201	real xtnk(ntraciso,len)
	202	#endif
	203
	204	! local variables:
	205	INTEGER i, k
	206	#ifdef ISO
	207	integer ixt
	208	#endif
	209	INTEGER ihmin(len)
	210	REAL work(len)
	211	REAL pnk(len), qsnk(len), rh(len), chi(len)
	212	REAL a, b ! convect3
	213	! ym
	214	plcl = 0.0
	215	! @ !-------------------------------------------------------------------
	216	! @ ! --- Find level of minimum moist static energy
	217	! @ ! --- If level of minimum moist static energy coincides with
	218	! @ ! --- or is lower than minimum allowable parcel origin level,
	219	! @ ! --- set iflag to 6.
	220	! @ !-------------------------------------------------------------------
	221	! @
	222	! @ do 180 i=1,len
	223	! @ work(i)=1.0e12
	224	! @ ihmin(i)=nl
	225	! @ 180 continue
	226	! @ do 200 k=2,nlp
	227	! @ do 190 i=1,len
	228	! @ if((hm(i,k).lt.work(i)).and.
	229	! @ & (hm(i,k).lt.hm(i,k-1)))then
	230	! @ work(i)=hm(i,k)
	231	! @ ihmin(i)=k
	232	! @ endif
	233	! @ 190 continue
	234	! @ 200 continue
	235	! @ do 210 i=1,len
	236	! @ ihmin(i)=min(ihmin(i),nlm)
	237	! @ if(ihmin(i).le.minorig)then
	238	! @ iflag(i)=6
	239	! @ endif
	240	! @ 210 continue
	241	! @ c
	242	! @ !-------------------------------------------------------------------
	243	! @ ! --- Find that model level below the level of minimum moist static
	244	! @ ! --- energy that has the maximum value of moist static energy
	245	! @ !-------------------------------------------------------------------
	246	! @
	247	! @ do 220 i=1,len
	248	! @ work(i)=hm(i,minorig)
	249	! @ nk(i)=minorig
	250	! @ 220 continue
	251	! @ do 240 k=minorig+1,nl
	252	! @ do 230 i=1,len
	253	! @ if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))then
	254	! @ work(i)=hm(i,k)
	255	! @ nk(i)=k
	256	! @ endif
	257	! @ 230 continue
	258	! @ 240 continue
	259
	260	! -------------------------------------------------------------------
	261	! --- Origin level of ascending parcels for convect3:
	262	! -------------------------------------------------------------------
	263
	264	DO i = 1, len
	265	nk(i) = minorig
	266	END DO
	267
	268	! -------------------------------------------------------------------
	269	! --- Check whether parcel level temperature and specific humidity
	270	! --- are reasonable
	271	! -------------------------------------------------------------------
	272	DO i = 1, len
	273	IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0)) & ! @ & .or.(
	274	! p(i,ihmin(i)).lt.400.0
	275	! ) )
	276	.AND. (iflag(i)==0)) iflag(i) = 7
	277	END DO
	278	! -------------------------------------------------------------------
	279	! --- Calculate lifted condensation level of air at parcel origin level
	280	! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)
	281	! -------------------------------------------------------------------
	282
	283	a = 1669.0 ! convect3
	284	b = 122.0 ! convect3
	285
	286	DO i = 1, len
	287
	288	IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002
	289
	290	tnk(i) = t(i, nk(i))
	291	qnk(i) = q(i, nk(i))
	292	gznk(i) = gz(i, nk(i))
	293	pnk(i) = p(i, nk(i))
	294	qsnk(i) = qs(i, nk(i))
	295	#ifdef ISO
	296	do ixt=1,ntraciso
	297	xtnk(ixt,i) = xt(ixt,i, nk(i))
	298	enddo
	299	#endif
	300
	301	rh(i) = qnk(i)/qsnk(i)
	302	! ori rh(i)=min(1.0,rh(i)) ! removed for convect3
	303	! ori chi(i)=tnk(i)/(1669.0-122.0*rh(i)-tnk(i))
	304	chi(i) = tnk(i)/(a-b*rh(i)-tnk(i)) ! convect3
	305	plcl(i) = pnk(i)(rh(i)*chi(i))
	306	IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) iflag &
	307	(i) = 8
	308
	309	END IF ! iflag=7
	310
	311	END DO
	312
	313	! -------------------------------------------------------------------
	314	! --- Calculate first level above lcl (=icb)
	315	! -------------------------------------------------------------------
	316
	317	! @ do 270 i=1,len
	318	! @ icb(i)=nlm
	319	! @ 270 continue
	320	! @c
	321	! @ do 290 k=minorig,nl
	322	! @ do 280 i=1,len
	323	! @ if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
	324	! @ & icb(i)=min(icb(i),k)
	325	! @ 280 continue
	326	! @ 290 continue
	327	! @c
	328	! @ do 300 i=1,len
	329	! @ if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
	330	! @ 300 continue
	331
	332	DO i = 1, len
	333	icb(i) = nlm
	334	END DO
	335
	336	! la modification consiste a comparer plcl a ph et non a p:
	337	! icb est defini par : ph(icb)<plcl<ph(icb-1)
	338	! @ do 290 k=minorig,nl
	339	DO k = 3, nl - 1 ! modif pour que icb soit sup/egal a 2
	340	DO i = 1, len
	341	IF (ph(i,k)<plcl(i)) icb(i) = min(icb(i), k)
	342	END DO
	343	END DO
	344
	345	DO i = 1, len
	346	! @ if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
	347	IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
	348	END DO
	349
	350	DO i = 1, len
	351	icb(i) = icb(i) - 1 ! icb sup ou egal a 2
	352	END DO
	353
	354	! Compute icbmax.
	355
	356	icbmax = 2
	357	DO i = 1, len
	358	! ! icbmax=max(icbmax,icb(i))
	359	IF (iflag(i)<7) icbmax = max(icbmax, icb(i)) ! sb Jun7th02
	360	END DO
	361
	362	RETURN
	363	END SUBROUTINE cv30_feed
	364
	365	SUBROUTINE cv30_undilute1(len, nd, t, q, qs, gz, plcl, p, nk, icb, tp, tvp, &
	366	clw, icbs &
	367	#ifdef ISO
	368	& ,xt,xtclw,tg_save &
	369	#endif
	370	& )
	371
	372	#ifdef ISO
	373	USE infotrac_phy, ONLY: ntraciso
	374	USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
	375	iso_eau,iso_HDO, ridicule
	376	USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
	377	#ifdef ISOTRAC
	378	USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
	379	#ifdef ISOVERIF
	380	use isotopes_verif_mod, ONLY: iso_verif_traceur
	381	#endif
	382	#endif
	383	#ifdef ISOVERIF
	384	use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
	385	iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
	386	iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
	387	iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
	388	iso_verif_positif,iso_verif_egalite_vect2D
	389	#endif
	390	#endif
	391	IMPLICIT NONE
	392
	393	! ----------------------------------------------------------------
	394	! Equivalent de TLIFT entre NK et ICB+1 inclus
	395
	396	! Differences with convect4:
	397	! - specify plcl in input
	398	! - icbs is the first level above LCL (may differ from icb)
	399	! - in the iterations, used x(icbs) instead x(icb)
	400	! - many minor differences in the iterations
	401	! - tvp is computed in only one time
	402	! - icbs: first level above Plcl (IMIN de TLIFT) in output
	403	! - if icbs=icb, compute also tp(icb+1),tvp(icb+1) & clw(icb+1)
	404	! ----------------------------------------------------------------
	405
	406	include "cvthermo.h"
	407	include "cv30param.h"
	408
	409
	410	! inputs:
	411	INTEGER len, nd
	412	INTEGER nk(len), icb(len)
	413	REAL t(len, nd), q(len, nd), qs(len, nd), gz(len, nd)
	414	REAL p(len, nd)
	415	REAL plcl(len) ! convect3
	416	#ifdef ISO
	417	real xt(ntraciso,len,nd)
	418	#endif
	419
	420	! outputs:
	421	REAL tp(len, nd), tvp(len, nd), clw(len, nd)
	422	#ifdef ISO
	423	real xtclw(ntraciso,len,nd)
	424	real tg_save(len,nd)
	425	#endif
	426
	427	! local variables:
	428	INTEGER i, k
	429	INTEGER icb1(len), icbs(len), icbsmax2 ! convect3
	430	REAL tg, qg, alv, s, ahg, tc, denom, es, rg
	431	REAL ah0(len), cpp(len)
	432	REAL tnk(len), qnk(len), gznk(len), ticb(len), gzicb(len)
	433	REAL qsicb(len) ! convect3
	434	REAL cpinv(len) ! convect3
	435	#ifdef ISO
	436	integer ixt
	437	real zfice(len),zxtliq(ntraciso,len),zxtice(ntraciso,len)
	438	real q_k(len),clw_k(len),tg_k(len),xt_k(ntraciso,len)
	439	!#ifdef ISOVERIF
	440	! integer iso_verif_positif_nostop
	441	!#endif
	442	#endif
	443
	444	! -------------------------------------------------------------------
	445	! --- Calculates the lifted parcel virtual temperature at nk,
	446	! --- the actual temperature, and the adiabatic
	447	! --- liquid water content. The procedure is to solve the equation.
	448	! cptp+Lqp+phi=cptnk+Lqnk+gznk.
	449	! -------------------------------------------------------------------
	450
	451	#ifdef ISOVERIF
	452	write(,) 'cv30_routine undilute 1 413: entrée'
	453	#endif
	454
	455	DO i = 1, len
	456	tnk(i) = t(i, nk(i))
	457	qnk(i) = q(i, nk(i))
	458	gznk(i) = gz(i, nk(i))
	459	! ori ticb(i)=t(i,icb(i))
	460	! ori gzicb(i)=gz(i,icb(i))
	461	END DO
	462
	463	! * Calculate certain parcel quantities, including static energy *
	464
	465	DO i = 1, len
	466	ah0(i) = (cpd(1.-qnk(i))+clqnk(i))tnk(i) + qnk(i)(lv0-clmcpv*(tnk(i)- &
	467	273.15)) + gznk(i)
	468	cpp(i) = cpd(1.-qnk(i)) + qnk(i)cpv
	469	cpinv(i) = 1./cpp(i)
	470	END DO
	471
	472	! * Calculate lifted parcel quantities below cloud base *
	473
	474	DO i = 1, len !convect3
	475	icb1(i) = min(max(icb(i), 2), nl)
	476	! if icb is below LCL, start loop at ICB+1:
	477	! (icbs est le premier niveau au-dessus du LCL)
	478	icbs(i) = icb1(i) !convect3
	479	IF (plcl(i)<p(i,icb1(i))) THEN
	480	icbs(i) = min(icbs(i)+1, nl) !convect3
	481	END IF
	482	END DO !convect3
	483
	484	DO i = 1, len !convect3
	485	ticb(i) = t(i, icbs(i)) !convect3
	486	gzicb(i) = gz(i, icbs(i)) !convect3
	487	qsicb(i) = qs(i, icbs(i)) !convect3
	488	END DO !convect3
	489
	490
	491	! Re-compute icbsmax (icbsmax2): !convect3
	492	! !convect3
	493	icbsmax2 = 2 !convect3
	494	DO i = 1, len !convect3
	495	icbsmax2 = max(icbsmax2, icbs(i)) !convect3
	496	END DO !convect3
	497
	498	! initialization outputs:
	499
	500	DO k = 1, icbsmax2 ! convect3
	501	DO i = 1, len ! convect3
	502	tp(i, k) = 0.0 ! convect3
	503	tvp(i, k) = 0.0 ! convect3
	504	clw(i, k) = 0.0 ! convect3
	505	#ifdef ISO
	506	do ixt=1,ntraciso
	507	xtclw(ixt,i,k) = 0.0
	508	enddo
	509
	510	#endif
	511	END DO ! convect3
	512	END DO ! convect3
	513
	514	#ifdef ISO
	515	do k=1,nd
	516	do i=1,len
	517	tg_save(i,k)=min(max(t(i,k),pxtmin),pxtmax)
	518	enddo
	519	enddo
	520	!#ifdef ISOVERIF
	521	! write(,) 'tg_save(1,1)=',tg_save(1,1)
	522	!#endif
	523	#endif
	524
	525
	526	! tp and tvp below cloud base:
	527
	528	DO k = minorig, icbsmax2 - 1
	529	DO i = 1, len
	530	tp(i, k) = tnk(i) - (gz(i,k)-gznk(i))*cpinv(i)
	531	tvp(i, k) = tp(i, k)*(1.+qnk(i)/eps-qnk(i)) !whole thing (convect3)
	532	END DO
	533	END DO
	534
	535	! * Find lifted parcel quantities above cloud base *
	536
	537	DO i = 1, len
	538	tg = ticb(i)
	539	! ori qg=qs(i,icb(i))
	540	qg = qsicb(i) ! convect3
	541	! debug alv=lv0-clmcpv*(ticb(i)-t0)
	542	alv = lv0 - clmcpv*(ticb(i)-273.15)
	543
	544	! First iteration.
	545
	546	! ori s=cpd+alvalvqg/(rrvticb(i)ticb(i))
	547	s = cpd(1.-qnk(i)) + clqnk(i) & ! convect3
	548	+alvalvqg/(rrvticb(i)ticb(i)) ! convect3
	549	s = 1./s
	550	! ori ahg=cpdtg+(cl-cpd)qnk(i)ticb(i)+alvqg+gzicb(i)
	551	ahg = cpdtg + (cl-cpd)qnk(i)tg + alvqg + gzicb(i) ! convect3
	552	tg = tg + s*(ah0(i)-ahg)
	553	! ori tg=max(tg,35.0)
	554	! debug tc=tg-t0
	555	tc = tg - 273.15
	556	denom = 243.5 + tc
	557	denom = max(denom, 1.0) ! convect3
	558	! ori if(tc.ge.0.0)then
	559	es = 6.112exp(17.67tc/denom)
	560	! ori else
	561	! ori es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
	562	! ori endif
	563	! ori qg=epses/(p(i,icb(i))-es(1.-eps))
	564	qg = epses/(p(i,icbs(i))-es(1.-eps))
	565	#ifdef CAMMODIF
	566	qg=max(0.0,qg)
	567	#endif
	568
	569	! Second iteration.
	570
	571
	572	! ori s=cpd+alvalvqg/(rrvticb(i)ticb(i))
	573	! ori s=1./s
	574	! ori ahg=cpdtg+(cl-cpd)qnk(i)ticb(i)+alvqg+gzicb(i)
	575	ahg = cpdtg + (cl-cpd)qnk(i)tg + alvqg + gzicb(i) ! convect3
	576	tg = tg + s*(ah0(i)-ahg)
	577	! ori tg=max(tg,35.0)
	578	! debug tc=tg-t0
	579	tc = tg - 273.15
	580	denom = 243.5 + tc
	581	denom = max(denom, 1.0) ! convect3
	582	! ori if(tc.ge.0.0)then
	583	es = 6.112exp(17.67tc/denom)
	584	! ori else
	585	! ori es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
	586	! ori end if
	587	! ori qg=epses/(p(i,icb(i))-es(1.-eps))
	588	qg = epses/(p(i,icbs(i))-es(1.-eps))
	589	#ifdef CAMMODIF
	590	qg=max(0.0,qg)
	591	#endif
	592
	593	alv = lv0 - clmcpv*(ticb(i)-273.15)
	594
	595	! ori c approximation here:
	596	! ori tp(i,icb(i))=(ah0(i)-(cl-cpd)qnk(i)ticb(i)
	597	! ori & -gz(i,icb(i))-alv*qg)/cpd
	598
	599	! convect3: no approximation:
	600	tp(i, icbs(i)) = (ah0(i)-gz(i,icbs(i))-alvqg)/(cpd+(cl-cpd)qnk(i))
	601
	602	! ori clw(i,icb(i))=qnk(i)-qg
	603	! ori clw(i,icb(i))=max(0.0,clw(i,icb(i)))
	604	clw(i, icbs(i)) = qnk(i) - qg
	605	clw(i, icbs(i)) = max(0.0, clw(i,icbs(i)))
	606
	607	rg = qg/(1.-qnk(i))
	608	! ori tvp(i,icb(i))=tp(i,icb(i))(1.+rgepsi)
	609	! convect3: (qg utilise au lieu du vrai mixing ratio rg)
	610	tvp(i, icbs(i)) = tp(i, icbs(i))*(1.+qg/eps-qnk(i)) !whole thing
	611
	612	#ifdef ISO
	613	if (cond_temp_env) then
	614	tg_save(i,icbs(i))=t(i,icbs(i))
	615	else !if (cond_temp_env) then
	616	tg_save(i,icbs(i))=min(max(tg,pxtmin),pxtmax)
	617	endif !if (cond_temp_env) then
	618	#endif
	619
	620	END DO
	621
	622	#ifdef ISO
	623	! calcul de zfice
	624	do i=1,len
	625	zfice(i) = 1.0-(tg_save(i,icbs(i))-pxtice)/(pxtmelt-pxtice)
	626	zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
	627	enddo
	628	! calcul de la composition du condensat glacé et liquide
	629
	630	do i=1,len
	631	clw_k(i)=clw(i,icbs(i))
	632	tg_k(i)=tg_save(i,icbs(i))
	633	do ixt=1,ntraciso
	634	xt_k(ixt,i)=xt(ixt,i,nk(i))
	635	enddo
	636	enddo
	637	#ifdef ISOVERIF
	638	write(,) 'cv30_routine undilute1 573: avant condiso'
	639	write(,) 'tg_save(1,1)=',tg_save(1,1)
	640	do i=1,len
	641	call iso_verif_positif(tg_save(i,icbs(i))-Tmin_verif, &
	642	& 'cv30_routines 654')
	643	enddo
	644	if (iso_HDO.gt.0) then
	645	do i=1,len
	646	if (qnk(i).gt.ridicule) then
	647	call iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), &
	648	& 'cv30_routines 576')
	649	endif !if (qnk(i).gt.ridicule) then
	650	enddo
	651	endif !if (iso_HDO.gt.0) then
	652	! write(,) 'i=1, clw_k,qnk=',clw_k(1),qnk(1)
	653	#endif
	654	call condiso_liq_ice_vectall(xt_k(1,1),qnk(1), &
	655	& clw_k(1),tg_k(1), &
	656	& zfice(1),zxtice(1,1),zxtliq(1,1),len)
	657	#ifdef ISOTRAC
	658	#ifdef ISOVERIF
	659	write(,) 'cv30_routines 658: call condiso_liq_ice_vectall_trac'
	660	#endif
	661	call condiso_liq_ice_vectall_trac(xt_k(1,1),qnk(1), &
	662	& clw_k(1),tg_k(1), &
	663	& zfice(1),zxtice(1,1),zxtliq(1,1),len)
	664	#endif
	665	do i=1,len
	666	do ixt = 1, ntraciso
	667	xtclw(ixt,i,icbs(i))= zxtice(ixt,i)+zxtliq(ixt,i)
	668	xtclw(ixt,i,icbs(i))=max(0.0,xtclw(ixt,i,icbs(i)))
	669	enddo !do ixt=1,niso
	670	enddo !do i=1,len
	671
	672	#ifdef ISOVERIF
	673	write(,) 'cv30_routine undilute 1 598: après condiso'
	674
	675	if (iso_eau.gt.0) then
	676	do i=1,len
	677	call iso_verif_egalite_choix(xtclw(iso_eau,i,icbs(i)), &
	678	& clw(i,icbs(i)),'cv30_routines 577',errmax,errmaxrel)
	679	enddo !do i=1,len
	680	endif !if (iso_eau.gt.0) then
	681	#ifdef ISOTRAC
	682	do i=1,len
	683	call iso_verif_traceur(xtclw(1,i,k),'cv30_routines 603')
	684	enddo
	685	#endif
	686
	687	#endif
	688	#endif
	689
	690	! ori do 380 k=minorig,icbsmax2
	691	! ori do 370 i=1,len
	692	! ori tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
	693	! ori 370 continue
	694	! ori 380 continue
	695
	696
	697	! -- The following is only for convect3:
	698
	699	! * icbs is the first level above the LCL:
	700	! if plcl<p(icb), then icbs=icb+1
	701	! if plcl>p(icb), then icbs=icb
	702
	703	! * the routine above computes tvp from minorig to icbs (included).
	704
	705	! * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
	706	! must be known. This is the case if icbs=icb+1, but not if icbs=icb.
	707
	708	! * therefore, in the case icbs=icb, we compute tvp at level icb+1
	709	! (tvp at other levels will be computed in cv3_undilute2.F)
	710
	711
	712	DO i = 1, len
	713	ticb(i) = t(i, icb(i)+1)
	714	gzicb(i) = gz(i, icb(i)+1)
	715	qsicb(i) = qs(i, icb(i)+1)
	716	END DO
	717
	718	DO i = 1, len
	719	tg = ticb(i)
	720	qg = qsicb(i) ! convect3
	721	! debug alv=lv0-clmcpv*(ticb(i)-t0)
	722	alv = lv0 - clmcpv*(ticb(i)-273.15)
	723
	724	! First iteration.
	725
	726	! ori s=cpd+alvalvqg/(rrvticb(i)ticb(i))
	727	s = cpd(1.-qnk(i)) + clqnk(i) & ! convect3
	728	+alvalvqg/(rrvticb(i)ticb(i)) ! convect3
	729	s = 1./s
	730	! ori ahg=cpdtg+(cl-cpd)qnk(i)ticb(i)+alvqg+gzicb(i)
	731	ahg = cpdtg + (cl-cpd)qnk(i)tg + alvqg + gzicb(i) ! convect3
	732	tg = tg + s*(ah0(i)-ahg)
	733	! ori tg=max(tg,35.0)
	734	! debug tc=tg-t0
	735	tc = tg - 273.15
	736	denom = 243.5 + tc
	737	denom = max(denom, 1.0) ! convect3
	738	! ori if(tc.ge.0.0)then
	739	es = 6.112exp(17.67tc/denom)
	740	! ori else
	741	! ori es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
	742	! ori endif
	743	! ori qg=epses/(p(i,icb(i))-es(1.-eps))
	744	qg = epses/(p(i,icb(i)+1)-es(1.-eps))
	745	#ifdef CAMMODIF
	746	qg=max(0.0,qg)
	747	#endif
	748
	749	! Second iteration.
	750
	751
	752	! ori s=cpd+alvalvqg/(rrvticb(i)ticb(i))
	753	! ori s=1./s
	754	! ori ahg=cpdtg+(cl-cpd)qnk(i)ticb(i)+alvqg+gzicb(i)
	755	ahg = cpdtg + (cl-cpd)qnk(i)tg + alvqg + gzicb(i) ! convect3
	756	tg = tg + s*(ah0(i)-ahg)
	757	! ori tg=max(tg,35.0)
	758	! debug tc=tg-t0
	759	tc = tg - 273.15
	760	denom = 243.5 + tc
	761	denom = max(denom, 1.0) ! convect3
	762	! ori if(tc.ge.0.0)then
	763	es = 6.112exp(17.67tc/denom)
	764	! ori else
	765	! ori es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
	766	! ori end if
	767	! ori qg=epses/(p(i,icb(i))-es(1.-eps))
	768	qg = epses/(p(i,icb(i)+1)-es(1.-eps))
	769	#ifdef CAMMODIF
	770	qg=max(0.0,qg)
	771	#endif
	772
	773	alv = lv0 - clmcpv*(ticb(i)-273.15)
	774
	775	! ori c approximation here:
	776	! ori tp(i,icb(i))=(ah0(i)-(cl-cpd)qnk(i)ticb(i)
	777	! ori & -gz(i,icb(i))-alv*qg)/cpd
	778
	779	! convect3: no approximation:
	780	tp(i, icb(i)+1) = (ah0(i)-gz(i,icb(i)+1)-alvqg)/(cpd+(cl-cpd)qnk(i))
	781
	782	! ori clw(i,icb(i))=qnk(i)-qg
	783	! ori clw(i,icb(i))=max(0.0,clw(i,icb(i)))
	784	clw(i, icb(i)+1) = qnk(i) - qg
	785	clw(i, icb(i)+1) = max(0.0, clw(i,icb(i)+1))
	786
	787	rg = qg/(1.-qnk(i))
	788	! ori tvp(i,icb(i))=tp(i,icb(i))(1.+rgepsi)
	789	! convect3: (qg utilise au lieu du vrai mixing ratio rg)
	790	tvp(i, icb(i)+1) = tp(i, icb(i)+1)*(1.+qg/eps-qnk(i)) !whole thing
	791
	792	#ifdef ISO
	793	if (cond_temp_env) then
	794	tg_save(i,icb(i)+1)=t(i,icb(i)+1)
	795	else !if (cond_temp_env) then
	796	tg_save(i,icb(i)+1)=tg
	797	endif !if (cond_temp_env) then
	798	#ifdef ISOVERIF
	799	call iso_verif_positif(tg_save(i,icb(i)+1) &
	800	& -Tmin_verif,'cv30_routines 735')
	801	#endif
	802	tg_save(i,icb(i)+1)=min(max(tg_save(i,icb(i)+1), &
	803	& pxtmin),pxtmax)
	804	#endif
	805
	806	END DO
	807
	808
	809	#ifdef ISO
	810	do i=1,len
	811	zfice(i) = 1.0-(tg_save(i,icb(i)+1)-pxtice)/(pxtmelt-pxtice)
	812	zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
	813	! call calcul_zfice(tp(i,icb(i)+1),zfice)
	814	enddo !do i=1,len
	815	do i=1,len
	816	clw_k(i)=clw(i,icb(i)+1)
	817	tg_k(i)=tg_save(i,icb(i)+1)
	818	#ifdef ISOVERIF
	819	call iso_verif_positif(tg_k(i)-Tmin_verif,'cv30_routines 750')
	820	#endif
	821	do ixt=1,ntraciso
	822	xt_k(ixt,i)=xt(ixt,i,nk(i))
	823	enddo
	824	enddo !do i=1,len
	825	#ifdef ISOVERIF
	826	write(,) 'cv30_routines 739: avant condiso'
	827	if (iso_HDO.gt.0) then
	828	do i=1,len
	829	call iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), &
	830	& 'cv30_routines 725')
	831	enddo
	832	endif !if (iso_HDO.gt.0) then
	833	#ifdef ISOTRAC
	834	do i=1,len
	835	call iso_verif_traceur(xtclw(1,i,k),'cv30_routines 738')
	836	enddo
	837	#endif
	838	#endif
	839	call condiso_liq_ice_vectall(xt_k(1,1),qnk(1), &
	840	& clw_k(1),tg_k(1), &
	841	& zfice(1),zxtice(1,1),zxtliq(1,1),len)
	842	#ifdef ISOTRAC
	843	call condiso_liq_ice_vectall_trac(xt_k(1,1),qnk(1), &
	844	& clw_k(1),tg_k(1), &
	845	& zfice(1),zxtice(1,1),zxtliq(1,1),len)
	846	#endif
	847	do i=1,len
	848	do ixt = 1, ntraciso
	849	xtclw(ixt,i,icb(i)+1)=zxtice(ixt,i)+zxtliq(ixt,i)
	850	xtclw(ixt,i,icb(i)+1)=max(0.0,xtclw(ixt,i,icb(i)+1))
	851	enddo !do ixt = 1, niso
	852	enddo !do i=1,len
	853
	854	#ifdef ISOVERIF
	855	!write(,) 'DEBUG ISO B'
	856	do i=1,len
	857	if (iso_eau.gt.0) then
	858	call iso_verif_egalite_choix(xtclw(iso_eau,i,icb(i)+1), &
	859	& clw(i,icb(i)+1),'cv30_routines 708',errmax,errmaxrel)
	860	endif ! if (iso_eau.gt.0) then
	861	#ifdef ISOTRAC
	862	call iso_verif_traceur(xtclw(1,i,icb(i)+1), &
	863	& 'cv30_routines 760')
	864	#endif
	865	enddo !do i=1,len
	866	!write(,) 'FIN DEBUG ISO B'
	867	#endif
	868	#endif
	869
	870	RETURN
	871	END SUBROUTINE cv30_undilute1
	872
	873	SUBROUTINE cv30_trigger(len, nd, icb, plcl, p, th, tv, tvp, pbase, buoybase, &
	874	iflag, sig, w0)
	875	IMPLICIT NONE
	876
	877	! -------------------------------------------------------------------
	878	! --- TRIGGERING
	879
	880	! - computes the cloud base
	881	! - triggering (crude in this version)
	882	! - relaxation of sig and w0 when no convection
	883
	884	! Caution1: if no convection, we set iflag=4
	885	! (it used to be 0 in convect3)
	886
	887	! Caution2: at this stage, tvp (and thus buoy) are know up
	888	! through icb only!
	889	! -> the buoyancy below cloud base not (yet) set to the cloud base buoyancy
	890	! -------------------------------------------------------------------
	891
	892	include "cv30param.h"
	893
	894	! input:
	895	INTEGER len, nd
	896	INTEGER icb(len)
	897	REAL plcl(len), p(len, nd)
	898	REAL th(len, nd), tv(len, nd), tvp(len, nd)
	899
	900	! output:
	901	REAL pbase(len), buoybase(len)
	902
	903	! input AND output:
	904	INTEGER iflag(len)
	905	REAL sig(len, nd), w0(len, nd)
	906
	907	! local variables:
	908	INTEGER i, k
	909	REAL tvpbase, tvbase, tdif, ath, ath1
	910
	911
	912	! *** set cloud base buoyancy at (plcl+dpbase) level buoyancy
	913
	914	DO i = 1, len
	915	pbase(i) = plcl(i) + dpbase
	916	tvpbase = tvp(i, icb(i))*(pbase(i)-p(i,icb(i)+1))/ &
	917	(p(i,icb(i))-p(i,icb(i)+1)) + tvp(i, icb(i)+1)*(p(i,icb(i))-pbase(i))/( &
	918	p(i,icb(i))-p(i,icb(i)+1))
	919	tvbase = tv(i, icb(i))*(pbase(i)-p(i,icb(i)+1))/ &
	920	(p(i,icb(i))-p(i,icb(i)+1)) + tv(i, icb(i)+1)*(p(i,icb(i))-pbase(i))/(p &
	921	(i,icb(i))-p(i,icb(i)+1))
	922	buoybase(i) = tvpbase - tvbase
	923	END DO
	924
	925
	926	! * make sure that column is dry adiabatic between the surface *
	927	! * and cloud base, and that lifted air is positively buoyant *
	928	! * at cloud base *
	929	! * if not, return to calling program after resetting *
	930	! * sig(i) and w0(i) *
	931
	932
	933	! oct3 do 200 i=1,len
	934	! oct3
	935	! oct3 tdif = buoybase(i)
	936	! oct3 ath1 = th(i,1)
	937	! oct3 ath = th(i,icb(i)-1) - dttrig
	938	! oct3
	939	! oct3 if (tdif.lt.dtcrit .or. ath.gt.ath1) then
	940	! oct3 do 60 k=1,nl
	941	! oct3 sig(i,k) = betasig(i,k) - 2.alphatdiftdif
	942	! oct3 sig(i,k) = AMAX1(sig(i,k),0.0)
	943	! oct3 w0(i,k) = beta*w0(i,k)
	944	! oct3 60 continue
	945	! oct3 iflag(i)=4 ! pour version vectorisee
	946	! oct3c convect3 iflag(i)=0
	947	! oct3cccc return
	948	! oct3 endif
	949	! oct3
	950	! oct3200 continue
	951
	952	! -- oct3: on reecrit la boucle 200 (pour la vectorisation)
	953
	954	DO k = 1, nl
	955	DO i = 1, len
	956
	957	tdif = buoybase(i)
	958	ath1 = th(i, 1)
	959	ath = th(i, icb(i)-1) - dttrig
	960
	961	IF (tdif<dtcrit .OR. ath>ath1) THEN
	962	sig(i, k) = betasig(i, k) - 2.alphatdiftdif
	963	sig(i, k) = amax1(sig(i,k), 0.0)
	964	w0(i, k) = beta*w0(i, k)
	965	iflag(i) = 4 ! pour version vectorisee
	966	! convect3 iflag(i)=0
	967	END IF
	968
	969	END DO
	970	END DO
	971
	972	! fin oct3 --
	973
	974	RETURN
	975	END SUBROUTINE cv30_trigger
	976
	977	SUBROUTINE cv30_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
	978	plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, &
	979	th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, &
	980	iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, &
	981	v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, w0 &
	982	#ifdef ISO
	983	& ,xtnk1,xt1,xtclw1,tg_save1 &
	984	& ,xtnk,xt,xtclw,tg_save &
	985	#endif
	986	& )
	987	USE print_control_mod, ONLY: lunout
	988	#ifdef ISO
	989	use infotrac_phy, ONLY: ntraciso
	990	use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
	991	#ifdef ISOVERIF
	992	use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &
	993	iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
	994	iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
	995	iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
	996	iso_verif_positif,iso_verif_egalite_vect2D
	997	#endif
	998	#endif
	999	IMPLICIT NONE
	1000
	1001	include "cv30param.h"
	1002
	1003
	1004	! inputs:
	1005	INTEGER len, ncum, nd, ntra, nloc
	1006	INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len)
	1007	REAL plcl1(len), tnk1(len), qnk1(len), gznk1(len)
	1008	REAL pbase1(len), buoybase1(len)
	1009	REAL t1(len, nd), q1(len, nd), qs1(len, nd), u1(len, nd), v1(len, nd)
	1010	REAL gz1(len, nd), h1(len, nd), lv1(len, nd), cpn1(len, nd)
	1011	REAL p1(len, nd), ph1(len, nd+1), tv1(len, nd), tp1(len, nd)
	1012	REAL tvp1(len, nd), clw1(len, nd)
	1013	REAL th1(len, nd)
	1014	REAL sig1(len, nd), w01(len, nd)
	1015	REAL tra1(len, nd, ntra)
	1016	#ifdef ISO
	1017	!integer niso
	1018	real xt1(ntraciso,len,nd), xtclw1(ntraciso,len,nd)
	1019	real tg_save1(len,nd)
	1020	real xtnk1(ntraciso,len)
	1021	#endif
	1022
	1023	! outputs:
	1024	! en fait, on a nloc=len pour l'instant (cf cv_driver)
	1025	INTEGER iflag(nloc), nk(nloc), icb(nloc), icbs(nloc)
	1026	REAL plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)
	1027	REAL pbase(nloc), buoybase(nloc)
	1028	REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd), u(nloc, nd), v(nloc, nd)
	1029	REAL gz(nloc, nd), h(nloc, nd), lv(nloc, nd), cpn(nloc, nd)
	1030	REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
	1031	REAL tvp(nloc, nd), clw(nloc, nd)
	1032	REAL th(nloc, nd)
	1033	REAL sig(nloc, nd), w0(nloc, nd)
	1034	REAL tra(nloc, nd, ntra)
	1035	#ifdef ISO
	1036	real xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
	1037	real tg_save(nloc,nd)
	1038	real xtnk(ntraciso,nloc)
	1039	#endif
	1040
	1041
	1042	! local variables:
	1043	INTEGER i, k, nn, j
	1044	#ifdef ISO
	1045	integer ixt
	1046	#endif
	1047
	1048	CHARACTER (LEN=20) :: modname = 'cv30_compress'
	1049	CHARACTER (LEN=80) :: abort_message
	1050
	1051	#ifdef ISO
	1052	!#ifdef ISOVERIF
	1053	! write(,) 'cv30_compress 1066: tg_save1(1,1)=',tg_save1(1,1)
	1054	! write(,) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
	1055	! write(,) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1)
	1056	!#endif
	1057	! initialisation des champs compresses:
	1058	do k=1,nd
	1059	do i=1,nloc
	1060	if (essai_convergence) then
	1061	else
	1062	q(i,k)=0.0
	1063	clw(i,k)=0.0 ! mise en commentaire le 5 avril pour vérif
	1064	tg_save(i,k)=0.0
	1065	! convergence
	1066	endif !f (negation(essai_convergence)) then
	1067	do ixt=1,ntraciso
	1068	xt(ixt,i,k)=0.0
	1069	xtclw(ixt,i,k)=0.0
	1070	enddo !do ixt=1,niso
	1071	enddo !do i=1,len
	1072	enddo !do k=1,nd
	1073	! write(,) 'q(1,1),xt(iso_eau,1,1)=',q(1,1),xt(iso_eau,1,1)
	1074	#endif
	1075
	1076	DO k = 1, nl + 1
	1077	nn = 0
	1078	DO i = 1, len
	1079	IF (iflag1(i)==0) THEN
	1080	nn = nn + 1
	1081	sig(nn, k) = sig1(i, k)
	1082	w0(nn, k) = w01(i, k)
	1083	t(nn, k) = t1(i, k)
	1084	q(nn, k) = q1(i, k)
	1085	qs(nn, k) = qs1(i, k)
	1086	u(nn, k) = u1(i, k)
	1087	v(nn, k) = v1(i, k)
	1088	gz(nn, k) = gz1(i, k)
	1089	h(nn, k) = h1(i, k)
	1090	lv(nn, k) = lv1(i, k)
	1091	cpn(nn, k) = cpn1(i, k)
	1092	p(nn, k) = p1(i, k)
	1093	ph(nn, k) = ph1(i, k)
	1094	tv(nn, k) = tv1(i, k)
	1095	tp(nn, k) = tp1(i, k)
	1096	tvp(nn, k) = tvp1(i, k)
	1097	clw(nn, k) = clw1(i, k)
	1098	th(nn, k) = th1(i, k)
	1099	#ifdef ISO
	1100	do ixt = 1, ntraciso
	1101	xt(ixt,nn,k)=xt1(ixt,i,k)
	1102	xtclw(ixt,nn,k)=xtclw1(ixt,i,k)
	1103	enddo
	1104	! write(,) 'nn,i,k,q(nn,k),xt(iso_eau,nn,k)=', &
	1105	! & nn,i,k,q(nn, k),xt(ixt,nn,k)
	1106	tg_save(nn,k)=tg_save1(i,k)
	1107	#endif
	1108	END IF
	1109	END DO
	1110	END DO
	1111
	1112	! do 121 j=1,ntra
	1113	! do 111 k=1,nd
	1114	! nn=0
	1115	! do 101 i=1,len
	1116	! if(iflag1(i).eq.0)then
	1117	! nn=nn+1
	1118	! tra(nn,k,j)=tra1(i,k,j)
	1119	! endif
	1120	! 101 continue
	1121	! 111 continue
	1122	! 121 continue
	1123
	1124	IF (nn/=ncum) THEN
	1125	WRITE (lunout, *) 'strange! nn not equal to ncum: ', nn, ncum
	1126	abort_message = ''
	1127	CALL abort_physic(modname, abort_message, 1)
	1128	END IF
	1129
	1130	nn = 0
	1131	DO i = 1, len
	1132	IF (iflag1(i)==0) THEN
	1133	nn = nn + 1
	1134	pbase(nn) = pbase1(i)
	1135	buoybase(nn) = buoybase1(i)
	1136	plcl(nn) = plcl1(i)
	1137	tnk(nn) = tnk1(i)
	1138	qnk(nn) = qnk1(i)
	1139	gznk(nn) = gznk1(i)
	1140	nk(nn) = nk1(i)
	1141	icb(nn) = icb1(i)
	1142	icbs(nn) = icbs1(i)
	1143	iflag(nn) = iflag1(i)
	1144	#ifdef ISO
	1145	do ixt=1,ntraciso
	1146	xtnk(ixt,nn) = xtnk1(ixt,i)
	1147	enddo
	1148	#endif
	1149	END IF
	1150	END DO
	1151
	1152	#ifdef ISO
	1153	#ifdef ISOVERIF
	1154	if (iso_eau.gt.0) then
	1155	do k = 1, nd
	1156	do i = 1, nloc
	1157	!write(,) 'i,k=',i,k
	1158	call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
	1159	& 'compress 973',errmax,errmaxrel)
	1160	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
	1161	& 'compress 975',errmax,errmaxrel)
	1162	enddo
	1163	enddo
	1164	endif !if (iso_eau.gt.0) then
	1165	do k = 1, nd
	1166	do i = 1, nn
	1167	call iso_verif_positif(q(i,k),'compress 1004')
	1168	call iso_verif_positif(tg_save(i,k)-Tmin_verif, &
	1169	& 'cv30_compress 1168')
	1170	enddo
	1171	enddo
	1172	#endif
	1173	#endif
	1174
	1175	RETURN
	1176	END SUBROUTINE cv30_compress
	1177
	1178	SUBROUTINE cv30_undilute2(nloc, ncum, nd, icb, icbs, nk, tnk, qnk, gznk, t, &
	1179	q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, &
	1180	inb, tp, tvp, clw, hp, &
	1181	ep, sigp, buoy &
	1182	#ifdef ISO
	1183	& ,xtnk,xt,xtclw,tg_save &
	1184	#endif
	1185	& )
	1186	! epmax_cape: ajout arguments
	1187	#ifdef ISO
	1188	use infotrac_phy, ONLY: ntraciso
	1189	USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, iso_eau,iso_HDO
	1190	USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
	1191	#ifdef ISOTRAC
	1192	USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac
	1193	#ifdef ISOVERIF
	1194	USE isotopes_verif_mod, ONLY: iso_verif_traceur
	1195	#endif
	1196	#endif
	1197	#ifdef ISOVERIF
	1198	use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,Tmax_verif, &
	1199	iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
	1200	iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
	1201	iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
	1202	iso_verif_positif,iso_verif_egalite_vect2D
	1203	#endif
	1204	#endif
	1205	IMPLICIT NONE
	1206
	1207	! ---------------------------------------------------------------------
	1208	! Purpose:
	1209	! FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	1210	! &
	1211	! COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	1212	! FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	1213	! &
	1214	! FIND THE LEVEL OF NEUTRAL BUOYANCY
	1215
	1216	! Main differences convect3/convect4:
	1217	! - icbs (input) is the first level above LCL (may differ from icb)
	1218	! - many minor differences in the iterations
	1219	! - condensed water not removed from tvp in convect3
	1220	! - vertical profile of buoyancy computed here (use of buoybase)
	1221	! - the determination of inb is different
	1222	! - no inb1, only inb in output
	1223	! ---------------------------------------------------------------------
	1224
	1225	include "cvthermo.h"
	1226	include "cv30param.h"
	1227	include "conema3.h"
	1228
	1229	! inputs:
	1230	INTEGER ncum, nd, nloc
	1231	INTEGER icb(nloc), icbs(nloc), nk(nloc)
	1232	REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd), gz(nloc, nd)
	1233	REAL p(nloc, nd)
	1234	REAL tnk(nloc), qnk(nloc), gznk(nloc)
	1235	REAL lv(nloc, nd), tv(nloc, nd), h(nloc, nd)
	1236	REAL pbase(nloc), buoybase(nloc), plcl(nloc)
	1237
	1238	! outputs:
	1239	INTEGER inb(nloc)
	1240	REAL tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd)
	1241	REAL ep(nloc, nd), sigp(nloc, nd), hp(nloc, nd)
	1242	REAL buoy(nloc, nd)
	1243
	1244	! local variables:
	1245	INTEGER i, k
	1246	REAL tg, qg, ahg, alv, s, tc, es, denom, rg, tca, elacrit
	1247	REAL by, defrac, pden
	1248	REAL ah0(nloc), cape(nloc), capem(nloc), byp(nloc)
	1249	LOGICAL lcape(nloc)
	1250
	1251	#ifdef ISO
	1252	real xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)
	1253	real xtnk(ntraciso,nloc)
	1254	real tg_save(nloc,nd) ! inout
	1255	! real xtep(ntraciso,nloc,nd) ! le 7 mai: on supprime xtep, car pas besoin
	1256	! la chute de precip ne fractionne pas.
	1257	integer ixt
	1258	real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
	1259	real clw_k(nloc),tg_k(nloc)
	1260	#ifdef ISOVERIF
	1261	real qg_save(nloc,nd) ! inout
	1262	!integer iso_verif_positif_nostop
	1263	#endif
	1264	#endif
	1265
	1266	! =====================================================================
	1267	! --- SOME INITIALIZATIONS
	1268	! =====================================================================
	1269
	1270	DO k = 1, nl
	1271	DO i = 1, ncum
	1272	ep(i, k) = 0.0
	1273	sigp(i, k) = spfac
	1274	END DO
	1275	END DO
	1276
	1277	! =====================================================================
	1278	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	1279	! =====================================================================
	1280
	1281	! --- The procedure is to solve the equation.
	1282	! cptp+Lqp+phi=cptnk+Lqnk+gznk.
	1283
	1284	! * Calculate certain parcel quantities, including static energy *
	1285
	1286
	1287	DO i = 1, ncum
	1288	ah0(i) = (cpd(1.-qnk(i))+clqnk(i))*tnk(i) & ! debug &
	1289	! +qnk(i)(lv0-clmcpv(tnk(i)-t0))+gznk(i)
	1290	+qnk(i)(lv0-clmcpv(tnk(i)-273.15)) + gznk(i)
	1291	END DO
	1292
	1293
	1294	! * Find lifted parcel quantities above cloud base *
	1295
	1296
	1297	DO k = minorig + 1, nl
	1298	DO i = 1, ncum
	1299	! ori if(k.ge.(icb(i)+1))then
	1300	IF (k>=(icbs(i)+1)) THEN ! convect3
	1301	tg = t(i, k)
	1302	qg = qs(i, k)
	1303	! debug alv=lv0-clmcpv*(t(i,k)-t0)
	1304	alv = lv0 - clmcpv*(t(i,k)-273.15)
	1305
	1306	! First iteration.
	1307
	1308	! ori s=cpd+alvalvqg/(rrvt(i,k)t(i,k))
	1309	s = cpd(1.-qnk(i)) + clqnk(i) & ! convect3
	1310	+alvalvqg/(rrvt(i,k)t(i,k)) ! convect3
	1311	s = 1./s
	1312	! ori ahg=cpdtg+(cl-cpd)qnk(i)t(i,k)+alvqg+gz(i,k)
	1313	ahg = cpdtg + (cl-cpd)qnk(i)tg + alvqg + gz(i, k) ! convect3
	1314	tg = tg + s*(ah0(i)-ahg)
	1315	! ori tg=max(tg,35.0)
	1316	! debug tc=tg-t0
	1317	tc = tg - 273.15
	1318	denom = 243.5 + tc
	1319	denom = max(denom, 1.0) ! convect3
	1320	! ori if(tc.ge.0.0)then
	1321	es = 6.112exp(17.67tc/denom)
	1322	! ori else
	1323	! ori es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
	1324	! ori endif
	1325	qg = epses/(p(i,k)-es(1.-eps))
	1326	#ifdef CAMMODIF
	1327	qg=max(0.0,qg)
	1328	#endif
	1329
	1330	! Second iteration.
	1331
	1332	! ori s=cpd+alvalvqg/(rrvt(i,k)t(i,k))
	1333	! ori s=1./s
	1334	! ori ahg=cpdtg+(cl-cpd)qnk(i)t(i,k)+alvqg+gz(i,k)
	1335	ahg = cpdtg + (cl-cpd)qnk(i)tg + alvqg + gz(i, k) ! convect3
	1336	tg = tg + s*(ah0(i)-ahg)
	1337	! ori tg=max(tg,35.0)
	1338	! debug tc=tg-t0
	1339	tc = tg - 273.15
	1340	denom = 243.5 + tc
	1341	denom = max(denom, 1.0) ! convect3
	1342	! ori if(tc.ge.0.0)then
	1343	es = 6.112exp(17.67tc/denom)
	1344	! ori else
	1345	! ori es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
	1346	! ori endif
	1347	qg = epses/(p(i,k)-es(1.-eps))
	1348	#ifdef CAMMODIF
	1349	qg=max(0.0,qg)
	1350	#endif
	1351
	1352	! debug alv=lv0-clmcpv*(t(i,k)-t0)
	1353	alv = lv0 - clmcpv*(t(i,k)-273.15)
	1354	! print*,'cpd dans convect2 ',cpd
	1355	! print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
	1356	! print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
	1357
	1358	! ori c approximation here:
	1359	! ori
	1360	! tp(i,k)=(ah0(i)-(cl-cpd)qnk(i)t(i,k)-gz(i,k)-alv*qg)/cpd
	1361
	1362	! convect3: no approximation:
	1363	tp(i, k) = (ah0(i)-gz(i,k)-alvqg)/(cpd+(cl-cpd)qnk(i))
	1364
	1365	clw(i, k) = qnk(i) - qg
	1366	clw(i, k) = max(0.0, clw(i,k))
	1367	rg = qg/(1.-qnk(i))
	1368	! ori tvp(i,k)=tp(i,k)(1.+rgepsi)
	1369	! convect3: (qg utilise au lieu du vrai mixing ratio rg):
	1370	tvp(i, k) = tp(i, k)*(1.+qg/eps-qnk(i)) ! whole thing
	1371
	1372	#ifdef ISO
	1373	if (cond_temp_env) then
	1374	tg_save(i,k)=t(i,k)
	1375	else ! if (cond_temp_env) then
	1376	tg_save(i,k)=min(max(tg,pxtmin),pxtmax)
	1377	endif ! if (cond_temp_env) then
	1378	#ifdef ISOVERIF
	1379	qg_save(i,k)=qg
	1380	#endif
	1381	else !if(k.ge.(icbs(i)+1))then
	1382	tg_save(i,k)=t(i,k)
	1383	clw(i,k)=0.0
	1384	#ifdef ISOVERIF
	1385	qg_save(i,k)=qs(i,k)
	1386	#endif
	1387	#endif
	1388	END IF
	1389	END DO
	1390	#ifdef ISO
	1391	#ifdef ISOVERIF
	1392	do i=1,ncum
	1393	call iso_verif_positif(tg_save(i,k) &
	1394	& -Tmin_verif,'cv30_routines 1368')
	1395	enddo !do i=1,ncum
	1396	#endif
	1397	! calcul de zfice
	1398	do i=1,ncum
	1399	zfice(i) = 1.0-(tg_save(i,k)-pxtice)/(pxtmelt-pxtice)
	1400	zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
	1401	enddo
	1402	do i=1,ncum
	1403	clw_k(i)=clw(i,k)
	1404	tg_k(i)=tg_save(i,k)
	1405	enddo !do i=1,ncum
	1406	#ifdef ISOVERIF
	1407	!write(,) 'cv30_routine 1259: avant condiso'
	1408	if (iso_HDO.gt.0) then
	1409	do i=1,ncum
	1410	call iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
	1411	& 'cv30_routines 1231')
	1412	enddo
	1413	endif !if (iso_HDO.gt.0) then
	1414	if (iso_eau.gt.0) then
	1415	do i=1,ncum
	1416	call iso_verif_egalite(xtnk(iso_eau,i),qnk(i), &
	1417	& 'cv30_routines 1373')
	1418	enddo
	1419	endif !if (iso_HDO.gt.0) then
	1420	do i=1,ncum
	1421	if ((iso_verif_positif_nostop(qnk(i)-clw_k(i), &
	1422	& 'cv30_routines 1275').eq.1).or. &
	1423	& (iso_verif_positif_nostop(tg_k(i)-Tmin_verif, &
	1424	& 'cv30_routines 1297a').eq.1).or. &
	1425	& (iso_verif_positif_nostop(Tmax_verif-tg_k(i), &
	1426	& 'cv30_routines 1297b').eq.1)) then
	1427	write(,) 'i,k,qnk,clw_k=',i,k,qnk(i),clw_k(i)
	1428	write(,) 'tg,t,qg=',tg_k(i),t(i,k),qg_save(i,k)
	1429	write(,) 'icbs(i)=',icbs(i)
	1430	stop
	1431	endif ! if ((iso_verif_positif_nostop
	1432	enddo !do i=1,ncum
	1433	#ifdef ISOTRAC
	1434	do i=1,ncum
	1435	call iso_verif_traceur(xtnk(1,i),'cv30_routines 1251')
	1436	enddo !do i=1,ncum
	1437	#endif
	1438	#endif
	1439	call condiso_liq_ice_vectall(xtnk(1,1),qnk(1), &
	1440	& clw_k(1),tg_k(1), &
	1441	& zfice(1),zxtice(1,1),zxtliq(1,1),ncum)
	1442	#ifdef ISOTRAC
	1443	#ifdef ISOVERIF
	1444	write(,) 'cv30_routines 1283: condiso pour traceurs'
	1445	#endif
	1446	call condiso_liq_ice_vectall_trac(xtnk(1,1),qnk(1), &
	1447	& clw_k(1),tg_k(1), &
	1448	& zfice(1),zxtice(1,1),zxtliq(1,1),ncum)
	1449	#endif
	1450	do i=1,ncum
	1451	do ixt=1,ntraciso
	1452	xtclw(ixt,i,k)=zxtice(ixt,i)+zxtliq(ixt,i)
	1453	xtclw(ixt,i,k)=max(0.0,xtclw(ixt,i,k))
	1454	enddo !do ixt=1,niso
	1455	enddo !do i=1,ncum
	1456	#ifdef ISOVERIF
	1457	if (iso_eau.gt.0) then
	1458	do i=1,ncum
	1459	call iso_verif_egalite_choix(xtclw(iso_eau,i,k), &
	1460	& clw(i,k),'cv30_routines 1223',errmax,errmaxrel)
	1461	enddo
	1462	endif !if (iso_eau.gt.0) then
	1463	#ifdef ISOTRAC
	1464	do i=1,ncum
	1465	call iso_verif_traceur(xtclw(1,i,k),'cv30_routines 1275')
	1466	enddo
	1467	#endif
	1468	#endif
	1469	#endif
	1470	END DO
	1471
	1472	! =====================================================================
	1473	! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
	1474	! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
	1475	! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
	1476	! =====================================================================
	1477
	1478	! ori do 320 k=minorig+1,nl
	1479	DO k = 1, nl ! convect3
	1480	DO i = 1, ncum
	1481	pden = ptcrit - pbcrit
	1482	ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax
	1483	ep(i, k) = amax1(ep(i,k), 0.0)
	1484	ep(i, k) = amin1(ep(i,k), epmax)
	1485	sigp(i, k) = spfac
	1486	! ori if(k.ge.(nk(i)+1))then
	1487	! ori tca=tp(i,k)-t0
	1488	! ori if(tca.ge.0.0)then
	1489	! ori elacrit=elcrit
	1490	! ori else
	1491	! ori elacrit=elcrit*(1.0-tca/tlcrit)
	1492	! ori endif
	1493	! ori elacrit=max(elacrit,0.0)
	1494	! ori ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
	1495	! ori ep(i,k)=max(ep(i,k),0.0 )
	1496	! ori ep(i,k)=min(ep(i,k),1.0 )
	1497	! ori sigp(i,k)=sigs
	1498	! ori endif
	1499	END DO
	1500	END DO
	1501
	1502	! =====================================================================
	1503	! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
	1504	! --- VIRTUAL TEMPERATURE
	1505	! =====================================================================
	1506
	1507	! dans convect3, tvp est calcule en une seule fois, et sans retirer
	1508	! l'eau condensee (~> reversible CAPE)
	1509
	1510	! ori do 340 k=minorig+1,nl
	1511	! ori do 330 i=1,ncum
	1512	! ori if(k.ge.(icb(i)+1))then
	1513	! ori tvp(i,k)=tvp(i,k)(1.0-qnk(i)+ep(i,k)clw(i,k))
	1514	! oric print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
	1515	! oric print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
	1516	! ori endif
	1517	! ori 330 continue
	1518	! ori 340 continue
	1519
	1520	! ori do 350 i=1,ncum
	1521	! ori tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
	1522	! ori 350 continue
	1523
	1524	DO i = 1, ncum ! convect3
	1525	tp(i, nlp) = tp(i, nl) ! convect3
	1526	END DO ! convect3
	1527
	1528	! =====================================================================
	1529	! --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
	1530	! =====================================================================
	1531
	1532	! -- this is for convect3 only:
	1533
	1534	! first estimate of buoyancy:
	1535
	1536	DO i = 1, ncum
	1537	DO k = 1, nl
	1538	buoy(i, k) = tvp(i, k) - tv(i, k)
	1539	END DO
	1540	END DO
	1541
	1542	! set buoyancy=buoybase for all levels below base
	1543	! for safety, set buoy(icb)=buoybase
	1544
	1545	DO i = 1, ncum
	1546	DO k = 1, nl
	1547	IF ((k>=icb(i)) .AND. (k<=nl) .AND. (p(i,k)>=pbase(i))) THEN
	1548	buoy(i, k) = buoybase(i)
	1549	END IF
	1550	END DO
	1551	! IM cf. CRio/JYG 270807 buoy(icb(i),k)=buoybase(i)
	1552	buoy(i, icb(i)) = buoybase(i)
	1553	END DO
	1554
	1555	! -- end convect3
	1556
	1557	! =====================================================================
	1558	! --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
	1559	! --- LEVEL OF NEUTRAL BUOYANCY
	1560	! =====================================================================
	1561
	1562	! -- this is for convect3 only:
	1563
	1564	DO i = 1, ncum
	1565	inb(i) = nl - 1
	1566	END DO
	1567
	1568	DO i = 1, ncum
	1569	DO k = 1, nl - 1
	1570	IF ((k>=icb(i)) .AND. (buoy(i,k)<dtovsh)) THEN
	1571	inb(i) = min(inb(i), k)
	1572	END IF
	1573	END DO
	1574	END DO
	1575
	1576	! -- end convect3
	1577
	1578	! ori do 510 i=1,ncum
	1579	! ori cape(i)=0.0
	1580	! ori capem(i)=0.0
	1581	! ori inb(i)=icb(i)+1
	1582	! ori inb1(i)=inb(i)
	1583	! ori 510 continue
	1584
	1585	! Originial Code
	1586
	1587	! do 530 k=minorig+1,nl-1
	1588	! do 520 i=1,ncum
	1589	! if(k.ge.(icb(i)+1))then
	1590	! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
	1591	! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
	1592	! cape(i)=cape(i)+by
	1593	! if(by.ge.0.0)inb1(i)=k+1
	1594	! if(cape(i).gt.0.0)then
	1595	! inb(i)=k+1
	1596	! capem(i)=cape(i)
	1597	! endif
	1598	! endif
	1599	! 520 continue
	1600	! 530 continue
	1601	! do 540 i=1,ncum
	1602	! byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
	1603	! cape(i)=capem(i)+byp
	1604	! defrac=capem(i)-cape(i)
	1605	! defrac=max(defrac,0.001)
	1606	! frac(i)=-cape(i)/defrac
	1607	! frac(i)=min(frac(i),1.0)
	1608	! frac(i)=max(frac(i),0.0)
	1609	! 540 continue
	1610
	1611	! K Emanuel fix
	1612
	1613	! call zilch(byp,ncum)
	1614	! do 530 k=minorig+1,nl-1
	1615	! do 520 i=1,ncum
	1616	! if(k.ge.(icb(i)+1))then
	1617	! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
	1618	! cape(i)=cape(i)+by
	1619	! if(by.ge.0.0)inb1(i)=k+1
	1620	! if(cape(i).gt.0.0)then
	1621	! inb(i)=k+1
	1622	! capem(i)=cape(i)
	1623	! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
	1624	! endif
	1625	! endif
	1626	! 520 continue
	1627	! 530 continue
	1628	! do 540 i=1,ncum
	1629	! inb(i)=max(inb(i),inb1(i))
	1630	! cape(i)=capem(i)+byp(i)
	1631	! defrac=capem(i)-cape(i)
	1632	! defrac=max(defrac,0.001)
	1633	! frac(i)=-cape(i)/defrac
	1634	! frac(i)=min(frac(i),1.0)
	1635	! frac(i)=max(frac(i),0.0)
	1636	! 540 continue
	1637
	1638	! J Teixeira fix
	1639
	1640	! ori call zilch(byp,ncum)
	1641	! ori do 515 i=1,ncum
	1642	! ori lcape(i)=.true.
	1643	! ori 515 continue
	1644	! ori do 530 k=minorig+1,nl-1
	1645	! ori do 520 i=1,ncum
	1646	! ori if(cape(i).lt.0.0)lcape(i)=.false.
	1647	! ori if((k.ge.(icb(i)+1)).and.lcape(i))then
	1648	! ori by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
	1649	! ori byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
	1650	! ori cape(i)=cape(i)+by
	1651	! ori if(by.ge.0.0)inb1(i)=k+1
	1652	! ori if(cape(i).gt.0.0)then
	1653	! ori inb(i)=k+1
	1654	! ori capem(i)=cape(i)
	1655	! ori endif
	1656	! ori endif
	1657	! ori 520 continue
	1658	! ori 530 continue
	1659	! ori do 540 i=1,ncum
	1660	! ori cape(i)=capem(i)+byp(i)
	1661	! ori defrac=capem(i)-cape(i)
	1662	! ori defrac=max(defrac,0.001)
	1663	! ori frac(i)=-cape(i)/defrac
	1664	! ori frac(i)=min(frac(i),1.0)
	1665	! ori frac(i)=max(frac(i),0.0)
	1666	! ori 540 continue
	1667
	1668	! =====================================================================
	1669	! --- CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
	1670	! =====================================================================
	1671
	1672	! ym do i=1,ncum*nlp
	1673	! ym hp(i,1)=h(i,1)
	1674	! ym enddo
	1675
	1676	DO k = 1, nlp
	1677	DO i = 1, ncum
	1678	hp(i, k) = h(i, k)
	1679	END DO
	1680	END DO
	1681
	1682	DO k = minorig + 1, nl
	1683	DO i = 1, ncum
	1684	IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
	1685	hp(i, k) = h(i, nk(i)) + (lv(i,k)+(cpd-cpv)t(i,k))ep(i, k)*clw(i, k &
	1686	)
	1687	END IF
	1688	END DO
	1689	END DO
	1690
	1691	RETURN
	1692	END SUBROUTINE cv30_undilute2
	1693
	1694	SUBROUTINE cv30_closure(nloc, ncum, nd, icb, inb, pbase, p, ph, tv, buoy, &
	1695	sig, w0, cape, m)
	1696	IMPLICIT NONE
	1697
	1698	! ===================================================================
	1699	! --- CLOSURE OF CONVECT3
	1700
	1701	! vectorization: S. Bony
	1702	! ===================================================================
	1703
	1704	include "cvthermo.h"
	1705	include "cv30param.h"
	1706
	1707	! input:
	1708	INTEGER ncum, nd, nloc
	1709	INTEGER icb(nloc), inb(nloc)
	1710	REAL pbase(nloc)
	1711	REAL p(nloc, nd), ph(nloc, nd+1)
	1712	REAL tv(nloc, nd), buoy(nloc, nd)
	1713
	1714	! input/output:
	1715	REAL sig(nloc, nd), w0(nloc, nd)
	1716
	1717	! output:
	1718	REAL cape(nloc)
	1719	REAL m(nloc, nd)
	1720
	1721	! local variables:
	1722	INTEGER i, j, k, icbmax
	1723	REAL deltap, fac, w, amu
	1724	REAL dtmin(nloc, nd), sigold(nloc, nd)
	1725
	1726	! -------------------------------------------------------
	1727	! -- Initialization
	1728	! -------------------------------------------------------
	1729
	1730	DO k = 1, nl
	1731	DO i = 1, ncum
	1732	m(i, k) = 0.0
	1733	END DO
	1734	END DO
	1735
	1736	! -------------------------------------------------------
	1737	! -- Reset sig(i) and w0(i) for i>inb and i<icb
	1738	! -------------------------------------------------------
	1739
	1740	! update sig and w0 above LNB:
	1741
	1742	DO k = 1, nl - 1
	1743	DO i = 1, ncum
	1744	IF ((inb(i)<(nl-1)) .AND. (k>=(inb(i)+1))) THEN
	1745	sig(i, k) = betasig(i, k) + 2.alphabuoy(i, inb(i))abs(buoy(i,inb( &
	1746	i)))
	1747	sig(i, k) = amax1(sig(i,k), 0.0)
	1748	w0(i, k) = beta*w0(i, k)
	1749	END IF
	1750	END DO
	1751	END DO
	1752
	1753	! compute icbmax:
	1754
	1755	icbmax = 2
	1756	DO i = 1, ncum
	1757	icbmax = max(icbmax, icb(i))
	1758	END DO
	1759
	1760	! update sig and w0 below cloud base:
	1761
	1762	DO k = 1, icbmax
	1763	DO i = 1, ncum
	1764	IF (k<=icb(i)) THEN
	1765	sig(i, k) = betasig(i, k) - 2.alphabuoy(i, icb(i))buoy(i, icb(i))
	1766	sig(i, k) = amax1(sig(i,k), 0.0)
	1767	w0(i, k) = beta*w0(i, k)
	1768	END IF
	1769	END DO
	1770	END DO
	1771
	1772	! ! if(inb.lt.(nl-1))then
	1773	! ! do 85 i=inb+1,nl-1
	1774	! ! sig(i)=betasig(i)+2.alphabuoy(inb)
	1775	! ! 1 abs(buoy(inb))
	1776	! ! sig(i)=amax1(sig(i),0.0)
	1777	! ! w0(i)=beta*w0(i)
	1778	! ! 85 continue
	1779	! ! end if
	1780
	1781	! ! do 87 i=1,icb
	1782	! ! sig(i)=betasig(i)-2.alphabuoy(icb)buoy(icb)
	1783	! ! sig(i)=amax1(sig(i),0.0)
	1784	! ! w0(i)=beta*w0(i)
	1785	! ! 87 continue
	1786
	1787	! -------------------------------------------------------------
	1788	! -- Reset fractional areas of updrafts and w0 at initial time
	1789	! -- and after 10 time steps of no convection
	1790	! -------------------------------------------------------------
	1791
	1792	DO k = 1, nl - 1
	1793	DO i = 1, ncum
	1794	IF (sig(i,nd)<1.5 .OR. sig(i,nd)>12.0) THEN
	1795	sig(i, k) = 0.0
	1796	w0(i, k) = 0.0
	1797	END IF
	1798	END DO
	1799	END DO
	1800
	1801	! -------------------------------------------------------------
	1802	! -- Calculate convective available potential energy (cape),
	1803	! -- vertical velocity (w), fractional area covered by
	1804	! -- undilute updraft (sig), and updraft mass flux (m)
	1805	! -------------------------------------------------------------
	1806
	1807	DO i = 1, ncum
	1808	cape(i) = 0.0
	1809	END DO
	1810
	1811	! compute dtmin (minimum buoyancy between ICB and given level k):
	1812
	1813	DO i = 1, ncum
	1814	DO k = 1, nl
	1815	dtmin(i, k) = 100.0
	1816	END DO
	1817	END DO
	1818
	1819	DO i = 1, ncum
	1820	DO k = 1, nl
	1821	DO j = minorig, nl
	1822	IF ((k>=(icb(i)+1)) .AND. (k<=inb(i)) .AND. (j>=icb(i)) .AND. (j<=(k- &
	1823	1))) THEN
	1824	dtmin(i, k) = amin1(dtmin(i,k), buoy(i,j))
	1825	END IF
	1826	END DO
	1827	END DO
	1828	END DO
	1829
	1830	! the interval on which cape is computed starts at pbase :
	1831	DO k = 1, nl
	1832	DO i = 1, ncum
	1833
	1834	IF ((k>=(icb(i)+1)) .AND. (k<=inb(i))) THEN
	1835
	1836	deltap = min(pbase(i), ph(i,k-1)) - min(pbase(i), ph(i,k))
	1837	cape(i) = cape(i) + rrdbuoy(i, k-1)deltap/p(i, k-1)
	1838	cape(i) = amax1(0.0, cape(i))
	1839	sigold(i, k) = sig(i, k)
	1840
	1841	! dtmin(i,k)=100.0
	1842	! do 97 j=icb(i),k-1 ! mauvaise vectorisation
	1843	! dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
	1844	! 97 continue
	1845
	1846	sig(i, k) = betasig(i, k) + alphadtmin(i, k)*abs(dtmin(i,k))
	1847	sig(i, k) = amax1(sig(i,k), 0.0)
	1848	sig(i, k) = amin1(sig(i,k), 0.01)
	1849	fac = amin1(((dtcrit-dtmin(i,k))/dtcrit), 1.0)
	1850	w = (1.-beta)facsqrt(cape(i)) + beta*w0(i, k)
	1851	amu = 0.5(sig(i,k)+sigold(i,k))w
	1852	m(i, k) = amu0.007p(i, k)*(ph(i,k)-ph(i,k+1))/tv(i, k)
	1853	w0(i, k) = w
	1854	END IF
	1855
	1856	END DO
	1857	END DO
	1858
	1859	DO i = 1, ncum
	1860	w0(i, icb(i)) = 0.5*w0(i, icb(i)+1)
	1861	m(i, icb(i)) = 0.5m(i, icb(i)+1)(ph(i,icb(i))-ph(i,icb(i)+1))/ &
	1862	(ph(i,icb(i)+1)-ph(i,icb(i)+2))
	1863	sig(i, icb(i)) = sig(i, icb(i)+1)
	1864	sig(i, icb(i)-1) = sig(i, icb(i))
	1865	END DO
	1866
	1867
	1868	! ! cape=0.0
	1869	! ! do 98 i=icb+1,inb
	1870	! ! deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
	1871	! ! cape=cape+rrdbuoy(i-1)deltap/p(i-1)
	1872	! ! dcape=rrdbuoy(i-1)deltap/p(i-1)
	1873	! ! dlnp=deltap/p(i-1)
	1874	! ! cape=amax1(0.0,cape)
	1875	! ! sigold=sig(i)
	1876
	1877	! ! dtmin=100.0
	1878	! ! do 97 j=icb,i-1
	1879	! ! dtmin=amin1(dtmin,buoy(j))
	1880	! ! 97 continue
	1881
	1882	! ! sig(i)=betasig(i)+alphadtmin*abs(dtmin)
	1883	! ! sig(i)=amax1(sig(i),0.0)
	1884	! ! sig(i)=amin1(sig(i),0.01)
	1885	! ! fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
	1886	! ! w=(1.-beta)facsqrt(cape)+beta*w0(i)
	1887	! ! amu=0.5(sig(i)+sigold)w
	1888	! ! m(i)=amu0.007p(i)*(ph(i)-ph(i+1))/tv(i)
	1889	! ! w0(i)=w
	1890	! ! 98 continue
	1891	! ! w0(icb)=0.5*w0(icb+1)
	1892	! ! m(icb)=0.5m(icb+1)(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
	1893	! ! sig(icb)=sig(icb+1)
	1894	! ! sig(icb-1)=sig(icb)
	1895
	1896	RETURN
	1897	END SUBROUTINE cv30_closure
	1898
	1899	SUBROUTINE cv30_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, ph, t, rr, rs, &
	1900	u, v, tra, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, ment, qent, uent, &
	1901	vent, sij, elij, ments, qents, traent &
	1902	#ifdef ISO
	1903	& ,xt,xtnk,xtclw &
	1904	& ,xtent,xtelij,tg_save &
	1905	#endif
	1906	& )
	1907
	1908	#ifdef ISO
	1909	use infotrac_phy, ONLY: ntraciso,niso,index_trac
	1910	USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, &
	1911	ridicule
	1912	USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
	1913	#ifdef ISOVERIF
	1914	use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
	1915	iso_verif_egalite_choix,iso_verif_aberrant_choix, iso_verif_noNaN, &
	1916	iso_verif_aberrant, &
	1917	iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
	1918	iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
	1919	iso_verif_positif,iso_verif_egalite_vect2D
	1920	#endif
	1921	#ifdef ISOTRAC
	1922	use isotrac_mod, only: option_tmin,option_traceurs,seuil_tag_tmin, &
	1923	& option_cond,index_zone,izone_cond,index_iso
	1924	use isotrac_routines_mod, only: iso_recolorise_condensation
	1925	use isotopes_routines_mod, only: condiso_liq_ice_vectall_trac
	1926	#ifdef ISOVERIF
	1927	use isotopes_verif_mod, ONLY: iso_verif_trac17_q_deltad,iso_verif_traceur, &
	1928	& iso_verif_traceur_justmass
	1929	#endif
	1930	#endif
	1931	#endif
	1932
	1933	IMPLICIT NONE
	1934
	1935	! ---------------------------------------------------------------------
	1936	! a faire:
	1937	! - changer rr(il,1) -> qnk(il)
	1938	! - vectorisation de la partie normalisation des flux (do 789...)
	1939	! ---------------------------------------------------------------------
	1940
	1941	include "cvthermo.h"
	1942	include "cv30param.h"
	1943
	1944	! inputs:
	1945	INTEGER ncum, nd, na, ntra, nloc
	1946	INTEGER icb(nloc), inb(nloc), nk(nloc)
	1947	REAL sig(nloc, nd)
	1948	REAL qnk(nloc)
	1949	REAL ph(nloc, nd+1)
	1950	REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd)
	1951	REAL u(nloc, nd), v(nloc, nd)
	1952	REAL tra(nloc, nd, ntra) ! input of convect3
	1953	REAL lv(nloc, na), h(nloc, na), hp(nloc, na)
	1954	REAL tv(nloc, na), tvp(nloc, na), ep(nloc, na), clw(nloc, na)
	1955	REAL m(nloc, na) ! input of convect3
	1956	#ifdef ISO
	1957	real xt(ntraciso,nloc,na), xtclw(ntraciso,nloc,na)
	1958	real tg_save(nloc,nd)
	1959	real xtnk(ntraciso,nloc)
	1960	! real xtep(ntraciso,nloc,na)
	1961	#endif
	1962
	1963	! outputs:
	1964	REAL ment(nloc, na, na), qent(nloc, na, na)
	1965	REAL uent(nloc, na, na), vent(nloc, na, na)
	1966	REAL sij(nloc, na, na), elij(nloc, na, na)
	1967	REAL traent(nloc, nd, nd, ntra)
	1968	REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
	1969	REAL sigij(nloc, nd, nd)
	1970	#ifdef ISO
	1971	real xtent(ntraciso,nloc,nd,nd)
	1972	real xtelij(ntraciso,nloc,nd,nd)
	1973	#endif
	1974
	1975	! local variables:
	1976	INTEGER i, j, k, il, im, jm
	1977	INTEGER num1, num2
	1978	INTEGER nent(nloc, na)
	1979	REAL rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
	1980	REAL alt, smid, sjmin, sjmax, delp, delm
	1981	REAL asij(nloc), smax(nloc), scrit(nloc)
	1982	REAL asum(nloc, nd), bsum(nloc, nd), csum(nloc, nd)
	1983	REAL wgh
	1984	REAL zm(nloc, na)
	1985	LOGICAL lwork(nloc)
	1986	#ifdef ISO
	1987	integer ixt
	1988	real xtrti(ntraciso,nloc)
	1989	real xtres(ntraciso)
	1990	! on ajoute la dimension nloc à xtrti pour vérifs dans les tags: 5 fev
	1991	! 2010
	1992	real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
	1993	! real xt_reduit(ntraciso)
	1994	! logical negation
	1995	!#ifdef ISOVERIF
	1996	! integer iso_verif_positif_nostop
	1997	!#endif
	1998	#endif
	1999
	2000	! =====================================================================
	2001	! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
	2002	! =====================================================================
	2003	#ifdef ISO
	2004	#ifdef ISOVERIF
	2005	write(,) 'cv30_routines 1820: entrée dans cv3_mixing'
	2006	if (iso_eau.gt.0) then
	2007	call iso_verif_egalite_vect2D( &
	2008	& xtclw,clw, &
	2009	& 'cv30_mixing 1841',ntraciso,nloc,na)
	2010	endif
	2011	do i=1,ncum
	2012	do j=1,nl
	2013	if (iso_verif_positif_nostop(tg_save(i,j)-Tmin_verif, &
	2014	& 'cv30_mixing 1960').eq.1) then
	2015	write(,) 'i,j=',i,j
	2016	write(,) 'icb(i)=',icb(i)
	2017	stop
	2018	endif
	2019	enddo
	2020	enddo
	2021	#endif
	2022	#endif
	2023
	2024	! ori do 360 i=1,ncum*nlp
	2025	DO j = 1, nl
	2026	DO i = 1, ncum
	2027	nent(i, j) = 0
	2028	! in convect3, m is computed in cv3_closure
	2029	! ori m(i,1)=0.0
	2030	END DO
	2031	END DO
	2032
	2033	! ori do 400 k=1,nlp
	2034	! ori do 390 j=1,nlp
	2035	DO j = 1, nl
	2036	DO k = 1, nl
	2037	DO i = 1, ncum
	2038	qent(i, k, j) = rr(i, j)
	2039	uent(i, k, j) = u(i, j)
	2040	vent(i, k, j) = v(i, j)
	2041	elij(i, k, j) = 0.0
	2042	! ym ment(i,k,j)=0.0
	2043	! ym sij(i,k,j)=0.0
	2044	END DO
	2045	END DO
	2046	END DO
	2047
	2048
	2049	#ifdef ISO
	2050	do j=1,nd
	2051	do k=1,nd
	2052	do i=1,ncum
	2053	do ixt =1,ntraciso
	2054	xtent(ixt,i,k,j)=xt(ixt,i,j)
	2055	xtelij(ixt,i,k,j)=0.0
	2056	enddo !do ixt =1,niso
	2057	! on initialise mieux que ça qent et elij, même si au final les
	2058	! valeurs en nd=nl+1 ne sont pas utilisées
	2059	qent(i,k,j)=rr(i,j)
	2060	elij(i,k,j)=0.0
	2061	enddo !do i=1,ncum
	2062	enddo !do k=1,nl
	2063	enddo !do j=1,nl
	2064	#endif
	2065
	2066	! ym
	2067	ment(1:ncum, 1:nd, 1:nd) = 0.0
	2068	sij(1:ncum, 1:nd, 1:nd) = 0.0
	2069
	2070	! do k=1,ntra
	2071	! do j=1,nd ! instead nlp
	2072	! do i=1,nd ! instead nlp
	2073	! do il=1,ncum
	2074	! traent(il,i,j,k)=tra(il,j,k)
	2075	! enddo
	2076	! enddo
	2077	! enddo
	2078	! enddo
	2079	zm(:, :) = 0.
	2080
	2081	! =====================================================================
	2082	! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
	2083	! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
	2084	! --- FRACTION (sij)
	2085	! =====================================================================
	2086
	2087	DO i = minorig + 1, nl
	2088
	2089	DO j = minorig, nl
	2090	DO il = 1, ncum
	2091	IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)- &
	2092	1)) .AND. (j<=inb(il))) THEN
	2093
	2094	rti = rr(il, 1) - ep(il, i)*clw(il, i)
	2095	bf2 = 1. + lv(il, j)lv(il, j)rs(il, j)/(rrvt(il,j)t(il,j)*cpd)
	2096	anum = h(il, j) - hp(il, i) + (cpv-cpd)t(il, j)(rti-rr(il,j))
	2097	denom = h(il, i) - hp(il, i) + (cpd-cpv)(rr(il,i)-rti)t(il, j)
	2098	dei = denom
	2099	IF (abs(dei)<0.01) dei = 0.01
	2100	sij(il, i, j) = anum/dei
	2101	sij(il, i, i) = 1.0
	2102	altem = sij(il, i, j)rr(il, i) + (1.-sij(il,i,j))rti - rs(il, j)
	2103	altem = altem/bf2
	2104	cwat = clw(il, j)*(1.-ep(il,j))
	2105	stemp = sij(il, i, j)
	2106	IF ((stemp<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
	2107	anum = anum - lv(il, j)(rti-rs(il,j)-cwatbf2)
	2108	denom = denom + lv(il, j)*(rr(il,i)-rti)
	2109	IF (abs(denom)<0.01) denom = 0.01
	2110	sij(il, i, j) = anum/denom
	2111	altem = sij(il, i, j)rr(il, i) + (1.-sij(il,i,j))rti - &
	2112	rs(il, j)
	2113	altem = altem - (bf2-1.)*cwat
	2114	END IF
	2115	IF (sij(il,i,j)>0.0 .AND. sij(il,i,j)<0.95) THEN
	2116	qent(il, i, j) = sij(il, i, j)rr(il, i) + (1.-sij(il,i,j))rti
	2117	uent(il, i, j) = sij(il, i, j)*u(il, i) + &
	2118	(1.-sij(il,i,j))*u(il, nk(il))
	2119	vent(il, i, j) = sij(il, i, j)*v(il, i) + &
	2120	(1.-sij(il,i,j))*v(il, nk(il))
	2121	! !!! do k=1,ntra
	2122	! !!! traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
	2123	! !!! : +(1.-sij(il,i,j))*tra(il,nk(il),k)
	2124	! !!! end do
	2125	elij(il, i, j) = altem
	2126	elij(il, i, j) = amax1(0.0, elij(il,i,j))
	2127	ment(il, i, j) = m(il, i)/(1.-sij(il,i,j))
	2128	nent(il, i) = nent(il, i) + 1
	2129	END IF
	2130	sij(il, i, j) = amax1(0.0, sij(il,i,j))
	2131	sij(il, i, j) = amin1(1.0, sij(il,i,j))
	2132	END IF ! new
	2133	END DO
	2134
	2135
	2136	#ifdef ISO
	2137	#ifdef ISOVERIF
	2138	!write(,) 'cv30_routines tmp 2078'
	2139	#endif
	2140	do il=1,ncum
	2141	zfice(il) = 1.0-(tg_save(il,j)-pxtice)/(pxtmelt-pxtice)
	2142	zfice(il) = MIN(MAX(zfice(il),0.0),1.0)
	2143	if( (i.ge.icb(il)).and.(i.le.inb(il)).and. &
	2144	& (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
	2145	do ixt=1,ntraciso
	2146	! xtrti(ixt)=xt(ixt,il,1)-xtep(ixt,il,i)*xtclw(ixt,il,i) ! le 7 mai: on supprime xtep
	2147	xtrti(ixt,il)=xt(ixt,il,1)-ep(il,i)*xtclw(ixt,il,i)
	2148	enddo
	2149	if(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)then
	2150	! temperature of condensation (within mixtures):
	2151	! tcond(il)=t(il,j)
	2152	! : + ( sij(il,i,j)rr(il,i)+(1.-sij(il,i,j))rti
	2153	! : - elij(il,i,j) - rs(il,j) )
	2154	! : / ( cpd*(bf2-1.0)/lv(il,j) )
	2155
	2156	do ixt = 1, ntraciso
	2157	! total mixing ratio in the mixtures before precipitation:
	2158	xtent(ixt,il,i,j)=sij(il,i,j)*xt(ixt,il,i) &
	2159	& +(1.-sij(il,i,j))*xtrti(ixt,il)
	2160	enddo !do ixt = 1, ntraciso
	2161	endif !if(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)then
	2162	endif !if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
	2163	enddo !do il=1,ncum
	2164
	2165	call condiso_liq_ice_vectall(xtent(1,1,i,j),qent(1,i,j), &
	2166	& elij(1,i,j), &
	2167	& tg_save(1,j),zfice(1),zxtice(1,1),zxtliq(1,1),ncum)
	2168	#ifdef ISOTRAC
	2169	call condiso_liq_ice_vectall_trac(xtent(1,1,i,j),qent(1,i,j), &
	2170	& elij(1,i,j), &
	2171	& tg_save(1,j),zfice(1),zxtice(1,1),zxtliq(1,1),ncum)
	2172	#ifdef ISOVERIF
	2173	do il=1,ncum
	2174	call iso_verif_traceur(xt(1,il,i),'cv30_routines 1967')
	2175	if( (i.ge.icb(il)).and.(i.le.inb(il)).and. &
	2176	& (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
	2177	call iso_verif_traceur(xtrti(1,il),'cv30_routines 1968')
	2178	endif !if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
	2179	call iso_verif_traceur(xtent(1,il,i,j),'cv30_routines 1969')
	2180
	2181	enddo !do il=1,ncum
	2182	#endif
	2183	#endif
	2184	do il=1,ncum
	2185	do ixt = 1, ntraciso
	2186	xtelij(ixt,il,i,j)=zxtice(ixt,il)+zxtliq(ixt,il)
	2187	enddo !do ixt = 1, ntraciso
	2188	enddo !do il=1,ncum
	2189
	2190	#ifdef ISOVERIF
	2191	if ((j.eq.15).and.(i.eq.15)) then
	2192	il=2722
	2193	if (il.le.ncum) then
	2194	write(,) 'cv30_routines tmp 2194, il,i,j=',il,i,j
	2195	write(,) 'qent,elij=',qent(il,i,j),elij(il,i,j)
	2196	write(,) 'tgsave,zfice=',tg_save(il,j),zfice(il)
	2197	write(,) 'deltaDqent=',deltaD(xtent(iso_HDO,il,i,j)/qent(il,i,j))
	2198	write(,) 'deltaDelij=',deltaD(xtelij(iso_HDO,il,i,j)/elij(il,i,j))
	2199	write(,) 'deltaDice=',deltaD(zxtice(iso_HDO,il)/(zfice(il)*elij(il,i,j)))
	2200	write(,) 'deltaDliq=',deltaD(zxtliq(iso_HDO,il)/(1.0-zfice(il)*elij(il,i,j)))
	2201	endif
	2202	endif
	2203	#endif
	2204
	2205	#ifdef ISOTRAC
	2206	! write(,) 'cv30_routines tmp 1987,option_traceurs=',
	2207	! : option_traceurs
	2208	if (option_tmin.ge.1) then
	2209	do il=1,ncum
	2210	! write(,) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
	2211	! : 'tcond(il),rs(il,j)=',
	2212	! : il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
	2213	! colorier la vapeur résiduelle selon température de
	2214	! condensation, et le condensat en un tag spécifique
	2215	if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) then
	2216	if (option_traceurs.eq.17) then
	2217	call iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
	2218	& xtent(1,il,i,j),xtelij(1,il,i,j),tg_save(1,j), &
	2219	& 0.0,xtres, &
	2220	& seuil_tag_tmin)
	2221	else !if (option_traceurs.eq.17) then
	2222	! write(,) 'cv3 2002: il,i,j =',il,i,j
	2223	call iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), &
	2224	& xtent(1,il,i,j),xtelij(1,il,i,j),rs(il,j),0.0,xtres, &
	2225	& seuil_tag_tmin)
	2226	endif !if (option_traceurs.eq.17) then
	2227	do ixt=1+niso,ntraciso
	2228	xtent(ixt,il,i,j)=xtres(ixt)
	2229	enddo
	2230	endif !if (cond.gt.0.0) then
	2231	enddo !do il=1,ncum
	2232	#ifdef ISOVERIF
	2233	do il=1,ncum
	2234	call iso_verif_traceur(xtent(1,il,i,j),'cv30_routines 1996')
	2235	call iso_verif_traceur(xtelij(1,il,i,j),'cv30_routines 1997')
	2236	call iso_verif_trac17_q_deltaD(xtent(1,il,i,j), &
	2237	& 'cv30_routines 2042')
	2238	enddo !do il=1,ncum
	2239	#endif
	2240	endif !if (option_tmin.ge.1) then
	2241	#endif
	2242
	2243	! fractionation:
	2244	#ifdef ISOVERIF
	2245	! write(,) 'cv30_routines 2050: avant condiso'
	2246	do il=1,ncum
	2247	if ((i.ge.icb(il)).and.(i.le.inb(il)).and. &
	2248	& (j.ge.(icb(il)-1)).and.(j.le.inb(il))) then
	2249	if (sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95) then
	2250	if (iso_eau.gt.0) then
	2251	call iso_verif_egalite_choix(xtent(iso_eau,il,i,j), &
	2252	& qent(il,i,j),'cv30_routines 1889',errmax,errmaxrel)
	2253	call iso_verif_egalite_choix(xtelij(iso_eau,il,i,j), &
	2254	& elij(il,i,j),'cv30_routines 1890',errmax,errmaxrel)
	2255	endif
	2256	if (iso_HDO.gt.0) then
	2257	call iso_verif_aberrant_choix(xt(iso_HDO,il,i),rr(il,i), &
	2258	& ridicule,deltalim,'cv30_routines 1997')
	2259	call iso_verif_aberrant_choix( &
	2260	& xtent(iso_HDO,il,i,j),qent(il,i,j), &
	2261	& ridicule,deltalim,'cv30_routines 1931')
	2262	call iso_verif_aberrant_choix( &
	2263	& xtelij(iso_HDO,il,i,j),elij(il,i,j), &
	2264	& ridicule,deltalim,'cv30_routines 1993')
	2265	endif !if (iso_HDO.gt.0) then
	2266	#ifdef ISOTRAC
	2267	! write(,) 'cv30_routines tmp 2039 il=',il
	2268	call iso_verif_traceur(xtent(1,il,i,j), &
	2269	& 'cv30_routines 2031')
	2270	call iso_verif_traceur(xtelij(1,il,i,j), &
	2271	& 'cv30_routines 2033')
	2272	#endif
	2273
	2274	endif !if(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)then
	2275	endif !if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
	2276	enddo !do il=1,ncum
	2277	#endif
	2278	! write(,) 'cv30_routine tmp 1984: cond=',elij(il,i,j)
	2279
	2280
	2281	#endif
	2282
	2283	END DO
	2284
	2285	! do k=1,ntra
	2286	! do j=minorig,nl
	2287	! do il=1,ncum
	2288	! if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
	2289	! : (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
	2290	! traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
	2291	! : +(1.-sij(il,i,j))*tra(il,nk(il),k)
	2292	! endif
	2293	! enddo
	2294	! enddo
	2295	! enddo
	2296
	2297
	2298	! *** if no air can entrain at level i assume that updraft detrains
	2299	! ***
	2300	! *** at that level and calculate detrained air flux and properties
	2301	! ***
	2302
	2303
	2304	! @ do 170 i=icb(il),inb(il)
	2305
	2306	DO il = 1, ncum
	2307	IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
	2308	! @ if(nent(il,i).eq.0)then
	2309	ment(il, i, i) = m(il, i)
	2310	qent(il, i, i) = rr(il, nk(il)) - ep(il, i)*clw(il, i)
	2311	uent(il, i, i) = u(il, nk(il))
	2312	vent(il, i, i) = v(il, nk(il))
	2313	elij(il, i, i) = clw(il, i)
	2314	! MAF sij(il,i,i)=1.0
	2315	sij(il, i, i) = 0.0
	2316	#ifdef ISO
	2317	do ixt = 1, ntraciso
	2318	xtent(ixt,il,i,i)=xt(ixt,il,nk(il))-ep(il,i)*xtclw(ixt,il,i)
	2319	! xtent(ixt,il,i,i)=xt(ixt,il,nk(il))-xtep(ixt,il,i)*xtclw(ixt,il,i)
	2320	! le 7 mai: on supprime xtep
	2321	xtelij(ixt,il,i,i)=xtclw(ixt,il,i) ! rq: ne sera pas utilise ensuite
	2322	enddo !do ixt = 1, ntraciso
	2323
	2324	#ifdef ISOVERIF
	2325	if (iso_eau.gt.0) then
	2326	call iso_verif_egalite_choix(xtelij(iso_eau,il,i,i), &
	2327	& elij(il,i,i),'cv30_mixing 2117',errmax,errmaxrel)
	2328	endif !if (iso_eau.gt.0) then
	2329	#endif
	2330
	2331	#ifdef ISOTRAC
	2332	if (option_tmin.ge.1) then
	2333	! colorier la vapeur résiduelle selon température de
	2334	! condensation, et le condensat en un tag spécifique
	2335	! write(,) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
	2336	! : il,i,j,xtent(:,il,i,j)
	2337	if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) then
	2338	if (option_traceurs.eq.17) then
	2339	call iso_recolorise_condensation(qent(il,i,i), &
	2340	& elij(il,i,i), &
	2341	& xt(1,il,nk(il)),xtclw(1,il,i),tg_save(il,i),ep(il,i), &
	2342	& xtres, &
	2343	& seuil_tag_tmin)
	2344	else !if (option_traceurs.eq.17) then
	2345	call iso_recolorise_condensation(qent(il,i,i), &
	2346	& elij(il,i,i), &
	2347	& xt(1,il,nk(il)),xtclw(1,il,i),rs(il,i),ep(il,i), &
	2348	& xtres, &
	2349	& seuil_tag_tmin)
	2350	endif !if (option_traceurs.eq.17) then
	2351	do ixt=1+niso,ntraciso
	2352	xtent(ixt,il,i,i)=xtres(ixt)
	2353	enddo
	2354	#ifdef ISOVERIF
	2355	do ixt=1,niso
	2356	call iso_verif_egalite_choix(xtres(ixt),xtent(ixt,il,i,i), &
	2357	& 'cv30_routines 2102',errmax,errmaxrel)
	2358	call iso_verif_trac17_q_deltaD(xtent(1,il,i,j), &
	2359	& 'cv30_routines 2154')
	2360	enddo
	2361	#endif
	2362	endif !if (cond.gt.0.0) then
	2363
	2364	#ifdef ISOVERIF
	2365	call iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
	2366	& qent(il,i,i),'cv30_routines 2103',errmax,errmaxrel)
	2367	call iso_verif_traceur(xtent(1,il,i,i),'cv30_routines 2095')
	2368	call iso_verif_traceur(xtelij(1,il,i,i),'cv30_routines 2096')
	2369	#endif
	2370	endif !if (option_tmin.ge.1) then
	2371	#endif
	2372
	2373	#endif
	2374	END IF
	2375	END DO
	2376	END DO
	2377
	2378	! do j=1,ntra
	2379	! do i=minorig+1,nl
	2380	! do il=1,ncum
	2381	! if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
	2382	! traent(il,i,i,j)=tra(il,nk(il),j)
	2383	! endif
	2384	! enddo
	2385	! enddo
	2386	! enddo
	2387
	2388	DO j = minorig, nl
	2389	DO i = minorig, nl
	2390	DO il = 1, ncum
	2391	IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<= &
	2392	inb(il))) THEN
	2393	sigij(il, i, j) = sij(il, i, j)
	2394	END IF
	2395	END DO
	2396	END DO
	2397	END DO
	2398	! @ enddo
	2399
	2400	! @170 continue
	2401
	2402	! =====================================================================
	2403	! --- NORMALIZE ENTRAINED AIR MASS FLUXES
	2404	! --- TO REPRESENT EQUAL PROBABILITIES OF MIXING
	2405	! =====================================================================
	2406
	2407	! ym call zilch(asum,ncum*nd)
	2408	! ym call zilch(bsum,ncum*nd)
	2409	! ym call zilch(csum,ncum*nd)
	2410	CALL zilch(asum, nloc*nd)
	2411	CALL zilch(csum, nloc*nd)
	2412	CALL zilch(csum, nloc*nd)
	2413
	2414	DO il = 1, ncum
	2415	lwork(il) = .FALSE.
	2416	END DO
	2417
	2418	DO i = minorig + 1, nl
	2419
	2420	num1 = 0
	2421	DO il = 1, ncum
	2422	IF (i>=icb(il) .AND. i<=inb(il)) num1 = num1 + 1
	2423	END DO
	2424	IF (num1<=0) GO TO 789
	2425
	2426
	2427	DO il = 1, ncum
	2428	IF (i>=icb(il) .AND. i<=inb(il)) THEN
	2429	lwork(il) = (nent(il,i)/=0)
	2430	qp = rr(il, 1) - ep(il, i)*clw(il, i)
	2431	anum = h(il, i) - hp(il, i) - lv(il, i)*(qp-rs(il,i)) + &
	2432	(cpv-cpd)t(il, i)(qp-rr(il,i))
	2433	denom = h(il, i) - hp(il, i) + lv(il, i)*(rr(il,i)-qp) + &
	2434	(cpd-cpv)t(il, i)(rr(il,i)-qp)
	2435	IF (abs(denom)<0.01) denom = 0.01
	2436	scrit(il) = anum/denom
	2437	alt = qp - rs(il, i) + scrit(il)*(rr(il,i)-qp)
	2438	IF (scrit(il)<=0.0 .OR. alt<=0.0) scrit(il) = 1.0
	2439	smax(il) = 0.0
	2440	asij(il) = 0.0
	2441	END IF
	2442	END DO
	2443
	2444	DO j = nl, minorig, -1
	2445
	2446	num2 = 0
	2447	DO il = 1, ncum
	2448	IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
	2449	il)-1) .AND. j<=inb(il) .AND. lwork(il)) num2 = num2 + 1
	2450	END DO
	2451	IF (num2<=0) GO TO 175
	2452
	2453	DO il = 1, ncum
	2454	IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
	2455	il)-1) .AND. j<=inb(il) .AND. lwork(il)) THEN
	2456
	2457	IF (sij(il,i,j)>1.0E-16 .AND. sij(il,i,j)<0.95) THEN
	2458	wgh = 1.0
	2459	IF (j>i) THEN
	2460	sjmax = amax1(sij(il,i,j+1), smax(il))
	2461	sjmax = amin1(sjmax, scrit(il))
	2462	smax(il) = amax1(sij(il,i,j), smax(il))
	2463	sjmin = amax1(sij(il,i,j-1), smax(il))
	2464	sjmin = amin1(sjmin, scrit(il))
	2465	IF (sij(il,i,j)<(smax(il)-1.0E-16)) wgh = 0.0
	2466	smid = amin1(sij(il,i,j), scrit(il))
	2467	ELSE
	2468	sjmax = amax1(sij(il,i,j+1), scrit(il))
	2469	smid = amax1(sij(il,i,j), scrit(il))
	2470	sjmin = 0.0
	2471	IF (j>1) sjmin = sij(il, i, j-1)
	2472	sjmin = amax1(sjmin, scrit(il))
	2473	END IF
	2474	delp = abs(sjmax-smid)
	2475	delm = abs(sjmin-smid)
	2476	asij(il) = asij(il) + wgh*(delp+delm)
	2477	ment(il, i, j) = ment(il, i, j)(delp+delm)wgh
	2478	END IF
	2479	END IF
	2480	END DO
	2481
	2482	175 END DO
	2483
	2484	DO il = 1, ncum
	2485	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
	2486	asij(il) = amax1(1.0E-16, asij(il))
	2487	asij(il) = 1.0/asij(il)
	2488	asum(il, i) = 0.0
	2489	bsum(il, i) = 0.0
	2490	csum(il, i) = 0.0
	2491	END IF
	2492	END DO
	2493
	2494	DO j = minorig, nl
	2495	DO il = 1, ncum
	2496	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
	2497	il)-1) .AND. j<=inb(il)) THEN
	2498	ment(il, i, j) = ment(il, i, j)*asij(il)
	2499	END IF
	2500	END DO
	2501	END DO
	2502
	2503	DO j = minorig, nl
	2504	DO il = 1, ncum
	2505	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
	2506	il)-1) .AND. j<=inb(il)) THEN
	2507	asum(il, i) = asum(il, i) + ment(il, i, j)
	2508	ment(il, i, j) = ment(il, i, j)*sig(il, j)
	2509	bsum(il, i) = bsum(il, i) + ment(il, i, j)
	2510	END IF
	2511	END DO
	2512	END DO
	2513
	2514	DO il = 1, ncum
	2515	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
	2516	bsum(il, i) = amax1(bsum(il,i), 1.0E-16)
	2517	bsum(il, i) = 1.0/bsum(il, i)
	2518	END IF
	2519	END DO
	2520
	2521	DO j = minorig, nl
	2522	DO il = 1, ncum
	2523	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
	2524	il)-1) .AND. j<=inb(il)) THEN
	2525	ment(il, i, j) = ment(il, i, j)asum(il, i)bsum(il, i)
	2526	END IF
	2527	END DO
	2528	END DO
	2529
	2530	DO j = minorig, nl
	2531	DO il = 1, ncum
	2532	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
	2533	il)-1) .AND. j<=inb(il)) THEN
	2534	csum(il, i) = csum(il, i) + ment(il, i, j)
	2535	END IF
	2536	END DO
	2537	END DO
	2538
	2539	DO il = 1, ncum
	2540	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
	2541	csum(il,i)<m(il,i)) THEN
	2542	nent(il, i) = 0
	2543	ment(il, i, i) = m(il, i)
	2544	qent(il, i, i) = rr(il, 1) - ep(il, i)*clw(il, i)
	2545	uent(il, i, i) = u(il, nk(il))
	2546	vent(il, i, i) = v(il, nk(il))
	2547	elij(il, i, i) = clw(il, i)
	2548	! MAF sij(il,i,i)=1.0
	2549	sij(il, i, i) = 0.0
	2550	#ifdef ISO
	2551	do ixt = 1, ntraciso
	2552	! xtent(ixt,il,i,i)=xt(ixt,il,1)-xtep(ixt,il,i)*xtclw(ixt,il,i)
	2553	xtent(ixt,il,i,i)=xt(ixt,il,1)-ep(il,i)*xtclw(ixt,il,i)
	2554	xtelij(ixt,il,i,i)=xtclw(ixt,il,i) ! rq: ne sera pas utilise ensuite
	2555	enddo
	2556	#endif
	2557
	2558	#ifdef ISOVERIF
	2559	if (iso_eau.gt.0) then
	2560	call iso_verif_egalite_choix(xtelij(iso_eau,il,i,i), &
	2561	& elij(il,i,i),'cv30_mixing 2354',errmax,errmaxrel)
	2562	endif !if (iso_eau.gt.0) then
	2563	#endif
	2564
	2565	#ifdef ISOTRAC
	2566	if (option_tmin.ge.1) then
	2567	! colorier la vapeur résiduelle selon température de
	2568	! condensation, et le condensat en un tag spécifique
	2569	! write(,) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
	2570	! : il,i,j,xtent(:,il,i,j)
	2571	if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) then
	2572	if (option_traceurs.eq.17) then
	2573	call iso_recolorise_condensation(qent(il,i,i), &
	2574	& elij(il,i,i), &
	2575	& xt(1,il,1),xtclw(1,il,i),tg_save(il,i),ep(il,i), &
	2576	& xtres, &
	2577	& seuil_tag_tmin)
	2578	else !if (option_traceurs.eq.17) then
	2579	call iso_recolorise_condensation(qent(il,i,i), &
	2580	& elij(il,i,i), &
	2581	& xt(1,il,1),xtclw(1,il,i),rs(il,i),ep(il,i), &
	2582	& xtres, &
	2583	& seuil_tag_tmin)
	2584	endif ! if (option_traceurs.eq.17) then
	2585	do ixt=1+niso,ntraciso
	2586	xtent(ixt,il,i,i)=xtres(ixt)
	2587	enddo
	2588	#ifdef ISOVERIF
	2589	do ixt=1,niso
	2590	call iso_verif_egalite_choix(xtres(ixt),xtent(ixt,il,i,i), &
	2591	& 'cv30_routines 2318',errmax,errmaxrel)
	2592	call iso_verif_trac17_q_deltaD(xtent(1,il,i,j), &
	2593	& 'cv30_routines 2383')
	2594	enddo
	2595	#endif
	2596	endif !if (cond.gt.0.0) then
	2597	#ifdef ISOVERIF
	2598	call iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
	2599	& qent(il,i,i),'cv30_routines 2321',errmax,errmaxrel)
	2600	call iso_verif_traceur(xtent(1,il,i,i),'cv30_routines 2322')
	2601	call iso_verif_traceur(xtelij(1,il,i,i),'cv30_routines 2323')
	2602	#endif
	2603	endif !if (option_tmin.ge.1) then
	2604	#endif
	2605	END IF
	2606	END DO ! il
	2607
	2608	! do j=1,ntra
	2609	! do il=1,ncum
	2610	! if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
	2611	! : .and. csum(il,i).lt.m(il,i) ) then
	2612	! traent(il,i,i,j)=tra(il,nk(il),j)
	2613	! endif
	2614	! enddo
	2615	! enddo
	2616	789 END DO
	2617
	2618	! MAF: renormalisation de MENT
	2619	DO jm = 1, nd
	2620	DO im = 1, nd
	2621	DO il = 1, ncum
	2622	zm(il, im) = zm(il, im) + (1.-sij(il,im,jm))*ment(il, im, jm)
	2623	END DO
	2624	END DO
	2625	END DO
	2626
	2627	DO jm = 1, nd
	2628	DO im = 1, nd
	2629	DO il = 1, ncum
	2630	IF (zm(il,im)/=0.) THEN
	2631	ment(il, im, jm) = ment(il, im, jm)*m(il, im)/zm(il, im)
	2632	END IF
	2633	END DO
	2634	END DO
	2635	END DO
	2636
	2637	DO jm = 1, nd
	2638	DO im = 1, nd
	2639	DO il = 1, ncum
	2640	qents(il, im, jm) = qent(il, im, jm)
	2641	ments(il, im, jm) = ment(il, im, jm)
	2642	END DO
	2643	END DO
	2644	END DO
	2645
	2646	#ifdef ISO
	2647	!c--debug
	2648	#ifdef ISOVERIF
	2649	do im = 1, nd
	2650	do jm = 1, nd
	2651	do il = 1, ncum
	2652	if (iso_eau.gt.0) then
	2653	call iso_verif_egalite_choix(xtelij(iso_eau,il,im,jm), &
	2654	& elij(il,im,jm),'cv30_mixing 2110',errmax,errmaxrel)
	2655	call iso_verif_egalite_choix(xtent(iso_eau,il,im,jm), &
	2656	& qent(il,im,jm),'cv30_mixing 2112',errmax,errmaxrel)
	2657	endif !if (iso_eau.gt.0) then
	2658	#ifdef ISOTRAC
	2659	call iso_verif_traceur_justmass(xtelij(1,il,im,jm), &
	2660	& 'cv30_routine 2250')
	2661	#endif
	2662	enddo !do il = 1, nloc
	2663	enddo !do jm = 1, klev
	2664	enddo !do im = 1, klev
	2665	#endif
	2666	#endif
	2667
	2668	#ifdef ISO
	2669	#ifdef ISOTRAC
	2670	! seulement à la fin on taggue le condensat
	2671	if (option_cond.ge.1) then
	2672	do im = 1, nd
	2673	do jm = 1, nd
	2674	do il = 1, ncum
	2675	! colorier le condensat en un tag spécifique
	2676	do ixt=niso+1,ntraciso
	2677	if (index_zone(ixt).eq.izone_cond) then
	2678	xtelij(ixt,il,im,jm)=xtelij(index_iso(ixt),il,im,jm)
	2679	else !if (index_zone(ixt).eq.izone_cond) then
	2680	xtelij(ixt,il,im,jm)=0.0
	2681	endif !if (index_zone(ixt).eq.izone_cond) then
	2682	enddo !do ixt=1,ntraciso
	2683	#ifdef ISOVERIF
	2684	call iso_verif_egalite_choix(xtelij(iso_eau,il,im,jm), &
	2685	& elij(il,im,jm),'cv30_routines 2408',errmax,errmaxrel)
	2686	call iso_verif_traceur(xtelij(1,il,im,jm), &
	2687	& 'condiso_liq_ice_vectiso_trac 358')
	2688	#endif
	2689	enddo !do il = 1, ncum
	2690	enddo !do jm = 1, nd
	2691	enddo !do im = 1, nd
	2692	do im = 1, nd
	2693	do il = 1, ncum
	2694	! colorier le condensat en un tag spécifique
	2695	do ixt=niso+1,ntraciso
	2696	if (index_zone(ixt).eq.izone_cond) then
	2697	xtclw(ixt,il,im)=xtclw(index_iso(ixt),il,im)
	2698	else !if (index_zone(ixt).eq.izone_cond) then
	2699	xtclw(ixt,il,im)=0.0
	2700	endif !if (index_zone(ixt).eq.izone_cond) then
	2701	enddo !do ixt=1,ntraciso
	2702	#ifdef ISOVERIF
	2703	call iso_verif_egalite_choix(xtclw(iso_eau,il,im), &
	2704	& clw(il,im),'cv30_routines 2427',errmax,errmaxrel)
	2705	call iso_verif_traceur(xtclw(1,il,im), &
	2706	& 'condiso_liq_ice_vectiso_trac 358')
	2707	if (iso_verif_positif_nostop(xtclw(index_trac( &
	2708	& izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
	2709	& ,'cv30_routines 909').eq.1) then
	2710	write(,) 'i,k=',i,k
	2711	write(,) 'xtclw=',xtclw(:,i,k)
	2712	write(,) 'niso,ntraciso,index_zone,izone_cond=', &
	2713	& niso,ntraciso,index_zone,izone_cond
	2714	stop
	2715	endif !if (iso_verif_positif_nostop(xtclw(index_trac(
	2716	#endif
	2717	enddo !do il = 1, ncum
	2718	enddo !do im = 1, nd
	2719	! write(,) 'xtclw(:,1,2)=',xtclw(:,1,2)
	2720	endif !if (option_tmin.eq.1) then
	2721	#endif
	2722	#endif
	2723
	2724	RETURN
	2725	END SUBROUTINE cv30_mixing
	2726
	2727
	2728	SUBROUTINE cv30_unsat(nloc, ncum, nd, na, ntra, icb, inb, t, rr, rs, gz, u, &
	2729	v, tra, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, ment, elij, delt, plcl, &
	2730	mp, rp, up, vp, trap, wt, water, evap, b & ! RomP-jyg
	2731	, wdtraina, wdtrainm & ! 26/08/10 RomP-jyg
	2732	#ifdef ISO
	2733	& ,xt,xtclw,xtelij &
	2734	& ,xtp,xtwater,xtevap &
	2735	#ifdef DIAGISO
	2736	& ,wdtrain_diag,xtwdtrain_diag,taux_cond_conv &
	2737	#endif
	2738	#endif
	2739	& )
	2740	#ifdef ISO
	2741	use infotrac_phy, ONLY: ntraciso
	2742	use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule
	2743	use isotopes_routines_mod, ONLY: appel_stewart_vectall
	2744	#ifdef ISOVERIF
	2745	use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
	2746	iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
	2747	iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
	2748	iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
	2749	iso_verif_positif,iso_verif_egalite_vect2D
	2750	#endif
	2751	#ifdef ISOTRAC
	2752	use isotrac_mod, only: option_cond,izone_cond
	2753	use infotrac_phy, ONLY: index_trac
	2754	#ifdef ISOVERIF
	2755	use isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
	2756	& iso_verif_traceur
	2757	use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
	2758	#endif
	2759	#endif
	2760	#endif
	2761
	2762	IMPLICIT NONE
	2763
	2764
	2765	include "cvthermo.h"
	2766	include "cv30param.h"
	2767	include "cvflag.h"
	2768
	2769	! inputs:
	2770	INTEGER ncum, nd, na, ntra, nloc
	2771	INTEGER icb(nloc), inb(nloc)
	2772	REAL delt, plcl(nloc)
	2773	REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd)
	2774	REAL u(nloc, nd), v(nloc, nd)
	2775	REAL tra(nloc, nd, ntra)
	2776	REAL p(nloc, nd), ph(nloc, nd+1)
	2777	REAL th(nloc, na), gz(nloc, na)
	2778	REAL lv(nloc, na), ep(nloc, na), sigp(nloc, na), clw(nloc, na)
	2779	REAL cpn(nloc, na), tv(nloc, na)
	2780	REAL m(nloc, na), ment(nloc, na, na), elij(nloc, na, na)
	2781	#ifdef ISO
	2782	real xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,na)
	2783	real xtelij(ntraciso,nloc,na,na)
	2784	! real xtep(ntraciso,nloc,na) ! le 7 mai: on supprime xtep
	2785	#endif
	2786
	2787	! outputs:
	2788	REAL mp(nloc, na), rp(nloc, na), up(nloc, na), vp(nloc, na)
	2789	REAL water(nloc, na), evap(nloc, na), wt(nloc, na)
	2790	REAL trap(nloc, na, ntra)
	2791	REAL b(nloc, na)
	2792	! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
	2793	! lascendance adiabatique et des flux melanges Pa et Pm.
	2794	! Distinction des wdtrain
	2795	! Pa = wdtrainA Pm = wdtrainM
	2796	REAL wdtraina(nloc, na), wdtrainm(nloc, na)
	2797
	2798	#ifdef ISO
	2799	real xtp(ntraciso,nloc,na)
	2800	real xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)
	2801	#endif
	2802
	2803	! local variables
	2804	INTEGER i, j, k, il, num1
	2805	REAL tinv, delti
	2806	REAL awat, afac, afac1, afac2, bfac
	2807	REAL pr1, pr2, sigt, b6, c6, revap, tevap, delth
	2808	REAL amfac, amp2, xf, tf, fac2, ur, sru, fac, d, af, bf
	2809	REAL ampmax
	2810	REAL lvcp(nloc, na)
	2811	REAL wdtrain(nloc)
	2812	LOGICAL lwork(nloc)
	2813
	2814	#ifdef ISO
	2815	integer ixt
	2816	real xtwdtrain(ntraciso,nloc), xtawat(ntraciso)
	2817	! logical negation
	2818	real rpprec(nloc,na)
	2819	!#ifdef ISOVERIF
	2820	! integer iso_verif_aberrant_nostop
	2821	!#ifdef ISOTRAC
	2822	! integer iso_verif_traceur_choix_nostop
	2823	! integer iso_verif_positif_nostop
	2824	!#endif
	2825	!#endif
	2826	#ifdef DIAGISO
	2827	real wdtrain_diag(nloc,na)
	2828	real xtwdtrain_diag(niso,nloc,na)
	2829	real taux_cond_conv(nloc,na)
	2830	#endif
	2831	#endif
	2832
	2833
	2834	! ------------------------------------------------------
	2835	#ifdef ISO
	2836	!#ifdef ISOVERIF
	2837	! write(,) 'cv30_routines 2382: entrée dans cv3_unsat'
	2838	!#endif
	2839	! initialisations des variables non iso
	2840	if (essai_convergence) then
	2841	else
	2842	do i=1,nd
	2843	do il=1,nloc
	2844	rp(il,i)=0.0
	2845	water(il,i)=0.0 !mise en commentaire le 5 avril pour test
	2846	evap(il,i)=0.0
	2847	enddo !do i=1,nd
	2848	enddo !do il=1,nloc
	2849	endif !if (negation(essai_convergence)) then
	2850	! initialisations des variables isos
	2851	do i=1,nd
	2852	do il=1,nloc
	2853	do ixt=1,ntraciso
	2854	xtp(ixt,il,i)=0.0
	2855	xtwater(ixt,il,i)=0.0
	2856	xtevap(ixt,il,i)=0.0
	2857	enddo !do ixt=1,niso
	2858	enddo !do il=1,nloc
	2859	enddo !do i=1,nd
	2860	#endif
	2861
	2862	delti = 1./delt
	2863	tinv = 1./3.
	2864
	2865	mp(:, :) = 0.
	2866
	2867	DO i = 1, nl
	2868	DO il = 1, ncum
	2869	mp(il, i) = 0.0
	2870	rp(il, i) = rr(il, i)
	2871	up(il, i) = u(il, i)
	2872	vp(il, i) = v(il, i)
	2873	wt(il, i) = 0.001
	2874	water(il, i) = 0.0
	2875	evap(il, i) = 0.0
	2876	b(il, i) = 0.0
	2877	lvcp(il, i) = lv(il, i)/cpn(il, i)
	2878
	2879	#ifdef ISO
	2880	rpprec(il,i)=rp(il,i)
	2881	do ixt=1,ntraciso
	2882	xtp(ixt,il,i)=xt(ixt,il,i)
	2883	xtwater(ixt,il,i)=0.0
	2884	xtevap(ixt,il,i)=0.0
	2885	enddo
	2886	!-- debug
	2887	#ifdef ISOVERIF
	2888	if(iso_eau.gt.0) then
	2889	call iso_verif_egalite_choix(xt(iso_eau,il,i),rr(il,i), &
	2890	& 'cv30_unsat 2245 ',errmax,errmaxrel)
	2891	call iso_verif_egalite_choix(xtp(iso_eau,il,i),rp(il,i), &
	2892	& 'cv30_unsat 2247 ',errmax,errmaxrel)
	2893	endif !if(iso_eau.gt.0) then
	2894	#ifdef ISOTRAC
	2895	call iso_verif_traceur(xt(1,il,i),'cv30_routine 2410')
	2896	call iso_verif_traceur(xtp(1,il,i),'cv30_routine 2411')
	2897	#endif
	2898	#endif
	2899	#endif
	2900
	2901	END DO
	2902	END DO
	2903
	2904	! do k=1,ntra
	2905	! do i=1,nd
	2906	! do il=1,ncum
	2907	! trap(il,i,k)=tra(il,i,k)
	2908	! enddo
	2909	! enddo
	2910	! enddo
	2911	! ! RomP >>>
	2912	DO i = 1, nd
	2913	DO il = 1, ncum
	2914	wdtraina(il, i) = 0.0
	2915	wdtrainm(il, i) = 0.0
	2916	END DO
	2917	END DO
	2918	! ! RomP <<<
	2919
	2920	! * check whether ep(inb)=0, if so, skip precipitating *
	2921	! * downdraft calculation *
	2922
	2923
	2924	DO il = 1, ncum
	2925	lwork(il) = .TRUE.
	2926	IF (ep(il,inb(il))<0.0001) lwork(il) = .FALSE.
	2927	END DO
	2928
	2929	CALL zilch(wdtrain, ncum)
	2930	#ifdef ISO
	2931	call zilch(xtwdtrain,ncum*ntraciso)
	2932	#ifdef DIAGISO
	2933	call zilch(wdtrain_diag,ncum)
	2934	call zilch(taux_cond_conv,ncum)
	2935	call zilch(xtwdtrain_diag,ncum*ntraciso)
	2936	#endif
	2937	#endif
	2938
	2939	DO i = nl + 1, 1, -1
	2940
	2941	num1 = 0
	2942	DO il = 1, ncum
	2943	IF (i<=inb(il) .AND. lwork(il)) num1 = num1 + 1
	2944	END DO
	2945	IF (num1<=0) GO TO 400
	2946
	2947
	2948	! * integrate liquid water equation to find condensed water *
	2949	! * and condensed water flux *
	2950
	2951
	2952
	2953	! * begin downdraft loop *
	2954
	2955
	2956
	2957	! * calculate detrained precipitation *
	2958
	2959	DO il = 1, ncum
	2960	IF (i<=inb(il) .AND. lwork(il)) THEN
	2961	IF (cvflag_grav) THEN
	2962	wdtrain(il) = gravep(il, i)m(il, i)*clw(il, i)
	2963	wdtraina(il, i) = wdtrain(il)/grav ! Pa 26/08/10 RomP
	2964	#ifdef ISO
	2965	do ixt=1,ntraciso
	2966	! xtwdtrain(ixt,il)=gravxtep(ixt,il,i)m(il,i)*xtclw(ixt,il,i)
	2967	xtwdtrain(ixt,il)=gravep(il,i)m(il,i)*xtclw(ixt,il,i)
	2968	enddo
	2969	!--debug:
	2970	#ifdef ISOVERIF
	2971	if (iso_eau.gt.0) then
	2972	call iso_verif_egalite_choix(xtwdtrain(iso_eau,il), &
	2973	& wdtrain(il),'cv30_routines 2313',errmax,errmaxrel)
	2974	endif !if (iso_eau.gt.0) then
	2975	#ifdef ISOTRAC
	2976	call iso_verif_traceur(xtwdtrain(1,il),'cv30_routine 2480')
	2977	#endif
	2978	#endif
	2979	!--end debug
	2980	#ifdef DIAGISO
	2981	taux_cond_conv(il,i)=gravm(il,i)clw(il,i)
	2982	#endif
	2983	#endif
	2984
	2985	ELSE
	2986	wdtrain(il) = 10.0ep(il, i)m(il, i)*clw(il, i)
	2987	wdtraina(il, i) = wdtrain(il)/10. ! Pa 26/08/10 RomP
	2988	#ifdef ISO
	2989	do ixt=1,ntraciso
	2990	! xtwdtrain(ixt,il)=10.0xtep(ixt,il,i)m(il,i)*xtclw(ixt,il,i)
	2991	xtwdtrain(ixt,il)=10.0ep(il,i)m(il,i)*xtclw(ixt,il,i)
	2992	enddo
	2993	#endif
	2994	#ifdef DIAGISO
	2995	taux_cond_conv(il,i)=10.0m(il,i)clw(il,i)
	2996	#endif
	2997	END IF
	2998	END IF
	2999	END DO
	3000
	3001	IF (i>1) THEN
	3002
	3003	DO j = 1, i - 1
	3004	DO il = 1, ncum
	3005	IF (i<=inb(il) .AND. lwork(il)) THEN
	3006	awat = elij(il, j, i) - (1.-ep(il,i))*clw(il, i)
	3007	awat = amax1(awat, 0.0)
	3008	#ifdef ISO
	3009	! precip mixed drafts computed from: xtawat/xtelij = awat/elij
	3010	if (elij(il,j,i).ne.0.0) then
	3011	do ixt=1,ntraciso
	3012	xtawat(ixt)=xtelij(ixt,il,j,i)*(awat/elij(il,j,i))
	3013	xtawat(ixt)=amax1(xtawat(ixt),0.0)
	3014	enddo
	3015	!! xtawat(ixt)=amin1(xtawat(ixt),xtelij(ixt,il,j,i)) !security..
	3016	else
	3017	do ixt=1,ntraciso
	3018	xtawat(ixt)=0.0
	3019	enddo !do ixt=1,niso
	3020	endif
	3021
	3022	#ifdef ISOVERIF
	3023	if (iso_eau.gt.0) then
	3024	call iso_verif_egalite_choix(xtawat(iso_eau), &
	3025	& awat,'cv30_routines 2391',errmax,errmaxrel)
	3026	endif !if (iso_eau.gt.0) then
	3027	#ifdef ISOTRAC
	3028	call iso_verif_traceur(xtawat(1),'cv30_routine 2522')
	3029	#endif
	3030	#endif
	3031	#endif
	3032	IF (cvflag_grav) THEN
	3033	wdtrain(il) = wdtrain(il) + gravawatment(il, j, i)
	3034	#ifdef ISO
	3035	do ixt=1,ntraciso
	3036	xtwdtrain(ixt,il)=xtwdtrain(ixt,il) &
	3037	& +gravxtawat(ixt)ment(il,j,i)
	3038	enddo !do ixt=1,ntraciso
	3039	#endif
	3040	ELSE
	3041	wdtrain(il) = wdtrain(il) + 10.0awatment(il, j, i)
	3042	#ifdef ISO
	3043	do ixt=1,ntraciso
	3044	xtwdtrain(ixt,il)=xtwdtrain(ixt,il) &
	3045	& +10.0xtawat(ixt)ment(il,j,i)
	3046	enddo !!do ixt=1,ntraciso
	3047	#endif
	3048	END IF !if (cvflag_grav) then
	3049	#ifdef ISO
	3050	#ifdef DIAGISO
	3051	taux_cond_conv(il,i)=taux_cond_conv(il,i) &
	3052	& +10.0elij(il,j,i)ment(il,j,i)
	3053	#endif
	3054	!--debug:
	3055	#ifdef ISOVERIF
	3056	if (iso_eau.gt.0) then
	3057	call iso_verif_egalite_choix(xtwdtrain(iso_eau,il), &
	3058	& wdtrain(il),'cv30_routines 2366',errmax,errmaxrel)
	3059	endif !if (iso_eau.gt.0) then
	3060	#ifdef ISOTRAC
	3061	call iso_verif_traceur(xtwdtrain(1,il),'cv30_routine 2540')
	3062	if (option_cond.ge.1) then
	3063	! on vérifie que tout le détrainement est taggé condensat
	3064	if (iso_verif_positif_nostop( &
	3065	& xtwdtrain(index_trac(izone_cond,iso_eau),il) &
	3066	& -xtwdtrain(iso_eau,il), &
	3067	& 'cv30_routines 2795').eq.1) then
	3068	write(,) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
	3069	write(,) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i)
	3070	write(,) 'xtclw(:,il,i)=',xtclw(:,il,i)
	3071	stop
	3072	endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
	3073	endif !if (option_cond.ge.1) then
	3074	#endif
	3075	#endif
	3076	#endif
	3077
	3078	END IF
	3079	END DO
	3080	END DO
	3081	DO il = 1, ncum
	3082	IF (cvflag_grav) THEN
	3083	wdtrainm(il, i) = wdtrain(il)/grav - wdtraina(il, i) ! Pm 26/08/10 RomP
	3084	ELSE
	3085	wdtrainm(il, i) = wdtrain(il)/10. - wdtraina(il, i) ! Pm 26/08/10 RomP
	3086	END IF
	3087	END DO
	3088
	3089	END IF
	3090
	3091	#ifdef DIAGISO
	3092	do il=1,ncum
	3093	wdtrain_diag(il,i)=wdtrain(il)
	3094	do ixt=1,niso
	3095	xtwdtrain_diag(ixt,il,i)=xtwdtrain(ixt,il)
	3096	enddo
	3097	enddo !do il=1,ncum
	3098	#endif
	3099
	3100	! * find rain water and evaporation using provisional *
	3101	! * estimates of rp(i)and rp(i-1) *
	3102
	3103
	3104	DO il = 1, ncum
	3105
	3106	IF (i<=inb(il) .AND. lwork(il)) THEN
	3107
	3108	wt(il, i) = 45.0
	3109
	3110	IF (i<inb(il)) THEN
	3111	rp(il, i) = rp(il, i+1) + (cpd*(t(il,i+1)-t(il, &
	3112	i))+gz(il,i+1)-gz(il,i))/lv(il, i)
	3113	rp(il, i) = 0.5*(rp(il,i)+rr(il,i))
	3114	END IF
	3115	rp(il, i) = amax1(rp(il,i), 0.0)
	3116	rp(il, i) = amin1(rp(il,i), rs(il,i))
	3117	rp(il, inb(il)) = rr(il, inb(il))
	3118
	3119	IF (i==1) THEN
	3120	afac = p(il, 1)(rs(il,1)-rp(il,1))/(1.0E4+2000.0p(il,1)*rs(il,1))
	3121	ELSE
	3122	rp(il, i-1) = rp(il, i) + (cpd*(t(il,i)-t(il, &
	3123	i-1))+gz(il,i)-gz(il,i-1))/lv(il, i)
	3124	rp(il, i-1) = 0.5*(rp(il,i-1)+rr(il,i-1))
	3125	rp(il, i-1) = amin1(rp(il,i-1), rs(il,i-1))
	3126	rp(il, i-1) = amax1(rp(il,i-1), 0.0)
	3127	afac1 = p(il, i)(rs(il,i)-rp(il,i))/(1.0E4+2000.0p(il,i)*rs(il,i) &
	3128	)
	3129	afac2 = p(il, i-1)*(rs(il,i-1)-rp(il,i-1))/ &
	3130	(1.0E4+2000.0p(il,i-1)rs(il,i-1))
	3131	afac = 0.5*(afac1+afac2)
	3132	END IF
	3133	IF (i==inb(il)) afac = 0.0
	3134	afac = amax1(afac, 0.0)
	3135	bfac = 1./(sigd*wt(il,i))
	3136
	3137	! jyg1
	3138	! cc sigt=1.0
	3139	! cc if(i.ge.icb)sigt=sigp(i)
	3140	! prise en compte de la variation progressive de sigt dans
	3141	! les couches icb et icb-1:
	3142	! pour plcl<ph(i+1), pr1=0 & pr2=1
	3143	! pour plcl>ph(i), pr1=1 & pr2=0
	3144	! pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
	3145	! sur le nuage, et pr2 est la proportion sous la base du
	3146	! nuage.
	3147	pr1 = (plcl(il)-ph(il,i+1))/(ph(il,i)-ph(il,i+1))
	3148	pr1 = max(0., min(1.,pr1))
	3149	pr2 = (ph(il,i)-plcl(il))/(ph(il,i)-ph(il,i+1))
	3150	pr2 = max(0., min(1.,pr2))
	3151	sigt = sigp(il, i)*pr1 + pr2
	3152	! jyg2
	3153
	3154	b6 = bfac50.sigd(ph(il,i)-ph(il,i+1))sigt*afac
	3155	c6 = water(il, i+1) + bfacwdtrain(il) - 50.sigdbfac(ph(il,i)-ph( &
	3156	il,i+1))*evap(il, i+1)
	3157	IF (c6>0.0) THEN
	3158	revap = 0.5(-b6+sqrt(b6b6+4.*c6))
	3159	evap(il, i) = sigtafacrevap
	3160	water(il, i) = revap*revap
	3161	ELSE
	3162	evap(il, i) = -evap(il, i+1) + 0.02(wdtrain(il)+sigdwt(il,i)* &
	3163	water(il,i+1))/(sigd*(ph(il,i)-ph(il,i+1)))
	3164	END IF
	3165
	3166	#ifdef ISO
	3167	! ajout cam: éviter les evaporations ou eaux négatives
	3168	! water(il,i)=max(0.0,water(il,i)) ! ceci est toujours vérifié
	3169	#ifdef ISOVERIF
	3170	call iso_verif_positif(water(il,i),'cv30_unsat 2376')
	3171	#endif
	3172	! evap(il,i)=max(0.0,evap(il,i)) ! evap<0 permet la conservation de
	3173	! l'eau
	3174	! fin ajout cam
	3175	#endif
	3176
	3177
	3178	! * calculate precipitating downdraft mass flux under *
	3179	! * hydrostatic approximation *
	3180
	3181	IF (i/=1) THEN
	3182
	3183	tevap = amax1(0.0, evap(il,i))
	3184	delth = amax1(0.001, (th(il,i)-th(il,i-1)))
	3185	IF (cvflag_grav) THEN
	3186	mp(il, i) = 100.ginvlvcp(il, i)sigdtevap*(p(il,i-1)-p(il,i))/ &
	3187	delth
	3188	ELSE
	3189	mp(il, i) = 10.lvcp(il, i)sigdtevap(p(il,i-1)-p(il,i))/delth
	3190	END IF
	3191
	3192	! * if hydrostatic assumption fails, *
	3193	! * solve cubic difference equation for downdraft theta *
	3194	! * and mass flux from two simultaneous differential eqns *
	3195
	3196	amfac = sigdsigd70.0ph(il, i)(p(il,i-1)-p(il,i))* &
	3197	(th(il,i)-th(il,i-1))/(tv(il,i)*th(il,i))
	3198	amp2 = abs(mp(il,i+1)mp(il,i+1)-mp(il,i)mp(il,i))
	3199	IF (amp2>(0.1*amfac)) THEN
	3200	xf = 100.0sigdsigdsigd(ph(il,i)-ph(il,i+1))
	3201	tf = b(il, i) - 5.0(th(il,i)-th(il,i-1))t(il, i)/(lvcp(il,i)* &
	3202	sigd*th(il,i))
	3203	af = xftf + mp(il, i+1)mp(il, i+1)*tinv
	3204	bf = 2.(tinvmp(il,i+1))*3 + tinvmp(il, i+1)xftf + &
	3205	50.(p(il,i-1)-p(il,i))xf*tevap
	3206	fac2 = 1.0
	3207	IF (bf<0.0) fac2 = -1.0
	3208	bf = abs(bf)
	3209	ur = 0.25bfbf - afafaftinvtinv*tinv
	3210	IF (ur>=0.0) THEN
	3211	sru = sqrt(ur)
	3212	fac = 1.0
	3213	IF ((0.5*bf-sru)<0.0) fac = -1.0
	3214	mp(il, i) = mp(il, i+1)tinv + (0.5bf+sru)**tinv + &
	3215	fac(abs(0.5bf-sru))**tinv
	3216	ELSE
	3217	d = atan(2.*sqrt(-ur)/(bf+1.0E-28))
	3218	IF (fac2<0.0) d = 3.14159 - d
	3219	mp(il, i) = mp(il, i+1)tinv + 2.sqrt(aftinv)cos(d*tinv)
	3220	END IF
	3221	mp(il, i) = amax1(0.0, mp(il,i))
	3222
	3223	IF (cvflag_grav) THEN
	3224	! jyg : il y a vraisemblablement une erreur dans la ligne 2
	3225	! suivante:
	3226	! il faut diviser par (mp(il,i)sigdgrav) et non par
	3227	! (mp(il,i)+sigd*0.1).
	3228	! Et il faut bien revoir les facteurs 100.
	3229	b(il, i-1) = b(il, i) + 100.0(p(il,i-1)-p(il,i))tevap/(mp(il, &
	3230	i)+sigd0.1) - 10.0(th(il,i)-th(il,i-1))*t(il, i)/(lvcp(il,i &
	3231	)sigdth(il,i))
	3232	ELSE
	3233	b(il, i-1) = b(il, i) + 100.0(p(il,i-1)-p(il,i))tevap/(mp(il, &
	3234	i)+sigd0.1) - 10.0(th(il,i)-th(il,i-1))*t(il, i)/(lvcp(il,i &
	3235	)sigdth(il,i))
	3236	END IF
	3237	b(il, i-1) = amax1(b(il,i-1), 0.0)
	3238	END IF
	3239
	3240	! *** limit magnitude of mp(i) to meet cfl condition
	3241	! ***
	3242
	3243	ampmax = 2.0(ph(il,i)-ph(il,i+1))delti
	3244	amp2 = 2.0(ph(il,i-1)-ph(il,i))delti
	3245	ampmax = amin1(ampmax, amp2)
	3246	mp(il, i) = amin1(mp(il,i), ampmax)
	3247
	3248	! *** force mp to decrease linearly to zero
	3249	! ***
	3250	! *** between cloud base and the surface
	3251	! ***
	3252
	3253	IF (p(il,i)>p(il,icb(il))) THEN
	3254	mp(il, i) = mp(il, icb(il))*(p(il,1)-p(il,i))/ &
	3255	(p(il,1)-p(il,icb(il)))
	3256	END IF
	3257
	3258	END IF ! i.eq.1
	3259
	3260	! * find mixing ratio of precipitating downdraft *
	3261
	3262
	3263	IF (i/=inb(il)) THEN
	3264
	3265	rp(il, i) = rr(il, i)
	3266
	3267	IF (mp(il,i)>mp(il,i+1)) THEN
	3268
	3269	IF (cvflag_grav) THEN
	3270	rp(il, i) = rp(il, i+1)*mp(il, i+1) + &
	3271	rr(il, i)(mp(il,i)-mp(il,i+1)) + 100.ginv0.5sigd*(ph(il,i &
	3272	)-ph(il,i+1))*(evap(il,i+1)+evap(il,i))
	3273	ELSE
	3274	rp(il, i) = rp(il, i+1)*mp(il, i+1) + &
	3275	rr(il, i)(mp(il,i)-mp(il,i+1)) + 5.sigd*(ph(il,i)-ph(il,i+1 &
	3276	))*(evap(il,i+1)+evap(il,i))
	3277	END IF
	3278	rp(il, i) = rp(il, i)/mp(il, i)
	3279	up(il, i) = up(il, i+1)mp(il, i+1) + u(il, i)(mp(il,i)-mp(il,i+ &
	3280	1))
	3281	up(il, i) = up(il, i)/mp(il, i)
	3282	vp(il, i) = vp(il, i+1)mp(il, i+1) + v(il, i)(mp(il,i)-mp(il,i+ &
	3283	1))
	3284	vp(il, i) = vp(il, i)/mp(il, i)
	3285
	3286	! do j=1,ntra
	3287	! trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
	3288	! testmaf : +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
	3289	! : +tra(il,i,j)*(mp(il,i)-mp(il,i+1))
	3290	! trap(il,i,j)=trap(il,i,j)/mp(il,i)
	3291	! end do
	3292
	3293	ELSE
	3294
	3295	IF (mp(il,i+1)>1.0E-16) THEN
	3296	IF (cvflag_grav) THEN
	3297	rp(il, i) = rp(il, i+1) + 100.ginv0.5sigd(ph(il,i)-ph(il, &
	3298	i+1))*(evap(il,i+1)+evap(il,i))/mp(il, i+1)
	3299	ELSE
	3300	rp(il, i) = rp(il, i+1) + 5.sigd(ph(il,i)-ph(il,i+1))*(evap &
	3301	(il,i+1)+evap(il,i))/mp(il, i+1)
	3302	END IF
	3303	up(il, i) = up(il, i+1)
	3304	vp(il, i) = vp(il, i+1)
	3305
	3306	! do j=1,ntra
	3307	! trap(il,i,j)=trap(il,i+1,j)
	3308	! end do
	3309
	3310	END IF
	3311	END IF
	3312	#ifdef ISO
	3313	rpprec(il,i)=max(rp(il,i),0.0)
	3314	#endif
	3315	rp(il, i) = amin1(rp(il,i), rs(il,i))
	3316	rp(il, i) = amax1(rp(il,i), 0.0)
	3317
	3318	END IF
	3319	END IF
	3320	END DO
	3321
	3322	#ifdef ISO
	3323	#ifdef ISOVERIF
	3324	! verif des inputs à appel stewart
	3325	! write(,) 'cv30_routines 2842 tmp: appel de appel_stewart'
	3326	do il=1,ncum
	3327	if (i.le.inb(il) .and. lwork(il)) then
	3328	if (iso_eau.gt.0) then
	3329	call iso_verif_egalite_choix(xt(iso_eau,il,i), &
	3330	& rr(il,i),'appel_stewart 262, cas 1.1',errmax,errmaxrel)
	3331	endif !if (iso_eau.gt.0) then
	3332	!#ifdef ISOTRAC
	3333	! if (option_tmin.ge.1) then
	3334	! call iso_verif_positif(xtwater(
	3335	! : index_trac(izone_cond,iso_eau),il,i+1)
	3336	! : -xtwater(iso_eau,il,i+1),
	3337	! : 'cv30_routines 3083')
	3338	! endif !if (option_tmin.ge.1) then
	3339	!#endif
	3340	endif
	3341	enddo
	3342	#endif
	3343	! appel de appel_stewart_vectorisé
	3344	call appel_stewart_vectall(lwork,ncum, &
	3345	& ph,t,evap,xtwdtrain, &
	3346	& wdtrain, &
	3347	& water,rr,xt,rs,rpprec,mp,wt, & ! inputs physiques
	3348	& xtwater,xtp, & ! outputs indispensables
	3349	& xtevap, & ! diagnostiques
	3350	& sigd, & ! inputs tunables
	3351	& i,inb, & ! altitude: car cas particulier en INB
	3352	& na,nd,nloc,cvflag_grav,ginv,1e-16)
	3353
	3354	#ifdef ISOVERIF
	3355	! write(,) 'cv30_routines 2864 tmp: sortie de appel_stewart'
	3356	! verif des outputs de appel stewart
	3357	do il=1,ncum
	3358	if (i.le.inb(il) .and. lwork(il)) then
	3359	do ixt=1,ntraciso
	3360	call iso_verif_noNAN(xtp(ixt,il,i),'cv30_unsat 3382')
	3361	call iso_verif_noNAN(xtwater(ixt,il,i),'cv30_unsat 3381')
	3362	call iso_verif_noNAN(xtevap(ixt,il,i),'cv30_unsat 2661')
	3363	enddo
	3364	if (iso_eau.gt.0) then
	3365	call iso_verif_egalite_choix(xtp(iso_eau,il,i), &
	3366	& rpprec(il,i),'cv30_unsat 2736',errmax,errmaxrel)
	3367	call iso_verif_egalite_choix(xtwater(iso_eau,il,i), &
	3368	& water(il,i),'cv30_unsat 2747',errmax,errmaxrel)
	3369	! write(,) 'xtwater(4,il,i)=',xtwater(4,il,i)
	3370	! write(,) 'water(il,i)=',water(il,i)
	3371	call iso_verif_egalite_choix(xtevap(iso_eau,il,i), &
	3372	& evap(il,i),'cv30_unsat 2751',errmax,errmaxrel)
	3373	endif !if (iso_eau.gt.0) then
	3374	if ((iso_HDO.gt.0).and. &
	3375	& (rp(il,i).gt.ridicule)) then
	3376	call iso_verif_aberrant(xtp(iso_HDO,il,i)/rpprec(il,i), &
	3377	& 'cv3unsat 2756')
	3378	endif !if ((iso_HDO.gt.0).and.
	3379	#ifdef ISOTRAC
	3380	! if (il.eq.602) then
	3381	! write(,) 'cv30_routine tmp: il,i=',il,i
	3382	! write(,) 'xtp(iso_eau:ntraciso:3,il,i)=',
	3383	! : xtp(iso_eau:ntraciso:3,il,i)
	3384	! endif
	3385	call iso_verif_traceur(xtp(1,il,i),'cv30_routine 2852')
	3386	call iso_verif_traceur(xtwater(1,il,1), &
	3387	& 'cv30_routine 2853 unsat apres appel')
	3388	call iso_verif_traceur_pbidouille(xtwater(1,il,i), &
	3389	& 'cv30_routine 2853b')
	3390	call iso_verif_traceur_justmass(xtevap(1,il,i), &
	3391	& 'cv30_routine 2854')
	3392	! if (option_tmin.ge.1) then
	3393	! call iso_verif_positif(xtwater(
	3394	! : index_trac(izone_cond,iso_eau),il,i)
	3395	! : -xtwater(iso_eau,il,i),
	3396	! : 'cv30_routines 3143')
	3397	! endif !if (option_tmin.ge.1) then
	3398	#endif
	3399	endif !if (i.le.inb(il) .and. lwork(il)) then
	3400	enddo !do il=1,ncum
	3401	#endif
	3402
	3403	! équivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
	3404	do il=1,ncum
	3405	if (i.lt.inb(il) .and. lwork(il)) then
	3406
	3407	if (rpprec(il,i).gt.rs(il,i)) then
	3408	if (rs(il,i).le.0) then
	3409	write(,) 'cv3unsat 2640'
	3410	stop
	3411	endif
	3412	do ixt=1,ntraciso
	3413	xtp(ixt,il,i)=xtp(ixt,il,i)/rpprec(il,i)*rs(il,i)
	3414	xtp(ixt,il,i)=max(0.0,xtp(ixt,il,i))
	3415	enddo !do ixt=1,niso
	3416	#ifdef ISOVERIF
	3417	do ixt=1,ntraciso
	3418	call iso_verif_noNaN(xtp(ixt,il,i),'cv3unsat 2641')
	3419	enddo !do ixt=1,niso
	3420	if (iso_eau.gt.0) then
	3421	! write(,) 'xtp(iso_eau,il,i)=',xtp(iso_eau,il,i)
	3422	call iso_verif_egalite_choix(xtp(iso_eau,il,i),rp(il,i), &
	3423	& 'cv3unsat 2653',errmax,errmaxrel)
	3424	call iso_verif_egalite_choix(xtp(iso_eau,il,i), &
	3425	& rs(il,i),'cv3unsat 2654',errmax,errmaxrel)
	3426	endif
	3427	if ((iso_HDO.gt.0).and. &
	3428	& (rp(il,i).gt.ridicule)) then
	3429	if (iso_verif_aberrant_nostop(xtp(iso_HDO,il,i)/rp(il,i), &
	3430	& 'cv3unsat 2658').eq.1) then
	3431	write(,) 'rpprec(il,i),rs(il,i),rp(il,i)=', &
	3432	& rpprec(il,i),rs(il,i),rp(il,i)
	3433	stop
	3434	endif
	3435	endif
	3436	#ifdef ISOTRAC
	3437	call iso_verif_traceur(xtp(1,il,i),'cv30_routine 2893')
	3438	#endif
	3439	#endif
	3440	rpprec(il,i)=rs(il,i)
	3441	endif !if (rp(il,i).gt.rs(il,i)) then
	3442	endif !if (i.lt.INB et lwork)
	3443	enddo ! il=1,ncum
	3444	#endif
	3445
	3446	400 END DO
	3447
	3448	! fin de la boucle en i (altitude)
	3449	#ifdef ISO
	3450	! write(,) 'nl=',nl,'nd=',nd,'; ncum=',ncum
	3451	#ifdef ISOVERIF
	3452	do i=1,nl!nl
	3453	do il=1,ncum
	3454	if (iso_eau.gt.0) then
	3455	! write(,) 'cv30_routines 2767:i,il,lwork(il),inb(il)=',
	3456	! : i,il,lwork(il),inb(il)
	3457	! write(,) 'rp(il,i),xtp(iso_eau,il,i)=',
	3458	! : rp(il,i),xtp(iso_eau,il,i)
	3459	call iso_verif_egalite_choix(xt(iso_eau,il,i), &
	3460	& rr(il,i),'cv30_unsat 2668',errmax,errmaxrel)
	3461	call iso_verif_egalite_choix(xtp(iso_eau,il,i), &
	3462	& rp(il,i),'cv30_unsat 2670',errmax,errmaxrel)
	3463	call iso_verif_egalite_choix(xtwater(iso_eau,il,i), &
	3464	& water(il,i),'cv30_unsat 2672',errmax,errmaxrel)
	3465	endif !if (iso_eau.gt.0) then
	3466	!#ifdef ISOTRAC
	3467	! if (iso_verif_traceur_choix_nostop(xtwater(1,il,i),
	3468	! : 'cv30_routine 2982 unsat',errmax,
	3469	! : errmaxrel,ridicule_trac,deltalimtrac).eq.1) then
	3470	! write(,) 'il,i,inb(il),lwork(il)=',
	3471	! : il,i,inb(il),lwork(il)
	3472	! write(,) 'xtwater(:,il,i)=',xtwater(:,il,i)
	3473	! stop
	3474	! endif
	3475	!#endif
	3476	enddo !do il=1,nloc!ncum
	3477	enddo !do i=1,nl!nl
	3478	! il=130
	3479	! write(,) 'cv30_unsat 2780: '//
	3480	! : 'il,water(il,1),xtwater(iso_eau,il,1)='
	3481	! : ,il,water(il,1),xtwater(iso_eau,il,1)
	3482	#endif
	3483	#endif
	3484
	3485	RETURN
	3486	END SUBROUTINE cv30_unsat
	3487
	3488	SUBROUTINE cv30_yield(nloc, ncum, nd, na, ntra, icb, inb, delt, t, rr, u, v, &
	3489	tra, gz, p, ph, h, hp, lv, cpn, th, ep, clw, m, tp, mp, rp, up, vp, trap, &
	3490	wt, water, evap, b, ment, qent, uent, vent, nent, elij, traent, sig, tv, &
	3491	tvp, iflag, precip, vprecip, ft, fr, fu, fv, ftra, upwd, dnwd, dnwd0, ma, &
	3492	mike, tls, tps, qcondc, wd &
	3493	#ifdef ISO
	3494	& ,xt,xtclw,xtp,xtwater,xtevap &
	3495	& ,xtent,xtelij,xtprecip,fxt,xtVprecip &
	3496	#ifdef DIAGISO
	3497	& ,fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	3498	& ,fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
	3499	& , Amp_diag &
	3500	#endif
	3501	#endif
	3502	& )
	3503	#ifdef ISO
	3504	use infotrac_phy, ONLY: ntraciso,niso, &
	3505	& ntraceurs_zone,index_trac
	3506	use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
	3507	#ifdef ISOVERIF
	3508	use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
	3509	iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &
	3510	iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
	3511	iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
	3512	iso_verif_positif,iso_verif_egalite_vect2D, &
	3513	iso_verif_aberrant_enc_nostop,iso_verif_aberrant_encadre,iso_verif_o18_aberrant, &
	3514	iso_verif_O18_aberrant_nostop,deltaO
	3515	#endif
	3516	#ifdef ISOTRAC
	3517	use isotrac_mod, only: option_traceurs, &
	3518	izone_revap,izone_poubelle,izone_ddft
	3519	#ifdef ISOVERIF
	3520	use isotopes_verif_mod, ONLY: iso_verif_traceur_choix_nostop,deltalimtrac, &
	3521	& iso_verif_tracpos_choix_nostop,iso_verif_traceur,iso_verif_traceur_justmass
	3522	use isotrac_mod, only: ridicule_trac
	3523	#endif
	3524	#endif
	3525	#endif
	3526
	3527	IMPLICIT NONE
	3528
	3529	include "cvthermo.h"
	3530	include "cv30param.h"
	3531	include "cvflag.h"
	3532	include "conema3.h"
	3533
	3534	! inputs:
	3535	INTEGER ncum, nd, na, ntra, nloc
	3536	INTEGER icb(nloc), inb(nloc)
	3537	REAL delt
	3538	REAL t(nloc, nd), rr(nloc, nd), u(nloc, nd), v(nloc, nd)
	3539	REAL tra(nloc, nd, ntra), sig(nloc, nd)
	3540	REAL gz(nloc, na), ph(nloc, nd+1), h(nloc, na), hp(nloc, na)
	3541	REAL th(nloc, na), p(nloc, nd), tp(nloc, na)
	3542	REAL lv(nloc, na), cpn(nloc, na), ep(nloc, na), clw(nloc, na)
	3543	REAL m(nloc, na), mp(nloc, na), rp(nloc, na), up(nloc, na)
	3544	REAL vp(nloc, na), wt(nloc, nd), trap(nloc, nd, ntra)
	3545	REAL water(nloc, na), evap(nloc, na), b(nloc, na)
	3546	REAL ment(nloc, na, na), qent(nloc, na, na), uent(nloc, na, na)
	3547	! ym real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
	3548	REAL vent(nloc, na, na), elij(nloc, na, na)
	3549	INTEGER nent(nloc, na)
	3550	REAL traent(nloc, na, na, ntra)
	3551	REAL tv(nloc, nd), tvp(nloc, nd)
	3552	#ifdef ISO
	3553	real xt(ntraciso,nloc,nd)
	3554	! real xtep(ntraciso,nloc,na) ! le 7 mai: on supprime xtep
	3555	real xtclw(ntraciso,nloc,na), xtp(ntraciso,nloc,na)
	3556	real xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)
	3557	real xtent(ntraciso,nloc,na,na), xtelij(ntraciso,nloc,na,na)
	3558	#ifdef ISOVERIF
	3559	CHARACTER (LEN=20) :: modname='cv30_compress'
	3560	CHARACTER (LEN=80) :: abort_message
	3561	#endif
	3562	#endif
	3563
	3564	! input/output:
	3565	INTEGER iflag(nloc)
	3566
	3567	! outputs:
	3568	REAL precip(nloc)
	3569	REAL vprecip(nloc, nd+1)
	3570	REAL ft(nloc, nd), fr(nloc, nd), fu(nloc, nd), fv(nloc, nd)
	3571	REAL ftra(nloc, nd, ntra)
	3572	REAL upwd(nloc, nd), dnwd(nloc, nd), ma(nloc, nd)
	3573	REAL dnwd0(nloc, nd), mike(nloc, nd)
	3574	REAL tls(nloc, nd), tps(nloc, nd)
	3575	REAL qcondc(nloc, nd) ! cld
	3576	REAL wd(nloc) ! gust
	3577	#ifdef ISO
	3578	real xtprecip(ntraciso,nloc), fxt(ntraciso,nloc,nd)
	3579	real xtVprecip(ntraciso,nloc,nd+1)
	3580	#endif
	3581
	3582	! local variables:
	3583	INTEGER i, k, il, n, j, num1
	3584	REAL rat, awat, delti
	3585	REAL ax, bx, cx, dx, ex
	3586	REAL cpinv, rdcp, dpinv
	3587	REAL lvcp(nloc, na), mke(nloc, na)
	3588	REAL am(nloc), work(nloc), ad(nloc), amp1(nloc)
	3589	! !! real up1(nloc), dn1(nloc)
	3590	REAL up1(nloc, nd, nd), dn1(nloc, nd, nd)
	3591	REAL asum(nloc), bsum(nloc), csum(nloc), dsum(nloc)
	3592	REAL qcond(nloc, nd), nqcond(nloc, nd), wa(nloc, nd) ! cld
	3593	REAL siga(nloc, nd), sax(nloc, nd), mac(nloc, nd) ! cld
	3594	#ifdef ISO
	3595	integer ixt
	3596	real xtbx(ntraciso), xtawat(ntraciso)
	3597	! cam debug
	3598	! pour l'homogénéisation sous le nuage:
	3599	real frsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
	3600	! correction dans calcul tendance liée à Am:
	3601	real dq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp
	3602	#ifdef DIAGISO
	3603	! diagnostiques juste: tendance des différents processus
	3604	real fxt_detrainement(niso,nloc,nd)
	3605	real fxt_fluxmasse(niso,nloc,nd)
	3606	real fxt_evapprecip(niso,nloc,nd)
	3607	real fxt_ddft(niso,nloc,nd)
	3608	real fq_detrainement(nloc,nd)
	3609	real q_detrainement(nloc,nd)
	3610	real xt_detrainement(niso,nloc,nd)
	3611	real f_detrainement(nloc,nd)
	3612	real fq_fluxmasse(nloc,nd)
	3613	real fq_evapprecip(nloc,nd)
	3614	real fq_ddft(nloc,nd)
	3615	real Amp_diag(nloc,nd)
	3616	#endif
	3617	!#ifdef ISOVERIF
	3618	! integer iso_verif_aberrant_nostop
	3619	! real deltaD
	3620	!#endif
	3621	#ifdef ISOTRAC
	3622	! integer iso_verif_traceur_choix_nostop
	3623	! integer iso_verif_tracpos_choix_nostop
	3624	real xtnew(ntraciso)
	3625	! real conversion(niso)
	3626	real fxtYe(niso)
	3627	real fxtqe(niso)
	3628	real fxtXe(niso)
	3629	real fxt_revap(niso)
	3630	real Xe(niso)
	3631	integer ixt_revap,izone
	3632	integer ixt_poubelle, ixt_ddft,iiso
	3633	#endif
	3634	#endif
	3635
	3636
	3637	! -------------------------------------------------------------
	3638
	3639	! initialization:
	3640
	3641	delti = 1.0/delt
	3642
	3643	DO il = 1, ncum
	3644	precip(il) = 0.0
	3645	wd(il) = 0.0 ! gust
	3646	vprecip(il, nd+1) = 0.
	3647	#ifdef ISO
	3648	! cam debug
	3649	! write(,) 'cv30_routines 3082: entrée dans cv3_yield'
	3650	! en cam debug
	3651	do ixt = 1, ntraciso
	3652	xtprecip(ixt,il)=0.0
	3653	xtVprecip(ixt,il,nd+1)=0.0
	3654	enddo
	3655	#endif
	3656	END DO
	3657
	3658	DO i = 1, nd
	3659	DO il = 1, ncum
	3660	vprecip(il, i) = 0.0
	3661	ft(il, i) = 0.0
	3662	fr(il, i) = 0.0
	3663	fu(il, i) = 0.0
	3664	fv(il, i) = 0.0
	3665	qcondc(il, i) = 0.0 ! cld
	3666	qcond(il, i) = 0.0 ! cld
	3667	nqcond(il, i) = 0.0 ! cld
	3668	#ifdef ISO
	3669	do ixt = 1, ntraciso
	3670	fxt(ixt,il,i)=0.0
	3671	xtVprecip(ixt,il,i)=0.0
	3672	enddo
	3673	#ifdef DIAGISO
	3674	fq_fluxmasse(il,i)=0.0
	3675	fq_detrainement(il,i)=0.0
	3676	f_detrainement(il,i)=0.0
	3677	q_detrainement(il,i)=0.0
	3678	fq_evapprecip(il,i)=0.0
	3679	fq_ddft(il,i)=0.0
	3680	Amp_diag(il,i)=0.0
	3681	do ixt = 1, niso
	3682	fxt_fluxmasse(ixt,il,i)=0.0
	3683	fxt_detrainement(ixt,il,i)=0.0
	3684	xt_detrainement(ixt,il,i)=0.0
	3685	fxt_evapprecip(ixt,il,i)=0.0
	3686	fxt_ddft(ixt,il,i)=0.0
	3687	enddo
	3688	#endif
	3689	#endif
	3690	END DO
	3691	END DO
	3692
	3693	! do j=1,ntra
	3694	! do i=1,nd
	3695	! do il=1,ncum
	3696	! ftra(il,i,j)=0.0
	3697	! enddo
	3698	! enddo
	3699	! enddo
	3700
	3701	DO i = 1, nl
	3702	DO il = 1, ncum
	3703	lvcp(il, i) = lv(il, i)/cpn(il, i)
	3704	END DO
	3705	END DO
	3706
	3707
	3708
	3709	! * calculate surface precipitation in mm/day *
	3710
	3711	DO il = 1, ncum
	3712	IF (ep(il,inb(il))>=0.0001) THEN
	3713	IF (cvflag_grav) THEN
	3714	precip(il) = wt(il, 1)sigdwater(il, 1)86400.1000./(rowl*grav)
	3715
	3716	#ifdef ISO
	3717	do ixt = 1, ntraciso
	3718	xtprecip(ixt,il)=wt(il,1)sigdxtwater(ixt,il,1) &
	3719	& 86400.1000./(rowl*grav) ! en mm/jour
	3720	enddo
	3721	! cam verif
	3722	#ifdef ISOVERIF
	3723	if (iso_eau.gt.0) then
	3724	! write(,) 'cv30_yield 2952: '//
	3725	! : 'il,water(il,1),xtwater(iso_eau,il,1)='
	3726	! : ,il,water(il,1),xtwater(iso_eau,il,1)
	3727	call iso_verif_egalite_choix(xtwater(iso_eau,il,1), &
	3728	& water(il,1),'cv30_routines 2959', &
	3729	& errmax,errmaxrel)
	3730	!Rq: wt(il,1)sigd86400.1000./(rowlgrav)=3964.6565
	3731	! -> on auatorise 3e3 fois plus d'erreur dans precip
	3732	call iso_verif_egalite_choix(xtprecip(iso_eau,il), &
	3733	& precip(il),'cv30_routines 3138', &
	3734	& errmax*4e3,errmaxrel)
	3735	endif !if (iso_eau.gt.0) then
	3736	#ifdef ISOTRAC
	3737	call iso_verif_traceur(xtwater(1,il,1), &
	3738	& 'cv30_routine 3146')
	3739	if (iso_verif_traceur_choix_nostop(xtprecip(1,il), &
	3740	& 'cv30_routine 3147',errmax*1e2, &
	3741	& errmaxrel,ridicule_trac,deltalimtrac).eq.1) then
	3742	write(,) 'il,inb(il)=',il,inb(il)
	3743	write(,) 'xtwater(:,il,1)=',xtwater(:,il,1)
	3744	write(,) 'xtprecip(:,il)=',xtprecip(:,il)
	3745	write(,) 'fac=',wt(il,1)sigd86400.1000./(rowlgrav)
	3746	stop
	3747	endif
	3748	#endif
	3749	#endif
	3750	! end cam verif
	3751	#endif
	3752	ELSE !IF (cvflag_grav) THEN
	3753	precip(il) = wt(il, 1)sigdwater(il, 1)*8640.
	3754	#ifdef ISO
	3755	do ixt = 1, ntraciso
	3756	xtprecip(ixt,il)=wt(il,1)sigdxtwater(ixt,il,1)*8640.
	3757	enddo
	3758	! cam verif
	3759	#ifdef ISOVERIF
	3760	if (iso_eau.gt.0) then
	3761	call iso_verif_egalite_choix(xtprecip(iso_eau,il), &
	3762	& precip(il),'cv30_routines 3139', &
	3763	& errmax,errmaxrel)
	3764	endif !if (iso_eau.gt.0) then
	3765	#ifdef ISOTRAC
	3766	call iso_verif_traceur(xtprecip(1,il),'cv30_routine 3166')
	3767	#endif
	3768	#endif
	3769	! end cam verif
	3770	#endif
	3771	END IF !IF (cvflag_grav) THEN
	3772	END IF
	3773	END DO
	3774
	3775	! *** CALCULATE VERTICAL PROFILE OF PRECIPITATIONs IN kg/m2/s ===
	3776
	3777	! MAF rajout pour lessivage
	3778	DO k = 1, nl
	3779	DO il = 1, ncum
	3780	IF (k<=inb(il)) THEN
	3781	IF (cvflag_grav) THEN
	3782	vprecip(il, k) = wt(il, k)sigdwater(il, k)/grav
	3783	#ifdef ISO
	3784	do ixt=1,ntraciso
	3785	xtVPrecip(ixt,il,k) = wt(il,k)*sigd &
	3786	& *xtwater(ixt,il,k)/grav
	3787	enddo
	3788	#endif
	3789	ELSE
	3790	vprecip(il, k) = wt(il, k)sigdwater(il, k)/10.
	3791	#ifdef ISO
	3792	do ixt=1,ntraciso
	3793	xtVPrecip(ixt,il,k) = wt(il,k)*sigd &
	3794	& *xtwater(ixt,il,k)/10.0
	3795	enddo
	3796	#endif
	3797	END IF
	3798	END IF
	3799	END DO
	3800	END DO
	3801
	3802
	3803	! * Calculate downdraft velocity scale *
	3804	! * NE PAS UTILISER POUR L'INSTANT *
	3805
	3806	! ! do il=1,ncum
	3807	! ! wd(il)=betadabs(mp(il,icb(il)))0.01rrdt(il,icb(il))
	3808	! ! : /(sigd*p(il,icb(il)))
	3809	! ! enddo
	3810
	3811
	3812	! * calculate tendencies of lowest level potential temperature *
	3813	! * and mixing ratio *
	3814
	3815	DO il = 1, ncum
	3816	work(il) = 1.0/(ph(il,1)-ph(il,2))
	3817	am(il) = 0.0
	3818	END DO
	3819
	3820	DO k = 2, nl
	3821	DO il = 1, ncum
	3822	IF (k<=inb(il)) THEN
	3823	am(il) = am(il) + m(il, k)
	3824	END IF
	3825	END DO
	3826	END DO
	3827
	3828	DO il = 1, ncum
	3829
	3830	! convect3 if((0.1dpinvam).ge.delti)iflag(il)=4
	3831	IF (cvflag_grav) THEN
	3832	IF ((0.01gravwork(il)*am(il))>=delti) iflag(il) = 1 !consist vect
	3833	ft(il, 1) = 0.01gravwork(il)am(il)(t(il,2)-t(il,1)+(gz(il,2)-gz(il, &
	3834	1))/cpn(il,1))
	3835	ELSE
	3836	IF ((0.1work(il)am(il))>=delti) iflag(il) = 1 !consistency vect
	3837	ft(il, 1) = 0.1work(il)am(il)*(t(il,2)-t(il,1)+(gz(il,2)-gz(il, &
	3838	1))/cpn(il,1))
	3839	END IF
	3840
	3841	ft(il, 1) = ft(il, 1) - 0.5lvcp(il, 1)sigd*(evap(il,1)+evap(il,2))
	3842
	3843	IF (cvflag_grav) THEN
	3844	ft(il, 1) = ft(il, 1) - 0.009gravsigdmp(il, 2)t(il, 1)b(il, 1) &
	3845	work(il)
	3846	ELSE
	3847	ft(il, 1) = ft(il, 1) - 0.09sigdmp(il, 2)t(il, 1)b(il, 1)*work(il)
	3848	END IF
	3849
	3850	ft(il, 1) = ft(il, 1) + 0.01sigdwt(il, 1)(cl-cpd)water(il, 2)*(t(il,2 &
	3851	)-t(il,1))*work(il)/cpn(il, 1)
	3852
	3853	IF (cvflag_grav) THEN
	3854	! jyg1 Correction pour mieux conserver l'eau (conformite avec
	3855	! CONVECT4.3)
	3856	! (sb: pour l'instant, on ne fait que le chgt concernant grav, pas
	3857	! evap)
	3858	fr(il, 1) = 0.01gravmp(il, 2)(rp(il,2)-rr(il,1))work(il) + &
	3859	sigd0.5(evap(il,1)+evap(il,2))
	3860	! +tard : +sigd*evap(il,1)
	3861
	3862	fr(il, 1) = fr(il, 1) + 0.01gravam(il)(rr(il,2)-rr(il,1))work(il)
	3863
	3864	#ifdef ISO
	3865	! juste Mp et evap pour l'instant, voir plus bas pour am
	3866	do ixt = 1, ntraciso
	3867	fxt(ixt,il,1)= &
	3868	& 0.01gravmp(il,2)(xtp(ixt,il,2)-xt(ixt,il,1))work(il) &
	3869	& +sigd0.5(xtevap(ixt,il,1)+xtevap(ixt,il,2))
	3870	!c+tard : +sigd*xtevap(ixt,il,1)
	3871	enddo !do ixt = 1, ntraciso ! pour water tagging option 6: pas besoin ici de faire de conversion.
	3872
	3873	#ifdef DIAGISO
	3874	fq_ddft(il,1)=fq_ddft(il,1) &
	3875	& +0.01gravmp(il,2)(rp(il,2)-rr(il,1))work(il)
	3876	fq_evapprecip(il,1)=fq_evapprecip(il,1) &
	3877	& +sigd0.5(evap(il,1)+evap(il,2))
	3878	fq_fluxmasse(il,1)=fq_fluxmasse(il,1) &
	3879	& +0.01gravam(il)(rr(il,2)-rr(il,1))work(il)
	3880	Amp_diag(il,1)=Amp_diag(il,1)+am(il)
	3881	do ixt = 1, niso
	3882	! fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
	3883	! & +0.01gravam(il)(xt(ixt,il,2)-xt(ixt,il,1))work(il) ! déplacé
	3884	! plus haut car il existe différents cas
	3885	fxt_ddft(ixt,il,1)=fxt_ddft(ixt,il,1) &
	3886	& +0.01gravmp(il,2)(xtp(ixt,il,2)-xt(ixt,il,1))work(il)
	3887	fxt_evapprecip(ixt,il,1)=fxt_evapprecip(ixt,il,1) &
	3888	& +sigd0.5(xtevap(ixt,il,1)+xtevap(ixt,il,2))
	3889	enddo
	3890	#endif
	3891
	3892
	3893	! pour l'ajout de la tendance liée au flux de masse Am, il faut être
	3894	! prudent.
	3895	! On a dq1=k(q2-q1) avec k=dt0.01gravam(il)*work(il)
	3896	! Pour les isotopes, la formule utilisée depuis 2006 et qui avait toujours marché est:
	3897	! dx1=k*(x2-x1)
	3898	! Mais on plante dans un cas pathologique en décembre 2017 lors du test
	3899	! d'un cas d'Anne Cozic: les isotopes deviennent négatifs.
	3900	! C'est un cas pas physique: on perd 99% de la masse de vapeur d'eau!
	3901	! q2=1.01e-3 et q1=1.25e-3 kg/kg
	3902	! et dq=-1.24e-3: comment est-ce possible qu'un flux venant d'un air à
	3903	! q2= 1.01e-3 assèche q1 jusqu'à 0.01e-3kg/kg!
	3904	! Pour les isotopes, ça donne des x1+dx négatifs.
	3905	! Ce n'est pas physique mais il faut quand même s'adapter.
	3906	! Pour cela, on considère que d'abord on fait rentrer le flux de masse
	3907	! descendant, et ensuite seulement on fait sortir le flux de masse
	3908	! sortant.
	3909	! Ainsi, le flux de masse sortant ne modifie pas la composition
	3910	! isotopique de la vapeur d'eau q1.
	3911	! A la fin, on a R=(x1+dx)/(q1+dq)=(x1+kx2)/(q1+kq2)
	3912	! On vérifie que quand k est petit, on tend vers la formulation
	3913	! habituelle.
	3914	! Comme on est habitués à la formulation habituelle, qu'elle a fait ses
	3915	! preuves, on la garde sauf dans le cas où dq/q<-0.9 où on utilise la
	3916	! nouvelle formulation.
	3917	! rappel: dq_tmp=0.01gravam(il)(rr(il,2)-rr(il,1))work(il)*delt
	3918	! Même avec cette nouvelle foirmulation, on a encore des isotopes
	3919	! négatifs, cette fois à cause des ddfts
	3920	! On considère donc les tendances et série et non en parallèle quand on
	3921	! calcule R_tmp.
	3922	dq_tmp=0.01gravam(il)(rr(il,2)-rr(il,1))work(il)*delt ! utile ci-dessous
	3923	if (dq_tmp/rr(il,1).lt.-0.9) then
	3924	! nouvelle formulation où on fait d'abord entrer k*q2 et ensuite
	3925	! seulement on fait sortir k*q1 sans changement de composition
	3926	! isotopique
	3927	k_tmp=0.01gravam(il)work(il)delt
	3928	dqreste_tmp= 0.01gravmp(il, 2)(rp(il,2)-rr(il,1))work(il)*delt + &
	3929	& sigd0.5(evap(il,1)+evap(il,2))*delt
	3930	do ixt = 1, ntraciso
	3931	dxreste_tmp= 0.01gravmp(il,2)(xtp(ixt,il,2)-xt(ixt,il,1))work(il)*delt &
	3932	& +sigd0.5(xtevap(ixt,il,1)+xtevap(ixt,il,2))*delt
	3933	R_tmp=(xt(ixt,il,1)+dxreste_tmp+k_tmpxt(ixt,il,2))/(rr(il,1)+dqreste_tmp+k_tmprr(il,2))
	3934	dx_tmp=R_tmp*(rr(il,1)+dqreste_tmp+dq_tmp)-(xt(ixt,il,1)+dxreste_tmp)
	3935	fxt(ixt,il,1)=fxt(ixt,il,1) &
	3936	& + dx_tmp/delt
	3937	#ifdef ISOVERIF
	3938	if (ixt.eq.iso_HDO) then
	3939	write(,) 'cv30_routines 3888: il=',il
	3940	write(,) 'dq_tmp,rr(il,1)=',dq_tmp,rr(il,1)
	3941	write(,) 'R_tmp,dx_tmp,delt=',R_tmp,dx_tmp,delt
	3942	write(,) 'xt(ixt,il,1:2)=',xt(ixt,il,1:2)
	3943	write(,) 'rr(il,1:2)=',rr(il,1:2)
	3944	write(,) 'fxt=',dx_tmp/delt
	3945	write(,) 'rr(il,1)+dq_tmp=',rr(il,1)+dq_tmp
	3946	write(,) 'xt(ixt,il,1)+dx_tmp=',xt(ixt,il,1)+dx_tmp
	3947	write(,) 'xt(ixt,il,1)+fxt(ixt,il,1)*delt=', &
	3948	& xt(ixt,il,1)+fxt(ixt,il,1)*delt
	3949	write(,) 'dqreste_tmp,dxreste_tmp=',dqreste_tmp,dxreste_tmp
	3950	write(,) 'formule classique: fxt_Am=',0.01gravam(il)(xt(ixt,il,2)-xt(ixt,il,1))work(il)
	3951	write(,) 'donnerait dxt=',0.01gravam(il)(xt(ixt,il,2)-xt(ixt,il,1))work(il)*delt
	3952	endif !if (ixt.eq.iso_HDO) then
	3953	#endif
	3954	#ifdef DIAGISO
	3955	if (ixt.le.niso) then
	3956	fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
	3957	& + dx_tmp/delt
	3958	endif
	3959	#endif
	3960	enddo ! do ixt = 1, ntraciso
	3961	else !if (dq_tmp/rr(il,1).lt.-0.9) then
	3962	! formulation habituelle qui avait toujours marché de 2006 à
	3963	! décembre 2017.
	3964	do ixt = 1, ntraciso
	3965	fxt(ixt,il,1)=fxt(ixt,il,1) &
	3966	& +0.01gravam(il)(xt(ixt,il,2)-xt(ixt,il,1))work(il)
	3967	#ifdef DIAGISO
	3968	if (ixt.le.niso) then
	3969	fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
	3970	& +0.01gravam(il)(xt(ixt,il,2)-xt(ixt,il,1))work(il)
	3971	endif
	3972	#endif
	3973	enddo !do ixt = 1, ntraciso
	3974	endif !if (dq_tmp/rr(il,1).lt.-0.9) then
	3975
	3976	! cam verif
	3977	#ifdef ISOVERIF
	3978	if (iso_eau.gt.0) then
	3979	call iso_verif_egalite_choix(fxt(iso_eau,il,1), &
	3980	& fr(il,1),'cv30_routines 3251', &
	3981	& errmax,errmaxrel)
	3982	endif !if (iso_eau.gt.0) then
	3983	!write(,) 'il,am(il)=',il,am(il)
	3984	if ((iso_HDO.gt.0).and. &
	3985	& (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
	3986	if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,1) &
	3987	& +deltfxt(iso_HDO,il,1))/(rr(il,1)+deltfr(il,1)), &
	3988	& 'cv30_yield 3125, ddft en 1').eq.1) then
	3989	write(,) 'il,rr(il,1),delt=',il,rr(il,1),delt
	3990	write(,) 'deltaDxt=',deltaD(xt(iso_HDO,il,1)/rr(il,1))
	3991	write(,) 'deltfr(il,1),fr(il,1)=',deltfr(il,1),fr(il,1)
	3992	write(,) 'fxt=',fxt(iso_HDO,il,1)
	3993	write(,) 'fq_ddft(il,1)=',0.01gravmp(il,2)(rp(il,2)-rr(il,1))work(il)
	3994	write(,) 'fq_evapprecip(il,1)=',sigd0.5(evap(il,1)+evap(il,2))
	3995	write(,) 'fq_fluxmasse(il,1)=', 0.01gravam(il)(rr(il,2)-rr(il,1))work(il)
	3996	write(,) 'deltaDfq_ddft=',deltaD((xtp(iso_HDO,il,2)-xt(iso_HDO,il,1))/(rp(il,2)-rr(il,1)))
	3997	write(,) 'deltaDfq_evapprecip=',deltaD((xtevap(iso_HDO,il,1)+xtevap(iso_HDO,il,2))/(evap(il,1)+evap(il,2)))
	3998	write(,) 'deltaDfq_fluxmasse=',deltaD((xt(iso_HDO,il,2)-xt(iso_HDO,il,1))/(rr(il,2)-rr(il,1)))
	3999	write(,) 'rr(il,2),rr(il,1)=',rr(il,2),rr(il,1)
	4000	write(,) 'xt(iso_HDO,il,2),xt(iso_HDO,il,1)',xt(iso_HDO,il,2),xt(iso_HDO,il,1)
	4001	write(,) 'dq_tmp=',dq_tmp
	4002	call abort_physic('cv30_routines','cv30_yield',1)
	4003	endif ! iso_verif_aberrant_enc_nostop
	4004	endif !if (iso_HDO.gt.0) then
	4005	#ifdef ISOTRAC
	4006	call iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3417')
	4007	do ixt=1,ntraciso
	4008	xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
	4009	enddo
	4010	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3395',1e-5) &
	4011	& .eq.1) then
	4012	write(,) 'il=',il
	4013	write(,) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
	4014	write(,) 'xt(:,il,1)=' ,xt(:,il,1)
	4015	#ifdef DIAGISO
	4016	write(,) 'fxt_fluxmasse(:,il,1)=',fxt_fluxmasse(:,il,1)
	4017	write(,) 'fxt_ddft(:,il,1)=',fxt_ddft(:,il,1)
	4018	write(,) 'fxt_evapprecip(:,il,1)=', &
	4019	& fxt_evapprecip(:,il,1)
	4020	write(,) 'xt(:,il,2)=',xt(:,il,2)
	4021	write(,) 'xtp(:,il,2)=',xtp(:,il,2)
	4022	write(,) 'xtevap(:,il,1)=',xtevap(:,il,1)
	4023	write(,) 'xtevap(:,il,2)=',xtevap(:,il,2)
	4024	write(,) 'facam,facmp,facev=',0.01gravam(il)*work(il), &
	4025	& 0.01gravmp(il,2)work(il),sigd0.5
	4026	#endif
	4027	! stop
	4028	endif
	4029	#endif
	4030	#endif
	4031	! end cam verif
	4032	#endif
	4033
	4034	fu(il, 1) = fu(il, 1) + 0.01gravwork(il)(mp(il,2)(up(il,2)-u(il, &
	4035	1))+am(il)*(u(il,2)-u(il,1)))
	4036	fv(il, 1) = fv(il, 1) + 0.01gravwork(il)(mp(il,2)(vp(il,2)-v(il, &
	4037	1))+am(il)*(v(il,2)-v(il,1)))
	4038	ELSE ! cvflag_grav
	4039	fr(il, 1) = 0.1mp(il, 2)(rp(il,2)-rr(il,1))*work(il) + &
	4040	sigd0.5(evap(il,1)+evap(il,2))
	4041	fr(il, 1) = fr(il, 1) + 0.1am(il)(rr(il,2)-rr(il,1))*work(il)
	4042
	4043
	4044	#ifdef ISO
	4045	do ixt = 1, ntraciso
	4046	fxt(ixt,il,1)=0.1mp(il,2)(xtp(ixt,il,2)-xt(ixt,il,1))*work(il) &
	4047	& +sigd0.5(xtevap(ixt,il,1)+xtevap(ixt,il,2))
	4048	fxt(ixt,il,1)=fxt(ixt,il,1) &
	4049	& +0.1am(il)(xt(ixt,il,2)-xt(ixt,il,1))*work(il)
	4050	enddo
	4051
	4052	#ifdef DIAGISO
	4053	fq_ddft(il,1)=fq_ddft(il,1) &
	4054	& +0.1mp(il,2)(rp(il,2)-rr(il,1))*work(il)
	4055	fq_evapprecip(il,1)=fq_evapprecip(il,1) &
	4056	& +sigd0.5(evap(il,1)+evap(il,2))
	4057	fq_fluxmasse(il,1)=fq_fluxmasse(il,1) &
	4058	& +0.1am(il)(rr(il,2)-rr(il,1))*work(il)
	4059	Amp_diag(il,1)=Amp_diag(il,1)+am(il)
	4060	do ixt = 1, niso
	4061	fxt_fluxmasse(ixt,il,1)=fxt(ixt,il,1) &
	4062	& +0.1am(il)(xt(ixt,il,2)-xt(ixt,il,1))*work(il)
	4063	fxt_ddft(ixt,il,1)=fxt(ixt,il,1) &
	4064	& +0.1mp(il,2)(xtp(ixt,il,2)-xt(ixt,il,1))*work(il)
	4065	fxt_evapprecip(ixt,il,1)=fxt(ixt,il,1) &
	4066	& +sigd0.5(xtevap(ixt,il,1)+xtevap(ixt,il,2))
	4067	enddo
	4068	#endif
	4069
	4070
	4071	! cam verif
	4072	#ifdef ISOVERIF
	4073	if (iso_eau.gt.0) then
	4074	call iso_verif_egalite_choix(fxt(iso_eau,il,1), &
	4075	& fr(il,1),'cv30_routines 3023', &
	4076	& errmax,errmaxrel)
	4077	endif !if (iso_eau.gt.0) then
	4078	if ((iso_HDO.gt.0).and. &
	4079	& (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
	4080	call iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
	4081	& +delt*fxt(iso_HDO,il,1)) &
	4082	& /(rr(il,1)+delt*fr(il,1)), &
	4083	& 'cv30_yield 3125b, ddft en 1')
	4084	endif !if (iso_HDO.gt.0) then
	4085	#ifdef ISOTRAC
	4086	call iso_verif_traceur_justmass(fxt(1,il,1), &
	4087	& 'cv30_routine 3417')
	4088	do ixt=1,ntraciso
	4089	xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
	4090	enddo
	4091	if (iso_verif_tracpos_choix_nostop(xtnew, &
	4092	& 'cv30_yield 3449',1e-5) &
	4093	& .eq.1) then
	4094	write(,) 'il=',il
	4095	write(,) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
	4096	write(,) 'xt(:,il,1)=' ,xt(:,il,1)
	4097	! stop
	4098	endif
	4099	#endif
	4100	#endif
	4101	! end cam verif
	4102	#endif
	4103	fu(il, 1) = fu(il, 1) + 0.1work(il)(mp(il,2)*(up(il,2)-u(il, &
	4104	1))+am(il)*(u(il,2)-u(il,1)))
	4105	fv(il, 1) = fv(il, 1) + 0.1work(il)(mp(il,2)*(vp(il,2)-v(il, &
	4106	1))+am(il)*(v(il,2)-v(il,1)))
	4107	END IF ! cvflag_grav
	4108
	4109	END DO ! il
	4110
	4111	! do j=1,ntra
	4112	! do il=1,ncum
	4113	! if (cvflag_grav) then
	4114	! ftra(il,1,j)=ftra(il,1,j)+0.01gravwork(il)
	4115	! : (mp(il,2)(trap(il,2,j)-tra(il,1,j))
	4116	! : +am(il)*(tra(il,2,j)-tra(il,1,j)))
	4117	! else
	4118	! ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
	4119	! : (mp(il,2)(trap(il,2,j)-tra(il,1,j))
	4120	! : +am(il)*(tra(il,2,j)-tra(il,1,j)))
	4121	! endif
	4122	! enddo
	4123	! enddo
	4124
	4125	DO j = 2, nl
	4126	DO il = 1, ncum
	4127	IF (j<=inb(il)) THEN
	4128	IF (cvflag_grav) THEN
	4129	fr(il, 1) = fr(il, 1) + 0.01gravwork(il)ment(il, j, 1)(qent(il, &
	4130	j,1)-rr(il,1))
	4131	fu(il, 1) = fu(il, 1) + 0.01gravwork(il)ment(il, j, 1)(uent(il, &
	4132	j,1)-u(il,1))
	4133	fv(il, 1) = fv(il, 1) + 0.01gravwork(il)ment(il, j, 1)(vent(il, &
	4134	j,1)-v(il,1))
	4135
	4136	#ifdef ISO
	4137	do ixt = 1, ntraciso
	4138	fxt(ixt,il,1)=fxt(ixt,il,1) &
	4139	& +0.01gravwork(il)ment(il,j,1)(xtent(ixt,il,j,1)-xt(ixt,il,1))
	4140	enddo
	4141
	4142	#ifdef DIAGISO
	4143	fq_detrainement(il,1)=fq_detrainement(il,1) &
	4144	& +0.01gravwork(il)ment(il,j,1)(qent(il,j,1)-rr(il,1))
	4145	f_detrainement(il,1)=f_detrainement(il,1) &
	4146	& +0.01gravwork(il)*ment(il,j,1)
	4147	q_detrainement(il,1)=q_detrainement(il,1) &
	4148	& +0.01gravwork(il)ment(il,j,1)qent(il,j,1)
	4149	do ixt = 1, niso
	4150	fxt_detrainement(ixt,il,1)=fxt_detrainement(ixt,il,1)
	4151	& +0.01gravwork(il)ment(il,j,1)(xtent(ixt,il,j,1)-xt(ixt,il,1))
	4152	xt_detrainement(ixt,il,1)=xt_detrainement(ixt,il,1) &
	4153	& +0.01gravwork(il)ment(il,j,1)xtent(ixt,il,j,1)
	4154	enddo
	4155	#endif
	4156
	4157	! cam verif
	4158	#ifdef ISOVERIF
	4159	if (iso_eau.gt.0) then
	4160	call iso_verif_egalite_choix(fxt(iso_eau,il,1), &
	4161	& fr(il,1),'cv30_routines 3251',errmax,errmaxrel)
	4162	endif !if (iso_eau.gt.0) then
	4163	if ((iso_HDO.gt.0).and. &
	4164	& (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
	4165	call iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
	4166	& +deltfxt(iso_HDO,il,1))/(rr(il,1)+deltfr(il,1)), &
	4167	& 'cv30_yield 3127, dtr melanges')
	4168	endif !if (iso_HDO.gt.0) then
	4169	#ifdef ISOTRAC
	4170	call iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3417')
	4171	do ixt=1,ntraciso
	4172	xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
	4173	enddo
	4174	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3525',1e-5) &
	4175	& .eq.1) then
	4176	write(,) 'il=',il
	4177	write(,) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
	4178	write(,) 'fac=', 0.01gravwork(il)*ment(il,j,1)
	4179	write(,) 'xt(:,il,1)=' ,xt(:,il,1)
	4180	write(,) 'xtent(:,il,j,1)=' ,xtent(:,il,j,1)
	4181	! stop
	4182	endif
	4183	#endif
	4184	#endif
	4185	! end cam verif
	4186	#endif
	4187
	4188	ELSE ! cvflag_grav
	4189	fr(il, 1) = fr(il, 1) + 0.1work(il)ment(il, j, 1)*(qent(il,j,1)- &
	4190	rr(il,1))
	4191	fu(il, 1) = fu(il, 1) + 0.1work(il)ment(il, j, 1)*(uent(il,j,1)-u &
	4192	(il,1))
	4193	fv(il, 1) = fv(il, 1) + 0.1work(il)ment(il, j, 1)*(vent(il,j,1)-v &
	4194	(il,1))
	4195
	4196	#ifdef ISO
	4197	do ixt = 1, ntraciso
	4198	fxt(ixt,il,1)=fxt(ixt,il,1) &
	4199	& +0.1work(il)ment(il,j,1)*(xtent(ixt,il,j,1)-xt(ixt,il,1))
	4200	enddo
	4201
	4202	#ifdef DIAGISO
	4203	fq_detrainement(il,1)=fq_detrainement(il,1) &
	4204	& +0.1work(il)ment(il,j,1)*(qent(il,j,1)-rr(il,1))
	4205	f_detrainement(il,1)=f_detrainement(il,1) &
	4206	& +0.1work(il)ment(il,j,1)
	4207	q_detrainement(il,1)=q_detrainement(il,1) &
	4208	& +0.1work(il)ment(il,j,1)*qent(il,j,1)
	4209	do ixt = 1, niso
	4210	fxt_detrainement(ixt,il,1)=fxt_detrainement(ixt,il,1) &
	4211	& +0.1work(il)ment(il,j,1)*(xtent(ixt,il,j,1)-xt(ixt,il,1))
	4212	xt_detrainement(ixt,il,1)=xt_detrainement(ixt,il,1) &
	4213	& +0.1work(il)ment(il,j,1)*xtent(ixt,il,j,1)
	4214	enddo
	4215	#endif
	4216
	4217	! cam verif
	4218	#ifdef ISOVERIF
	4219	if (iso_eau.gt.0) then
	4220	call iso_verif_egalite_choix(fxt(iso_eau,il,1), &
	4221	& fr(il,1),'cv30_routines 3092',errmax,errmaxrel)
	4222	endif !if (iso_eau.gt.0) then
	4223	if ((iso_HDO.gt.0).and. &
	4224	& (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
	4225	call iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
	4226	& +deltfxt(iso_HDO,il,1))/(rr(il,1)+deltfr(il,1)), &
	4227	& 'cv30_yield 3127b, dtr melanges')
	4228	endif !if (iso_HDO.gt.0) then
	4229	#ifdef ISOTRAC
	4230	call iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3462')
	4231	do ixt=1,ntraciso
	4232	xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
	4233	enddo
	4234	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3753',1e-5) &
	4235	& .eq.1) then
	4236	write(,) 'il=',il
	4237	endif
	4238	#endif
	4239	#endif
	4240	! end cam verif
	4241	#endif
	4242
	4243	END IF ! cvflag_grav
	4244	END IF ! j
	4245	END DO
	4246	END DO
	4247
	4248	! do k=1,ntra
	4249	! do j=2,nl
	4250	! do il=1,ncum
	4251	! if (j.le.inb(il)) then
	4252
	4253	! if (cvflag_grav) then
	4254	! ftra(il,1,k)=ftra(il,1,k)+0.01gravwork(il)*ment(il,j,1)
	4255	! : *(traent(il,j,1,k)-tra(il,1,k))
	4256	! else
	4257	! ftra(il,1,k)=ftra(il,1,k)+0.1work(il)ment(il,j,1)
	4258	! : *(traent(il,j,1,k)-tra(il,1,k))
	4259	! endif
	4260
	4261	! endif
	4262	! enddo
	4263	! enddo
	4264	! enddo
	4265
	4266
	4267	! * calculate tendencies of potential temperature and mixing ratio *
	4268	! * at levels above the lowest level *
	4269
	4270	! * first find the net saturated updraft and downdraft mass fluxes *
	4271	! * through each level *
	4272
	4273
	4274	DO i = 2, nl + 1 ! newvecto: mettre nl au lieu nl+1?
	4275
	4276	num1 = 0
	4277	DO il = 1, ncum
	4278	IF (i<=inb(il)) num1 = num1 + 1
	4279	END DO
	4280	IF (num1<=0) GO TO 500
	4281
	4282	CALL zilch(amp1, ncum)
	4283	CALL zilch(ad, ncum)
	4284
	4285	DO k = i + 1, nl + 1
	4286	DO il = 1, ncum
	4287	IF (i<=inb(il) .AND. k<=(inb(il)+1)) THEN
	4288	amp1(il) = amp1(il) + m(il, k)
	4289	END IF
	4290	END DO
	4291	END DO
	4292
	4293	DO k = 1, i
	4294	DO j = i + 1, nl + 1
	4295	DO il = 1, ncum
	4296	IF (i<=inb(il) .AND. j<=(inb(il)+1)) THEN
	4297	amp1(il) = amp1(il) + ment(il, k, j)
	4298	END IF
	4299	END DO
	4300	END DO
	4301	END DO
	4302
	4303	DO k = 1, i - 1
	4304	DO j = i, nl + 1 ! newvecto: nl au lieu nl+1?
	4305	DO il = 1, ncum
	4306	IF (i<=inb(il) .AND. j<=inb(il)) THEN
	4307	ad(il) = ad(il) + ment(il, j, k)
	4308	END IF
	4309	END DO
	4310	END DO
	4311	END DO
	4312
	4313	DO il = 1, ncum
	4314	IF (i<=inb(il)) THEN
	4315	dpinv = 1.0/(ph(il,i)-ph(il,i+1))
	4316	cpinv = 1.0/cpn(il, i)
	4317
	4318	! convect3 if((0.1dpinvamp1).ge.delti)iflag(il)=4
	4319	IF (cvflag_grav) THEN
	4320	IF ((0.01gravdpinv*amp1(il))>=delti) iflag(il) = 1 ! vecto
	4321	ELSE
	4322	IF ((0.1dpinvamp1(il))>=delti) iflag(il) = 1 ! vecto
	4323	END IF
	4324
	4325	IF (cvflag_grav) THEN
	4326	ft(il, i) = 0.01gravdpinv(amp1(il)(t(il,i+1)-t(il, &
	4327	i)+(gz(il,i+1)-gz(il,i))cpinv)-ad(il)(t(il,i)-t(il, &
	4328	i-1)+(gz(il,i)-gz(il,i-1))cpinv)) - 0.5sigdlvcp(il, i)(evap( &
	4329	il,i)+evap(il,i+1))
	4330	rat = cpn(il, i-1)*cpinv
	4331	ft(il, i) = ft(il, i) - 0.009gravsigd(mp(il,i+1)t(il,i)*b(il,i) &
	4332	-mp(il,i)t(il,i-1)ratb(il,i-1))dpinv
	4333	ft(il, i) = ft(il, i) + 0.01gravdpinvment(il, i, i)(hp(il,i)-h( &
	4334	il,i)+t(il,i)(cpv-cpd)(rr(il,i)-qent(il,i,i)))*cpinv
	4335	ELSE ! cvflag_grav
	4336	ft(il, i) = 0.1dpinv(amp1(il)*(t(il,i+1)-t(il, &
	4337	i)+(gz(il,i+1)-gz(il,i))cpinv)-ad(il)(t(il,i)-t(il, &
	4338	i-1)+(gz(il,i)-gz(il,i-1))cpinv)) - 0.5sigdlvcp(il, i)(evap( &
	4339	il,i)+evap(il,i+1))
	4340	rat = cpn(il, i-1)*cpinv
	4341	ft(il, i) = ft(il, i) - 0.09sigd(mp(il,i+1)t(il,i)b(il,i)-mp(il &
	4342	,i)t(il,i-1)ratb(il,i-1))dpinv
	4343	ft(il, i) = ft(il, i) + 0.1dpinvment(il, i, i)*(hp(il,i)-h(il,i)+ &
	4344	t(il,i)(cpv-cpd)(rr(il,i)-qent(il,i,i)))*cpinv
	4345	END IF ! cvflag_grav
	4346
	4347
	4348	ft(il, i) = ft(il, i) + 0.01sigdwt(il, i)(cl-cpd)water(il, i+1)*( &
	4349	t(il,i+1)-t(il,i))dpinvcpinv
	4350
	4351	IF (cvflag_grav) THEN
	4352	fr(il, i) = 0.01gravdpinv(amp1(il)(rr(il,i+1)-rr(il, &
	4353	i))-ad(il)*(rr(il,i)-rr(il,i-1)))
	4354	fu(il, i) = fu(il, i) + 0.01gravdpinv(amp1(il)(u(il,i+1)-u(il, &
	4355	i))-ad(il)*(u(il,i)-u(il,i-1)))
	4356	fv(il, i) = fv(il, i) + 0.01gravdpinv(amp1(il)(v(il,i+1)-v(il, &
	4357	i))-ad(il)*(v(il,i)-v(il,i-1)))
	4358
	4359	#ifdef ISO
	4360	#ifdef DIAGISO
	4361	fq_fluxmasse(il,i)=fq_fluxmasse(il,i) &
	4362	& +0.01gravdpinv(amp1(il)(rr(il,i+1)-rr(il,i)) &
	4363	& -ad(il)*(rr(il,i)-rr(il,i-1)))
	4364	Amp_diag(il,i)=Amp_diag(il,i)+amp1(il)-ad(il)
	4365	! write(,) 'pgm 3754: il,i,Amp_diag(il,i)=',il,i,Amp_diag(il,i)
	4366	! modif 2 fev: pour avoir subsidence compensatoire totale, on retranche
	4367	! ad.
	4368	#endif
	4369	! ici, on sépare 2 cas, pour éviter le cas pathologique décrit plus haut
	4370	! pour la tendance liée à Am en i=1, qui peut conduire à des isotopes
	4371	! négatifs dans les cas où les flux de masse soustrait plus de 90% de la
	4372	! vapeur de la couche. Voir plus haut le détail des équations.
	4373	! La différence ici est qu'on considère les flux de masse amp1 et ad en
	4374	! même temps.
	4375	dq_tmp= 0.01gravdpinv(amp1(il)(rr(il,i+1)-rr(il,i)) &
	4376	& -ad(il)(rr(il,i)-rr(il,i-1)))delt
	4377	! c'est équivalent à dqi= kamp1qip1+kadqim1-(kamp1+kad)*qi
	4378	if (dq_tmp/rr(il,i).lt.-0.9) then
	4379	! nouvelle formulation
	4380	k_tmp=0.01gravdpinvamp1(il)delt
	4381	kad_tmp=0.01gravdpinvad(il)delt
	4382	do ixt = 1, ntraciso
	4383	R_tmp=(xt(ixt,il,i)+k_tmpxt(ixt,il,i+1)+kad_tmpxt(ixt,il,i-1)) &
	4384	& /(rr(il,i)+k_tmprr(il,i+1)+kad_tmprr(il,i-1))
	4385	dx_tmp= R_tmp*( rr(il,i)+ dq_tmp)-xt(ixt,il,i)
	4386	fxt(ixt,il,i)= dx_tmp/delt
	4387	#ifdef ISOVERIF
	4388	if ((ixt.eq.iso_HDO).or.(ixt.eq.iso_eau)) then
	4389	write(,) 'cv30_routines 4367: il,i,ixt=',il,i,ixt
	4390	write(,) 'dq_tmp,rr(il,i)=',dq_tmp,rr(il,i)
	4391	write(,) 'R_tmp,dx_tmp,delt=',R_tmp,dx_tmp,delt
	4392	write(,) 'amp1(il),ad(il)=',amp1(il),ad(il)
	4393	write(,) 'xt(ixt,il,i-1:i+1)=',xt(ixt,il,i-1:i+1)
	4394	write(,) 'rr(il,i-1:i+1)=',rr(il,i-1:i+1)
	4395	write(,) 'fxt=',dx_tmp/delt
	4396	write(,) 'rr(il,i)+dq_tmp=',rr(il,1)+dq_tmp
	4397	write(,) 'xt(ixt,il,i)+dx_tmp=',xt(ixt,il,i)+dx_tmp
	4398	write(,) 'xt(ixt,il,i)+fxt(ixt,il,i)*delt=', &
	4399	& xt(ixt,il,i)+fxt(ixt,il,i)*delt
	4400	write(,) 'fxt(:,il,i)=',fxt(:,il,i)
	4401	endif !if (ixt.eq.iso_HDO) then
	4402	#endif
	4403	enddo ! do ixt = 1, ntraciso
	4404	#ifdef DIAGISO
	4405	do ixt = 1, niso
	4406	fxt_fluxmasse(ixt,il,i)=fxt(ixt,il,i)
	4407	enddo
	4408	#endif
	4409	else !if (dq_tmp/rr(il,i).lt.-0.9) then
	4410	! ancienne formulation
	4411	do ixt = 1, ntraciso
	4412	fxt(ixt,il,i)= &
	4413	& 0.01gravdpinv(amp1(il)(xt(ixt,il,i+1)-xt(ixt,il,i)) &
	4414	& -ad(il)*(xt(ixt,il,i)-xt(ixt,il,i-1)))
	4415	enddo
	4416	#ifdef DIAGISO
	4417	do ixt = 1, niso
	4418	fxt_fluxmasse(ixt,il,i)=fxt_fluxmasse(ixt,il,i)+ &
	4419	& 0.01gravdpinv(amp1(il)(xt(ixt,il,i+1)-xt(ixt,il,i)) &
	4420	& -ad(il)*(xt(ixt,il,i)-xt(ixt,il,i-1)))
	4421	enddo
	4422	#endif
	4423	endif !if (dq_tmp/rr(il,i).lt.-0.9) then
	4424
	4425
	4426	! cam verif
	4427	#ifdef ISOVERIF
	4428	if (iso_eau.gt.0) then
	4429	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	4430	& fr(il,i),'cv30_routines 3226',errmax,errmaxrel)
	4431	endif !if (iso_eau.gt.0) then
	4432	do ixt=1,niso
	4433	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229')
	4434	enddo
	4435	if ((iso_HDO.gt.0).and. &
	4436	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4437	call iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
	4438	& +delt*fxt(iso_HDO,il,i)) &
	4439	& /(rr(il,i)+delt*fr(il,i)), &
	4440	& 'cv30_yield 3384, flux masse')
	4441	endif !if (iso_HDO.gt.0) then
	4442	if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
	4443	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4444	call iso_verif_O18_aberrant( &
	4445	& (xt(iso_HDO,il,i)+deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	4446	& (xt(iso_O18,il,i)+deltfxt(iso_O18,il,i))/(rr(il,i)+deltfr(il,i)), &
	4447	& 'cv30_yield 3384,O18, flux masse')
	4448	endif !if (iso_HDO.gt.0) then
	4449	#ifdef ISOTRAC
	4450	call iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3626')
	4451	do ixt=1,ntraciso
	4452	xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
	4453	enddo
	4454	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3727',1e-5) &
	4455	& .eq.1) then
	4456	write(,) 'il,i=',il,i
	4457	write(,) 'fxt(:,il,i)=',fxt(:,il,i)
	4458	write(,) 'amp1(il),ad(il),fac=', &
	4459	& amp1(il),ad(il),0.01gravdpinv
	4460	write(,) 'xt(:,il,i+1)=' ,xt(:,il,i+1)
	4461	write(,) 'xt(:,il,i)=' ,xt(:,il,i)
	4462	write(,) 'xt(:,il,i-1)=' ,xt(:,il,i-1)
	4463	! stop
	4464	endif
	4465	#endif
	4466	#endif
	4467	! end cam verif
	4468	#endif
	4469	ELSE ! cvflag_grav
	4470	fr(il, i) = 0.1dpinv(amp1(il)*(rr(il,i+1)-rr(il, &
	4471	i))-ad(il)*(rr(il,i)-rr(il,i-1)))
	4472	fu(il, i) = fu(il, i) + 0.1dpinv(amp1(il)*(u(il,i+1)-u(il, &
	4473	i))-ad(il)*(u(il,i)-u(il,i-1)))
	4474	fv(il, i) = fv(il, i) + 0.1dpinv(amp1(il)*(v(il,i+1)-v(il, &
	4475	i))-ad(il)*(v(il,i)-v(il,i-1)))
	4476
	4477	#ifdef ISO
	4478	do ixt = 1, ntraciso
	4479	fxt(ixt,il,i)= &
	4480	& 0.1dpinv(amp1(il)*(xt(ixt,il,i+1)-xt(ixt,il,i)) &
	4481	& -ad(il)*(xt(ixt,il,i)-xt(ixt,il,i-1)))
	4482	enddo
	4483
	4484	#ifdef DIAGISO
	4485	fq_fluxmasse(il,i)=fq_fluxmasse(il,i) &
	4486	& +0.1dpinv(amp1(il)*(rr(il,i+1)-rr(il,i)) &
	4487	& -ad(il)*(rr(il,i)-rr(il,i-1)))
	4488	Amp_diag(il,i)=Amp_diag(il,i)+amp1(il)-ad(il)
	4489	! write(,) 'pgm 3817: il,i,Amp_diag(il,i)=',il,i,Amp_diag(il,i)
	4490	! modif 2 fev: pour avoir subsidence compensatoire totale, on retranche
	4491	! ad.
	4492	do ixt = 1, niso
	4493	fxt_fluxmasse(ixt,il,i)=fxt_fluxmasse(ixt,il,i)+ &
	4494	& 0.1dpinv(amp1(il)*(xt(ixt,il,i+1)-xt(ixt,il,i)) &
	4495	& -ad(il)*(xt(ixt,il,i)-xt(ixt,il,i-1)))
	4496	enddo
	4497	#endif
	4498
	4499	! cam verif
	4500	#ifdef ISOVERIF
	4501	if (iso_eau.gt.0) then
	4502	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	4503	& fr(il,i),'cv30_routines 3252',errmax,errmaxrel)
	4504	endif !if (iso_eau.gt.0) then
	4505	do ixt=1,niso
	4506	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229')
	4507	enddo
	4508	! correction 21 oct 2008
	4509	if ((iso_HDO.gt.0).and. &
	4510	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4511	call iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
	4512	& +deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	4513	& 'cv30_yield 3384b flux masse')
	4514	if (iso_O18.gt.0) then
	4515	call iso_verif_O18_aberrant( &
	4516	& (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
	4517	& /(rr(il,i)+delt*fr(il,i)), &
	4518	& (xt(iso_O18,il,i)+delt*fxt(iso_O18,il,i)) &
	4519	& /(rr(il,i)+delt*fr(il,i)), &
	4520	& 'cv30_yield 3384bO18 flux masse')
	4521	endif !if (iso_O18.gt.0) then
	4522	endif !if (iso_HDO.gt.0) then
	4523	#ifdef ISOTRAC
	4524	call iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3674')
	4525	do ixt=1,ntraciso
	4526	xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
	4527	enddo
	4528	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3775',1e-5) &
	4529	& .eq.1) then
	4530	write(,) 'il,i=',il,i
	4531	endif
	4532	#endif
	4533	#endif
	4534	! end cam verif
	4535	#endif
	4536	END IF ! cvflag_grav
	4537
	4538	END IF ! i
	4539	END DO
	4540
	4541	! do k=1,ntra
	4542	! do il=1,ncum
	4543	! if (i.le.inb(il)) then
	4544	! dpinv=1.0/(ph(il,i)-ph(il,i+1))
	4545	! cpinv=1.0/cpn(il,i)
	4546	! if (cvflag_grav) then
	4547	! ftra(il,i,k)=ftra(il,i,k)+0.01gravdpinv
	4548	! : (amp1(il)(tra(il,i+1,k)-tra(il,i,k))
	4549	! : -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
	4550	! else
	4551	! ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
	4552	! : (amp1(il)(tra(il,i+1,k)-tra(il,i,k))
	4553	! : -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
	4554	! endif
	4555	! endif
	4556	! enddo
	4557	! enddo
	4558
	4559	DO k = 1, i - 1
	4560	DO il = 1, ncum
	4561	IF (i<=inb(il)) THEN
	4562	dpinv = 1.0/(ph(il,i)-ph(il,i+1))
	4563	cpinv = 1.0/cpn(il, i)
	4564
	4565	awat = elij(il, k, i) - (1.-ep(il,i))*clw(il, i)
	4566	awat = amax1(awat, 0.0)
	4567
	4568	#ifdef ISO
	4569	! on change le traitement de cette ligne le 8 mai 2009:
	4570	! avant, on avait: xtawat=xtelij(il,k,i)-(1.-xtep(il,i))*xtclw(il,i)
	4571	! c'est à dire que Rawat=Relij+(1-ep)clw/awat(Relij-Rclw)
	4572	! si Relij!=Rclw, alors un fractionnement isotopique non physique était
	4573	! introduit.
	4574	! En fait, awat représente le surplus de condensat dans le mélange par
	4575	! rapport à celui restant dans la colonne adiabatique
	4576	! ce surplus à la même compo que le elij, sans fractionnement.
	4577	! d'où le nouveau traitement ci-dessous.
	4578	if (elij(il,k,i).gt.0.0) then
	4579	do ixt = 1, ntraciso
	4580	xtawat(ixt)=awat*(xtelij(ixt,il,k,i)/elij(il,k,i))
	4581	! xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas nécessaire
	4582	enddo
	4583	else !if (elij(il,k,i).gt.0.0) then
	4584	! normalement, si elij(il,k,i)<=0, alors awat=0
	4585	! on le vérifie. Si c'est vrai -> xtawat=0 aussi
	4586	#ifdef ISOVERIF
	4587	call iso_verif_egalite(awat,0.0,'cv30_yield 3779')
	4588	#endif
	4589	do ixt = 1, ntraciso
	4590	xtawat(ixt)=0.0
	4591	enddo
	4592	endif
	4593
	4594	! cam verif
	4595	#ifdef ISOVERIF
	4596	if (iso_eau.gt.0) then
	4597	call iso_verif_egalite_choix(xtawat(iso_eau), &
	4598	& awat,'cv30_routines 3301',errmax,errmaxrel)
	4599	endif !if (iso_eau.gt.0) then
	4600	#ifdef ISOTRAC
	4601	call iso_verif_traceur_justmass(xtawat(1),'cv30_routine 3729')
	4602	#endif
	4603	#endif
	4604	! end cam verif
	4605	#endif
	4606
	4607	IF (cvflag_grav) THEN
	4608	fr(il, i) = fr(il, i) + 0.01gravdpinvment(il, k, i)(qent(il,k &
	4609	,i)-awat-rr(il,i))
	4610	fu(il, i) = fu(il, i) + 0.01gravdpinvment(il, k, i)(uent(il,k &
	4611	,i)-u(il,i))
	4612	fv(il, i) = fv(il, i) + 0.01gravdpinvment(il, k, i)(vent(il,k &
	4613	,i)-v(il,i))
	4614
	4615	#ifdef ISO
	4616	do ixt = 1, ntraciso
	4617	fxt(ixt,il,i)=fxt(ixt,il,i) &
	4618	& +0.01gravdpinv*ment(il,k,i) &
	4619	& *(xtent(ixt,il,k,i)-xtawat(ixt)-xt(ixt,il,i))
	4620	enddo
	4621
	4622	#ifdef DIAGISO
	4623	fq_detrainement(il,i)=fq_detrainement(il,i) &
	4624	& +0.01gravdpinv*ment(il,k,i) &
	4625	& *(qent(il,k,i)-awat-rr(il,i))
	4626	f_detrainement(il,i)=f_detrainement(il,i)&
	4627	& +0.01gravdpinv*ment(il,k,i)
	4628	q_detrainement(il,i)=q_detrainement(il,i) &
	4629	& +0.01gravdpinvment(il,k,i)qent(il,k,i)
	4630	do ixt = 1, niso
	4631	fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
	4632	& +0.01gravdpinv*ment(il,k,i) &
	4633	& *(xtent(ixt,il,k,i)-xtawat(ixt)-xt(ixt,il,i))
	4634	xt_detrainement(ixt,il,i)=xt_detrainement(ixt,il,i) &
	4635	& +0.01gravdpinvment(il,k,i)xtent(ixt,il,k,i)
	4636	enddo
	4637	#endif
	4638	! cam verif
	4639	#ifdef ISOVERIF
	4640	if (iso_eau.gt.0) then
	4641	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	4642	& fr(il,i),'cv30_routines 3325',errmax,errmaxrel)
	4643	endif !if (iso_eau.gt.0) then
	4644	do ixt=1,niso
	4645	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3328')
	4646	enddo
	4647	if ((iso_HDO.gt.0).and. &
	4648	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4649	if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
	4650	& +delt*fxt(iso_HDO,il,i)) &
	4651	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3396a, dtr mels') &
	4652	& .eq.1) then
	4653	write(,) 'il,k,i=',il,k,i
	4654	write(,) 'rr,delt,fr=',rr(il,i),delt,fr(il,i)
	4655	write(,) 'frnew=',0.01gravdpinvment(il, k, i)(qent(il,k,i)-awat-rr(il,i))
	4656	write(,) 'frold=',fr(il,i)-0.01gravdpinvment(il, k, i)(qent(il,k,i)-awat-rr(il,i))
	4657	write(,) 'deltaDfrnew=',deltaD((xtent(iso_HDO,il,k,i)-xtawat(iso_HDO)-xt(iso_HDO,il,i)) &
	4658	/(qent(il,k,i)-awat-rr(il,i)))
	4659	write(,) 'deltaDfrold=',deltaD((fxt(iso_HDO,il,i) &
	4660	-0.01gravdpinvment(il, k, i)(xtent(iso_HDO,il,k,i)-xtawat(iso_HDO)-xt(iso_HDO,il,i))) &
	4661	/(fr(il,i)-0.01gravdpinvment(il, k, i)(qent(il,k,i)-awat-rr(il,i))))
	4662	write(,) 'q+=',rr(il,i)+delt*fr(il,i)
	4663	write(,) 'qent,awat=',qent(il,k,i),awat
	4664	write(,) 'elij,clw,ep=',elij(il,k,i),clw(il,i),ep(il,i)
	4665	write(,) 'deltaDfr=',deltaD(fxt(iso_hdo,il,i)/fr(il,i))
	4666	write(,) 'deltaDrr=',deltaD(xt(iso_hdo,il,i)/rr(il,i))
	4667	write(,) 'deltaDqent=',deltaD(xtent(iso_hdo,il,k,i) &
	4668	& /qent(il,k,i))
	4669	write(,) 'deltaDqent-awat=',deltaD((xtent(iso_hdo,il,k,i)-xtawat(iso_HDO)) &
	4670	& /(qent(il,k,i)-awat))
	4671	write(,) 'deltaDawat=',deltaD(xtawat(iso_hdo)/awat)
	4672	write(,) 'deltaDclw=',deltaD(xtclw(iso_hdo,il,i)/clw(il,i))
	4673	! stop
	4674	endif
	4675	if (iso_O18.gt.0) then
	4676	call iso_verif_O18_aberrant( &
	4677	& (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
	4678	& /(rr(il,i)+delt*fr(il,i)), &
	4679	& (xt(iso_O18,il,i)+delt*fxt(iso_O18,il,i)) &
	4680	& /(rr(il,i)+delt*fr(il,i)), &
	4681	& 'cv30_yield 3396aO18, dtr mels')
	4682	endif !if (iso_O18.gt.0) then
	4683	endif !if (iso_HDO.gt.0) then
	4684	#ifdef ISOTRAC
	4685	call iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3784')
	4686	do ixt=1,ntraciso
	4687	xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
	4688	enddo
	4689	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3905',1e-5) &
	4690	& .eq.1) then
	4691	write(,) 'il,i=',il,i
	4692	endif
	4693	! call iso_verif_tracpos_choix(xtnew,'cv30_yield 3905',1e-5)
	4694	#endif
	4695	#endif
	4696	#endif
	4697	ELSE ! cvflag_grav
	4698	fr(il, i) = fr(il, i) + 0.1dpinvment(il, k, i)*(qent(il,k,i)- &
	4699	awat-rr(il,i))
	4700	fu(il, i) = fu(il, i) + 0.01gravdpinvment(il, k, i)(uent(il,k &
	4701	,i)-u(il,i))
	4702	fv(il, i) = fv(il, i) + 0.1dpinvment(il, k, i)*(vent(il,k,i)-v( &
	4703	il,i))
	4704
	4705	#ifdef ISO
	4706	do ixt = 1, ntraciso
	4707	fxt(ixt,il,i)=fxt(ixt,il,i) &
	4708	& +0.1dpinvment(il,k,i) &
	4709	& *(xtent(ixt,il,k,i)-xtawat(ixt)-xt(ixt,il,i))
	4710	enddo
	4711
	4712	#ifdef DIAGISO
	4713	fq_detrainement(il,i)=fq_detrainement(il,i) &
	4714	& +0.1dpinvment(il,k,i)*(qent(il,k,i)-awat-rr(il,i))
	4715	f_detrainement(il,i)=f_detrainement(il,i) &
	4716	& +0.1dpinvment(il,k,i)
	4717	q_detrainement(il,i)=q_detrainement(il,i) &
	4718	& +0.1dpinvment(il,k,i)*qent(il,k,i)
	4719	do ixt = 1, niso
	4720	fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
	4721	& +0.1dpinvment(il,k,i) &
	4722	& *(xtent(ixt,il,k,i)-xtawat(ixt)-xt(ixt,il,i))
	4723	xt_detrainement(ixt,il,i)=xt_detrainement(ixt,il,i) &
	4724	& +0.1dpinvment(il,k,i)*xtent(ixt,il,k,i)
	4725	enddo
	4726	#endif
	4727
	4728	! cam verif
	4729	#ifdef ISOVERIF
	4730	if (iso_eau.gt.0) then
	4731	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	4732	& fr(il,i),'cv30_routines 3350',errmax,errmaxrel)
	4733	endif !if (iso_eau.gt.0) then
	4734	do ixt=1,niso
	4735	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3353')
	4736	enddo
	4737	if ((iso_HDO.gt.0).and. &
	4738	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4739	call iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
	4740	& +delt*fxt(iso_HDO,il,i)) &
	4741	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3396b, dtr mels')
	4742	endif !if (iso_HDO.gt.0) then
	4743	if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
	4744	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4745	call iso_verif_O18_aberrant( &
	4746	& (xt(iso_HDO,il,i)+deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	4747	& (xt(iso_O18,il,i)+deltfxt(iso_O18,il,i))/(rr(il,i)+deltfr(il,i)), &
	4748	& 'cv30_yield 3396b,O18, dtr mels')
	4749	endif !if (iso_HDO.gt.0) then
	4750	#ifdef ISOTRAC
	4751	call iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3828')
	4752	do ixt=1,ntraciso
	4753	xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
	4754	enddo
	4755	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3949',1e-5) &
	4756	& .eq.1) then
	4757	write(,) 'il,i=',il,i
	4758	endif
	4759	! call iso_verif_tracpos_choix(xtnew,'cv30_yield 3949',1e-5)
	4760	#endif
	4761	#endif
	4762	! end cam verif
	4763	#endif
	4764
	4765	END IF ! cvflag_grav
	4766
	4767	! (saturated updrafts resulting from mixing) ! cld
	4768	qcond(il, i) = qcond(il, i) + (elij(il,k,i)-awat) ! cld
	4769	nqcond(il, i) = nqcond(il, i) + 1. ! cld
	4770	END IF ! i
	4771	END DO
	4772	END DO
	4773
	4774	! do j=1,ntra
	4775	! do k=1,i-1
	4776	! do il=1,ncum
	4777	! if (i.le.inb(il)) then
	4778	! dpinv=1.0/(ph(il,i)-ph(il,i+1))
	4779	! cpinv=1.0/cpn(il,i)
	4780	! if (cvflag_grav) then
	4781	! ftra(il,i,j)=ftra(il,i,j)+0.01gravdpinv*ment(il,k,i)
	4782	! : *(traent(il,k,i,j)-tra(il,i,j))
	4783	! else
	4784	! ftra(il,i,j)=ftra(il,i,j)+0.1dpinvment(il,k,i)
	4785	! : *(traent(il,k,i,j)-tra(il,i,j))
	4786	! endif
	4787	! endif
	4788	! enddo
	4789	! enddo
	4790	! enddo
	4791
	4792	DO k = i, nl + 1
	4793	DO il = 1, ncum
	4794	IF (i<=inb(il) .AND. k<=inb(il)) THEN
	4795	dpinv = 1.0/(ph(il,i)-ph(il,i+1))
	4796	cpinv = 1.0/cpn(il, i)
	4797
	4798	IF (cvflag_grav) THEN
	4799	fr(il, i) = fr(il, i) + 0.01gravdpinvment(il, k, i)(qent(il,k &
	4800	,i)-rr(il,i))
	4801	fu(il, i) = fu(il, i) + 0.01gravdpinvment(il, k, i)(uent(il,k &
	4802	,i)-u(il,i))
	4803	fv(il, i) = fv(il, i) + 0.01gravdpinvment(il, k, i)(vent(il,k &
	4804	,i)-v(il,i))
	4805	#ifdef ISO
	4806	do ixt = 1, ntraciso
	4807	fxt(ixt,il,i)=fxt(ixt,il,i) &
	4808	& +0.01gravdpinvment(il,k,i)(xtent(ixt,il,k,i)-xt(ixt,il,i))
	4809	enddo
	4810
	4811	#ifdef DIAGISO
	4812	fq_detrainement(il,i)=fq_detrainement(il,i) &
	4813	& +0.01gravdpinvment(il,k,i)(qent(il,k,i)-rr(il,i))
	4814	f_detrainement(il,i)=f_detrainement(il,i) &
	4815	& +0.01gravdpinv*ment(il,k,i)
	4816	q_detrainement(il,i)=q_detrainement(il,i) &
	4817	& +0.01gravdpinvment(il,k,i)qent(il,k,i)
	4818	do ixt = 1, niso
	4819	fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
	4820	& +0.01gravdpinvment(il,k,i)(xtent(ixt,il,k,i)-xt(ixt,il,i))
	4821	xt_detrainement(ixt,il,i)=xt_detrainement(ixt,il,i) &
	4822	& +0.01gravdpinvment(il,k,i)xtent(ixt,il,k,i)
	4823	enddo
	4824	#endif
	4825
	4826	! cam verif
	4827	#ifdef ISOVERIF
	4828	if ((il.eq.1636).and.(i.eq.9)) then
	4829	write(,) 'cv30 4785: on ajoute le dtr ici:'
	4830	write(,) 'M=',0.01gravdpinv*ment(il, k, i)
	4831	write(,) 'q,qe=',rr(il,i),qent(il,k,i)
	4832	bx=0.01gravdpinvment(il,k,i)(qent(il,k,i)-rr(il,i))
	4833	do ixt=1,niso
	4834	xtbx(ixt)=0.01gravdpinvment(il,k,i)(xtent(ixt,il,k,i)-xt(ixt,il,i))
	4835	enddo
	4836	endif
	4837	do ixt=1,niso
	4838	call iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 4351')
	4839	enddo
	4840	#endif
	4841	#ifdef ISOVERIF
	4842	if (iso_eau.gt.0) then
	4843	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	4844	& fr(il,i),'cv30_routines 3408',errmax,errmaxrel)
	4845	endif !if (iso_eau.gt.0) then
	4846	do ixt=1,niso
	4847	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3411')
	4848	enddo
	4849	if (1.eq.0) then
	4850	if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) then
	4851	if (iso_verif_aberrant_enc_nostop( &
	4852	& fxt(iso_HDO,il,i)/fr(il,i), &
	4853	& 'cv30_yield 3572, dtr mels').eq.1) then
	4854	write(,) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
	4855	write(,) 'fr(il,i)=',fr(il,i)
	4856	! if (fr(il,i).gt.ridicule*1e5) then
	4857	! stop
	4858	! endif
	4859	endif
	4860	endif !if (iso_HDO.gt.0) then
	4861	endif !if (1.eq.0) then
	4862	if ((iso_HDO.gt.0).and. &
	4863	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4864	call iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
	4865	& +delt*fxt(iso_HDO,il,i)) &
	4866	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3605, dtr mels')
	4867	if (iso_O18.gt.0) then
	4868	call iso_verif_O18_aberrant( &
	4869	& (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
	4870	& /(rr(il,i)+delt*fr(il,i)), &
	4871	& (xt(iso_O18,il,i)+delt*fxt(iso_O18,il,i)) &
	4872	& /(rr(il,i)+delt*fr(il,i)), &
	4873	& 'cv30_yield 3605O18, dtr mels')
	4874	if ((il.eq.1636).and.(i.eq.9)) then
	4875	call iso_verif_O18_aberrant( &
	4876	& (xt(iso_HDO,il,i)+delt*(fxt(iso_HDO,il,i)-xtbx(iso_HDO))) &
	4877	& /(rr(il,i)+delt*(fr(il,i)-bx)), &
	4878	& (xt(iso_O18,il,i)+delt*(fxt(iso_O18,il,i)-xtbx(iso_O18))) &
	4879	& /(rr(il,i)+delt*(fr(il,i)-bx)), &
	4880	& 'cv30_yield 3605O18_nobx, dtr mels')
	4881	endif !if ((il.eq.1636).and.(i.eq.9)) then
	4882	endif !if (iso_O18.gt.0) then
	4883	endif !if (iso_HDO.gt.0) then
	4884	#ifdef ISOTRAC
	4885	call iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3921')
	4886	do ixt=1,ntraciso
	4887	xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
	4888	enddo
	4889	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4036',1e-5) &
	4890	& .eq.1) then
	4891	write(,) 'il,i=',il,i
	4892	endif
	4893	! call iso_verif_tracpos_choix(xtnew,'cv30_yield 4036',1e-5)
	4894	#endif
	4895	#endif
	4896	! end cam verif
	4897	#endif
	4898	ELSE ! cvflag_grav
	4899	fr(il, i) = fr(il, i) + 0.1dpinvment(il, k, i)*(qent(il,k,i)-rr &
	4900	(il,i))
	4901	fu(il, i) = fu(il, i) + 0.1dpinvment(il, k, i)*(uent(il,k,i)-u( &
	4902	il,i))
	4903	fv(il, i) = fv(il, i) + 0.1dpinvment(il, k, i)*(vent(il,k,i)-v( &
	4904	il,i))
	4905
	4906	#ifdef ISO
	4907	do ixt = 1, ntraciso
	4908	fxt(ixt,il,i)=fxt(ixt,il,i) &
	4909	& +0.1dpinvment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
	4910	enddo
	4911
	4912	#ifdef DIAGISO
	4913	fq_detrainement(il,i)=fq_detrainement(il,i) &
	4914	& +0.1dpinvment(il,k,i)*(qent(il,k,i)-rr(il,i))
	4915	f_detrainement(il,i)=f_detrainement(il,i) &
	4916	& +0.1dpinvment(il,k,i)
	4917	q_detrainement(il,i)=q_detrainement(il,i) &
	4918	& +0.1dpinvment(il,k,i)*qent(il,k,i)
	4919	do ixt = 1, niso
	4920	fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
	4921	& +0.1dpinvment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
	4922	xt_detrainement(ixt,il,i)=xt_detrainement(ixt,il,i) &
	4923	& +0.1dpinvment(il,k,i)*xtent(ixt,il,k,i)
	4924	enddo
	4925	#endif
	4926
	4927	! cam verif
	4928	#ifdef ISOVERIF
	4929	if ((il.eq.1636).and.(i.eq.9)) then
	4930	write(,) 'cv30 4785b: on ajoute le dtr ici:'
	4931	write(,) 'M=',0.1dpinvment(il, k, i)
	4932	write(,) 'q,qe=',rr(il,i),qent(il,k,i)
	4933	endif
	4934	if (iso_eau.gt.0) then
	4935	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	4936	& fr(il,i),'cv30_routines 3433',errmax,errmaxrel)
	4937	endif !if (iso_eau.gt.0) then
	4938	do ixt=1,niso
	4939	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3436')
	4940	enddo
	4941	if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) then
	4942	if (iso_verif_aberrant_enc_nostop( &
	4943	& fxt(iso_HDO,il,i)/fr(il,i), &
	4944	& 'cv30_yield 3597').eq.1) then
	4945	write(,) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
	4946	stop
	4947	endif
	4948	endif !if (iso_HDO.gt.0) then
	4949	if ((iso_HDO.gt.0).and. &
	4950	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	4951	call iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
	4952	& +delt*fxt(iso_HDO,il,i)) &
	4953	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3605b, dtr mels')
	4954	endif !if (iso_HDO.gt.0) then
	4955	#ifdef ISOTRAC
	4956	call iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3972')
	4957	do ixt=1,ntraciso
	4958	xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
	4959	enddo
	4960	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4091',1e-5) &
	4961	& .eq.1) then
	4962	write(,) 'il,i=',il,i
	4963	endif
	4964	! call iso_verif_tracpos_choix(xtnew,'cv30_yield 4091',1e-5)
	4965	#endif
	4966	#endif
	4967	! end cam verif
	4968	#endif
	4969	END IF ! cvflag_grav
	4970	END IF ! i and k
	4971	END DO
	4972	END DO
	4973
	4974	! do j=1,ntra
	4975	! do k=i,nl+1
	4976	! do il=1,ncum
	4977	! if (i.le.inb(il) .and. k.le.inb(il)) then
	4978	! dpinv=1.0/(ph(il,i)-ph(il,i+1))
	4979	! cpinv=1.0/cpn(il,i)
	4980	! if (cvflag_grav) then
	4981	! ftra(il,i,j)=ftra(il,i,j)+0.01gravdpinv*ment(il,k,i)
	4982	! : *(traent(il,k,i,j)-tra(il,i,j))
	4983	! else
	4984	! ftra(il,i,j)=ftra(il,i,j)+0.1dpinvment(il,k,i)
	4985	! : *(traent(il,k,i,j)-tra(il,i,j))
	4986	! endif
	4987	! endif ! i and k
	4988	! enddo
	4989	! enddo
	4990	! enddo
	4991
	4992	DO il = 1, ncum
	4993	IF (i<=inb(il)) THEN
	4994	dpinv = 1.0/(ph(il,i)-ph(il,i+1))
	4995	cpinv = 1.0/cpn(il, i)
	4996
	4997	IF (cvflag_grav) THEN
	4998	! sb: on ne fait pas encore la correction permettant de mieux
	4999	! conserver l'eau:
	5000	fr(il, i) = fr(il, i) + 0.5sigd(evap(il,i)+evap(il,i+1)) + &
	5001	0.01grav(mp(il,i+1)(rp(il,i+1)-rr(il,i))-mp(il,i)(rp(il, &
	5002	i)-rr(il,i-1)))*dpinv
	5003
	5004	fu(il, i) = fu(il, i) + 0.01grav(mp(il,i+1)*(up(il,i+1)-u(il, &
	5005	i))-mp(il,i)(up(il,i)-u(il,i-1)))dpinv
	5006	fv(il, i) = fv(il, i) + 0.01grav(mp(il,i+1)*(vp(il,i+1)-v(il, &
	5007	i))-mp(il,i)(vp(il,i)-v(il,i-1)))dpinv
	5008	#ifdef ISO
	5009	do ixt = 1, niso
	5010	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5011	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
	5012	& +0.01grav(mp(il,i+1)*(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
	5013	& -mp(il,i) &
	5014	& (xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5015	enddo
	5016
	5017	#ifdef DIAGISO
	5018	fq_evapprecip(il,i)=fq_evapprecip(il,i) &
	5019	& +0.5sigd(evap(il,i)+evap(il,i+1))
	5020	fq_ddft(il,i)=fq_ddft(il,i) &
	5021	& +0.01grav(mp(il,i+1)*(rp(il,i+1)-rr(il,i))-mp(il,i) &
	5022	& (rp(il,i)-rr(il,i-1)))dpinv
	5023	do ixt = 1, niso
	5024	fxt_evapprecip(ixt,il,i)=fxt_evapprecip(ixt,il,i) &
	5025	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
	5026	fxt_ddft(ixt,il,i)=fxt_ddft(ixt,il,i) &
	5027	& +0.01grav(mp(il,i+1)*(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
	5028	& -mp(il,i)(xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5029	enddo
	5030	#endif
	5031
	5032	#ifdef ISOVERIF
	5033	do ixt=1,niso
	5034	call iso_verif_noNaN(xt(ixt,il,i),'cv30_yield 4514')
	5035	call iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 4515')
	5036	enddo
	5037	if ((iso_HDO.gt.0).and. &
	5038	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5039	if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
	5040	& +delt*fxt(iso_HDO,il,i)) &
	5041	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 4175') &
	5042	& .eq.1) then
	5043	write(,) 'il,i=',il,i
	5044	if (rr(il,i).ne.0.0) then
	5045	write(,) 'il,i,rr,deltaD=',il,i,rr(il,i),deltaD &
	5046	& (xt(iso_HDO,il,i)/rr(il,i))
	5047	endif
	5048	if (fr(il,i).ne.0.0) then
	5049	write(,) 'fr,fxt,deltaD=',fr(il,i),fxt(iso_HDO,il,i), &
	5050	& deltaD(fxt(iso_HDO,il,i)/fr(il,i))
	5051	endif
	5052	#ifdef DIAGISO
	5053	if (fq_ddft(il,i).ne.0.0) then
	5054	write(,) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
	5055	& fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i))
	5056	endif
	5057	if (fq_evapprecip(il,i).ne.0.0) then
	5058	write(,) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i),deltaD( &
	5059	& fxt_evapprecip(iso_HDO,il,i)/fq_evapprecip(il,i))
	5060	endif
	5061	#endif
	5062	write(,) 'sigd,evap(il,i),evap(il,i+1)=', &
	5063	& sigd,evap(il,i),evap(il,i+1)
	5064	write(,) 'xtevap(iso_HDO,il,i),xtevap(iso_HDO,il,i+1)=', &
	5065	& xtevap(iso_HDO,il,i),xtevap(iso_HDO,il,i+1)
	5066	write(,) 'grav,mp(il,i+1),mp(il,i),dpinv=', &
	5067	& grav,mp(il,i+1),mp(il,i),dpinv
	5068	write(,) 'rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)=', &
	5069	& rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)
	5070	write(,) 'xtp(il,i+1),xt(il,i),xtp(il,i),xt(il,i-1)=', &
	5071	& xtp(iso_HDO,il,i+1),xt(iso_HDO,il,i), &
	5072	& xtp(iso_HDO,il,i),xt(iso_HDO,il,i-1)
	5073	stop
	5074	endif
	5075	endif !if (iso_HDO.gt.0) then
	5076	if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
	5077	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5078	call iso_verif_O18_aberrant( &
	5079	& (xt(iso_HDO,il,i)+deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	5080	& (xt(iso_O18,il,i)+deltfxt(iso_O18,il,i))/(rr(il,i)+deltfr(il,i)), &
	5081	& 'cv30_yield 5029,O18, evap')
	5082	if ((il.eq.1636).and.(i.eq.9)) then
	5083	write(,) 'cv30_yield 5057: ici, on vérifie deltaD_nobx'
	5084	write(,) 'il,i=',il,i
	5085	write(,) 'fr(il,i),bx,fr(il,i)-bx=',fr(il,i),bx,fr(il,i)-bx
	5086	write(,) 'q,q+=',rr(il,i),rr(il,i)+delt*(fr(il,i)-bx)
	5087	write(,) 'deltaD,deltaD+=',deltaD(xt(iso_HDO,il,inb(il))/rr(il,inb(il))), &
	5088	& deltaD( (xt(iso_HDO,il,i)+delt(fxt(iso_HDO,il,i)-xtbx(iso_HDO)))/(rr(il,i)+delt(fr(il,i)-bx)))
	5089	write(,) 'deltaO18,deltaO18+=',deltaO(xt(iso_O18,il,inb(il))/rr(il,inb(il))), &
	5090	& deltaO( (xt(iso_O18,il,i)+delt(fxt(iso_O18,il,i)-xtbx(iso_O18)))/(rr(il,i)+delt(fr(il,i)-bx)))
	5091	call iso_verif_O18_aberrant( &
	5092	& (xt(iso_HDO,il,i)+delt*(fxt(iso_HDO,il,i)-xtbx(iso_HDO))) &
	5093	& /(rr(il,i)+delt*(fr(il,i)-bx)), &
	5094	& (xt(iso_O18,il,i)+delt*(fxt(iso_O18,il,i)-xtbx(iso_O18))) &
	5095	& /(rr(il,i)+delt*(fr(il,i)-bx)), &
	5096	& 'cv30_yield 5029_nobx,O18, evap, no bx')
	5097	endif !if ((il.eq.1636).and.(i.eq.9)) then
	5098	endif !if (iso_HDO.gt.0) then
	5099	#endif
	5100
	5101	#ifdef ISOTRAC
	5102	if ((option_traceurs.ne.6).and.(option_traceurs.ne.19)) then
	5103
	5104	! facile: on fait comme l'eau
	5105	do ixt = 1+niso,ntraciso
	5106	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5107	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
	5108	& +0.01grav(mp(il,i+1)*(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
	5109	& -mp(il,i)(xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5110	enddo !do ixt = 1+niso,ntraciso
	5111
	5112	else ! taggage des ddfts:
	5113	! la formule pour fq_ddft suppose que le ddft est en RP. Ce n'est pas le
	5114	! cas pour le water tagging puisqu'il y a conversion des molécules
	5115	! blances entrainées en molécule rouges.
	5116	! Il faut donc prendre en compte ce taux de conversion quand
	5117	! entrainement d'env vers ddft
	5118	! conversion(iiso)=0.01gravdpinv
	5119	! : (mp(il,i)-mp(il,i+1))xt(ixt_poubelle,il,i)
	5120	! fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+conversion(iiso)
	5121	! fxt(ixt_poubelle,il,i)=fxt(ixt_poubelle,il,i)
	5122	! : -conversion(iiso)
	5123
	5124	! Pb: quand on discretise, dqp/dt n'est pas vérifée numériquement.
	5125	! on se retrouve donc avec des d Ye/dt différents de 0 même si ye=0 ( on
	5126	! note X les molécules poubelles et Y les molécules ddfts).
	5127
	5128	! Solution alternative: Dans le cas entrainant, Ye ne varie que par
	5129	! ascendance compensatoire des ddfts et par perte de Ye vers le ddft. On
	5130	! calcule donc ce terme directement avec schéma amont:
	5131
	5132	! ajout déjà de l'évap
	5133	do ixt = 1+niso,ntraciso
	5134	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5135	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
	5136	enddo !do ixt = 1+niso,ntraciso
	5137
	5138	! ajout du terme des ddfts sensi stricto
	5139	! write(,) 'tmp cv3_yield 4165: i,il=',i,il
	5140	!
	5141	if (option_traceurs.eq.6) then
	5142	do iiso = 1, niso
	5143
	5144	ixt_ddft=index_trac(izone_ddft,iiso)
	5145	if (mp(il,i).gt.mp(il,i+1)) then
	5146	fxtYe(iiso)=0.01gravdpinv*mp(il,i) &
	5147	& *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
	5148	else !if (mp(il,i).gt.mp(il,i+1)) then
	5149	fxtYe(iiso)=0.01gravdpinv*(mp(il,i) &
	5150	& xt(ixt_ddft,il,i-1)-mp(il,i+1)xt(ixt_ddft,il,i) &
	5151	& +(mp(il,i+1)-mp(il,i))*xtp(ixt_ddft,il,i))
	5152	endif !if (mp(il,i).gt.mp(il,i+1)) then
	5153	fxtqe(iiso)=0.01gravdpinv* &
	5154	& (mp(il,i+1)*(xtp(iiso,il,i+1)-xt(iiso,il,i)) &
	5155	& -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
	5156
	5157	ixt_poubelle=index_trac(izone_poubelle,iiso)
	5158	fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso)
	5159	fxt(ixt_poubelle,il,i)=fxt(ixt_poubelle,il,i) &
	5160	& +fxtqe(iiso)-fxtYe(iiso)
	5161	enddo !do iiso = 1, niso
	5162
	5163	else !if (option_traceurs.eq.6) then
	5164
	5165
	5166	if (mp(il,i).gt.mp(il,i+1)) then
	5167	! cas entrainant: faire attention
	5168
	5169	do iiso = 1, niso
	5170	fxtqe(iiso)=0.01gravdpinv* &
	5171	& (mp(il,i+1)*(xtp(iiso,il,i+1)-xt(iiso,il,i)) &
	5172	& -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
	5173
	5174	ixt_ddft=index_trac(izone_ddft,iiso)
	5175	fxtYe(iiso)=0.01gravdpinv*mp(il,i) &
	5176	& *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
	5177	fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso)
	5178
	5179	ixt_revap=index_trac(izone_revap,iiso)
	5180	fxt_revap(iiso)=0.01gravdpinv(mp(il,i+1) &
	5181	& (xtp(ixt_revap,il,i+1)-xt(ixt_revap,il,i)) &
	5182	& -mp(il,i)*(xtp(ixt_revap,il,i)-xt(ixt_revap,il,i-1)))
	5183	fxt(ixt_revap,il,i)=fxt(ixt_revap,il,i) &
	5184	& +fxt_revap(iiso)
	5185
	5186	fxtXe(iiso)=fxtqe(iiso)-fxtYe(iiso)-fxt_revap(iiso)
	5187	Xe(iiso)=xt(iiso,il,i) &
	5188	& -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
	5189	if (Xe(iiso).gt.ridicule) then
	5190	do izone=1,ntraceurs_zone
	5191	if ((izone.ne.izone_revap).and. &
	5192	& (izone.ne.izone_ddft)) then
	5193	ixt=index_trac(izone,iiso)
	5194	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5195	& +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso)
	5196	endif !if ((izone.ne.izone_revap).and.
	5197	enddo !do izone=1,ntraceurs_zone
	5198	#ifdef ISOVERIF
	5199	! write(,) 'iiso=',iiso
	5200	! write(,) 'fxtqe=',fxtqe(iiso)
	5201	! write(,) 'fxtYe=',fxtYe(iiso)
	5202	! write(,) 'fxt_revap=',fxt_revap(iiso)
	5203	! write(,) 'fxtXe=',fxtXe(iiso)
	5204	! write(,) 'Xe=',Xe(iiso)
	5205	! write(,) 'xt=',xt(:,il,i)
	5206	call iso_verif_traceur_justmass(fxt(1,il,i), &
	5207	& 'cv30_routine 4646')
	5208	#endif
	5209	else !if (abs(dXe).gt.ridicule) then
	5210	! dans ce cas, fxtXe doit être faible
	5211
	5212	#ifdef ISOVERIF
	5213	if (delt*fxtXe(iiso).gt.ridicule) then
	5214	write(,) 'cv30_routines 6563: delt*fxtXe(iiso)=', &
	5215	& delt*fxtXe(iiso)
	5216	stop
	5217	endif
	5218	#endif
	5219	do izone=1,ntraceurs_zone
	5220	if ((izone.ne.izone_revap).and. &
	5221	& (izone.ne.izone_ddft)) then
	5222	ixt=index_trac(izone,iiso)
	5223	if (izone.eq.izone_poubelle) then
	5224	fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
	5225	else !if (izone.eq.izone_poubelle) then
	5226	! pas de tendance pour ce tag là
	5227	endif !if (izone.eq.izone_poubelle) then
	5228	endif !if ((izone.ne.izone_revap).and.
	5229	enddo !do izone=1,ntraceurs_zone
	5230	#ifdef ISOVERIF
	5231	call iso_verif_traceur_justmass(fxt(1,il,i), &
	5232	& 'cv30_routine 4671')
	5233	#endif
	5234
	5235	endif !if (abs(dXe).gt.ridicule) then
	5236
	5237	enddo !do iiso = 1, niso
	5238
	5239	else !if (mp(il,i).gt.mp(il,i+1)) then
	5240	! cas détrainant: pas de problèmes
	5241	do ixt=1+niso,ntraciso
	5242	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5243	& +0.01grav(mp(il,i+1)*(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
	5244	& -mp(il,i)(xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5245	enddo !do ixt=1+niso,ntraciso
	5246	#ifdef ISOVERIF
	5247	call iso_verif_traceur_justmass(fxt(1,il,i), &
	5248	& 'cv30_routine 4685')
	5249	#endif
	5250	endif !if (mp(il,i).gt.mp(il,i+1)) then
	5251
	5252	endif !if (option_traceurs.eq.6) then
	5253
	5254	! write(,) 'deltconversion=',deltconversion(iso_eau)
	5255	! write(,) 'deltfxtYe=',deltfxtYe(iso_eau)
	5256	! write(,) 'deltfxtqe=',deltfxtqe(iso_eau)
	5257
	5258	endif ! if ((option_traceurs.ne.6).and.(option_traceurs.ne.19)) then
	5259	#endif
	5260
	5261	! cam verif
	5262	#ifdef ISOVERIF
	5263	do ixt=1,niso
	5264	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3496')
	5265	enddo
	5266	#endif
	5267	#ifdef ISOVERIF
	5268	if (iso_eau.gt.0) then
	5269	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	5270	& fr(il,i),'cv30_routines 3493',errmax,errmaxrel)
	5271	endif !if (iso_eau.gt.0) then
	5272	if (1.eq.0) then
	5273	if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) then
	5274	if (iso_verif_aberrant_enc_nostop( &
	5275	& fxt(iso_HDO,il,i)/fr(il,i), &
	5276	& 'cv30_yield 3662').eq.1) then
	5277	write(,) 'il,i,icb(il),inb(il)=',il,i,icb(il),inb(il)
	5278	write(,) 'fr(il,i),delt=',fr(il,i),delt
	5279	#ifdef DIAGISO
	5280	if (fq_ddft(il,i).ne.0.0) then
	5281	write(,) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
	5282	& fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i))
	5283	endif !if (fq_ddft(il,i).ne.0.0) then
	5284	if (fq_evapprecip(il,i).ne.0.0) then
	5285	write(,) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i), &
	5286	& deltaD(fxt_evapprecip(iso_HDO,il,i) &
	5287	& /fq_evapprecip(il,i))
	5288	endif !if (fq_evapprecip(il,i).ne.0.0) then
	5289	#endif
	5290	endif !if (iso_verif_aberrant_enc_nostop(
	5291	endif !if (iso_HDO.gt.0) then
	5292	endif !if (1.eq.0) then
	5293	if ((iso_HDO.gt.0).and. &
	5294	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5295	if (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &
	5296	& +delt*fxt(iso_HDO,il,i)) &
	5297	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3757, ddfts') &
	5298	& .eq.1) then
	5299	write(,) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( &
	5300	& xt(iso_HDO,il,i)/rr(il,i))
	5301	write(,) 'i,il,fr,deltaD=',i,il,fr(il,i),deltaD( &
	5302	& fxt(iso_HDO,il,i)/fr(il,i))
	5303	stop
	5304	endif ! if (iso_verif_aberrant_enc_nostop
	5305	endif !if (iso_HDO.gt.0) then
	5306
	5307	if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
	5308	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5309	call iso_verif_O18_aberrant( &
	5310	& (xt(iso_HDO,il,i)+deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	5311	& (xt(iso_O18,il,i)+deltfxt(iso_O18,il,i))/(rr(il,i)+deltfr(il,i)), &
	5312	& 'cv30_yield 5250,O18, ddfts')
	5313	endif !if (iso_HDO.gt.0) then
	5314
	5315	#ifdef ISOTRAC
	5316	! write(,) 'tmp cv3_yield 4224: i,il=',i,il
	5317	call iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 4107')
	5318	do ixt=1,ntraciso
	5319	xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
	5320	enddo
	5321	if (iso_verif_tracpos_choix_nostop(xtnew, &
	5322	& 'cv30_yield 4221',1e-5).eq.1) then
	5323	write(,) 'deltfxt(,il,i)=',deltfxt(1:ntraciso:2,il,i)
	5324	write(,) 'deltfxt(,il,i)=',deltfxt(:,il,i)
	5325	write(,) 'xt(,il,i)=',xt(:,il,i)
	5326	write(,) 'delt,sigd,grav,dpinv=',delt,sigd,grav,dpinv
	5327	write(,) 'xtevap(,il,i)=',xtevap(:,il,i)
	5328	write(,) 'xtevap(,il,i+1)=',xtevap(:,il,i+1)
	5329	write(,) 'mp(il,i+1),mp(il,i)=',mp(il,i+1),mp(il,i)
	5330	write(,) 'xtp(,il,i)=',xtp(:,il,i)
	5331	write(,) 'xtp(,il,i+1)=',xtp(:,il,i+1)
	5332	write(,) 'xt(,il,i)=',xt(:,il,i)
	5333	write(,) 'xt(,il,i-1)=',xt(:,il,i-1)
	5334	! rappel: fxt(ixt,il,i)=fxt(ixt,il,i)
	5335	! 0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
	5336	! : +0.01grav(mp(il,i+1)*(xtp(ixt,il,i+1)-xt(ixt,il,i))
	5337	! : -mp(il,i)(xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5338	! stop
	5339	endif
	5340	#endif
	5341	#endif
	5342	#endif
	5343	ELSE ! cvflag_grav
	5344	fr(il, i) = fr(il, i) + 0.5sigd(evap(il,i)+evap(il,i+1)) + &
	5345	0.1(mp(il,i+1)(rp(il,i+1)-rr(il,i))-mp(il,i)*(rp(il,i)-rr(il, &
	5346	i-1)))*dpinv
	5347	fu(il, i) = fu(il, i) + 0.1(mp(il,i+1)(up(il,i+1)-u(il, &
	5348	i))-mp(il,i)(up(il,i)-u(il,i-1)))dpinv
	5349	fv(il, i) = fv(il, i) + 0.1(mp(il,i+1)(vp(il,i+1)-v(il, &
	5350	i))-mp(il,i)(vp(il,i)-v(il,i-1)))dpinv
	5351	#ifdef ISO
	5352	do ixt = 1, ntraciso
	5353	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5354	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
	5355	& +0.1(mp(il,i+1)(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
	5356	& -mp(il,i)(xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5357	enddo ! ixt=1,niso
	5358
	5359	#ifdef ISOTRAC
	5360	if (option_traceurs.ne.6) then
	5361
	5362	! facile: on fait comme l'eau
	5363	do ixt = 1+niso,ntraciso
	5364	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5365	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
	5366	& +0.01grav(mp(il,i+1)*(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
	5367	& -mp(il,i)(xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5368	enddo !do ixt = 1+niso,ntraciso
	5369
	5370	else !if (option_traceurs.ne.6) then
	5371
	5372	! taggage des ddfts: voir blabla + haut
	5373	do ixt = 1+niso,ntraciso
	5374	fxt(ixt,il,i)=fxt(ixt,il,i) &
	5375	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
	5376	enddo !do ixt = 1+niso,ntraciso
	5377	! write(,) 'tmp cv3_yield 4165: i,il=',i,il
	5378	! ixt_poubelle=index_trac(izone_poubelle,iso_eau)
	5379	! ixt_ddft=index_trac(izone_ddft,iso_eau)
	5380	! write(,) 'delt*fxt(ixt_poubelle,il,i)=',
	5381	! : delt*fxt(ixt_poubelle,il,i)
	5382	! write(,) 'deltfxt(ixt_ddft,il,i)=',deltfxt(ixt_ddft,il,i)
	5383	! write(,) 'xt(iso_eau,il,i)=',xt(iso_eau,il,i)
	5384	do iiso = 1, niso
	5385	ixt_poubelle=index_trac(izone_poubelle,iiso)
	5386	ixt_ddft=index_trac(izone_ddft,iiso)
	5387	if (mp(il,i).gt.mp(il,i+1)) then
	5388	fxtYe(iiso)=0.01gravdpinv*mp(il,i) &
	5389	& *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
	5390	else !if (mp(il,i).gt.mp(il,i+1)) then
	5391	fxtYe(iiso)=0.01gravdpinv*(mp(il,i) &
	5392	& xt(ixt_ddft,il,i-1)-mp(il,i+1)xt(ixt_ddft,il,i) &
	5393	& +(mp(il,i+1)-mp(il,i))*xtp(ixt_ddft,il,i))
	5394	endif !if (mp(il,i).gt.mp(il,i+1)) then
	5395	fxtqe(iiso)=0.01gravdpinv* &
	5396	& (mp(il,i+1)*(xtp(iiso,il,i+1)-xt(iiso,il,i)) &
	5397	& -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
	5398	fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso)
	5399	fxt(ixt_poubelle,il,i)=fxt(ixt_poubelle,il,i) &
	5400	& +fxtqe(iiso)-fxtYe(iiso)
	5401	enddo !do iiso = 1, niso
	5402	! write(,) 'deltconversion=',deltconversion(iso_eau)
	5403	! write(,) 'deltfxtYe=',deltfxtYe(iso_eau)
	5404	! write(,) 'deltfxtqe=',deltfxtqe(iso_eau)
	5405	endif !if (option_traceurs.eq.6) then
	5406	#endif
	5407
	5408	#ifdef DIAGISO
	5409	fq_evapprecip(il,i)=fq_evapprecip(il,i) &
	5410	& +0.5sigd(evap(il,i)+evap(il,i+1))
	5411	fq_ddft(il,i)=fq_ddft(il,i) &
	5412	& +0.1(mp(il,i+1)(rp(il,i+1)-rr(il,i))-mp(il,i) &
	5413	& (rp(il,i)-rr(il,i-1)))dpinv
	5414	do ixt = 1, niso
	5415	fxt_evapprecip(ixt,il,i)=fxt_evapprecip(ixt,il,i) &
	5416	& +0.5sigd(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
	5417	fxt_ddft(ixt,il,i)=fxt_ddft(ixt,il,i) &
	5418	& +0.1(mp(il,i+1)(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
	5419	& -mp(il,i)(xtp(ixt,il,i)-xt(ixt,il,i-1)))dpinv
	5420	enddo ! ixt=1,niso
	5421	#endif
	5422
	5423	! cam verif
	5424
	5425	#ifdef ISOVERIF
	5426	do ixt=1,niso
	5427	call iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 5083')
	5428	enddo
	5429	#endif
	5430	#ifdef ISOVERIF
	5431	if (iso_eau.gt.0) then
	5432	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	5433	& fr(il,i),'cv30_routines 3522',errmax,errmaxrel)
	5434	endif !if (iso_eau.gt.0) then
	5435	if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) then
	5436	if (iso_verif_aberrant_enc_nostop( &
	5437	& fxt(iso_HDO,il,i)/fr(il,i), &
	5438	& 'cv30_yield 3690').eq.1) then
	5439	write(,) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
	5440	stop
	5441	endif
	5442	endif !if (iso_HDO.gt.0) then
	5443	if ((iso_HDO.gt.0).and. &
	5444	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5445	call iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
	5446	& +delt*fxt(iso_HDO,il,i)) &
	5447	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3757b, ddfts')
	5448	endif !if (iso_HDO.gt.0) then
	5449	if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
	5450	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5451	call iso_verif_O18_aberrant( &
	5452	& (xt(iso_HDO,il,i)+deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	5453	& (xt(iso_O18,il,i)+deltfxt(iso_O18,il,i))/(rr(il,i)+deltfr(il,i)), &
	5454	& 'cv30_yield 3757b,O18, ddfts')
	5455	endif !if (iso_HDO.gt.0) then
	5456	#ifdef ISOTRAC
	5457	call iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 4172')
	5458	do ixt=1,ntraciso
	5459	xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
	5460	enddo
	5461	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4295',1e-5) &
	5462	& .eq.1) then
	5463	write(,) 'il,i=',il,i
	5464	endif
	5465	! call iso_verif_tracpos_choix(xtnew,'cv30_yield 4295',1e-5)
	5466	#endif
	5467	#endif
	5468	! end cam verif
	5469	#endif
	5470
	5471	END IF ! cvflag_grav
	5472
	5473	END IF ! i
	5474	END DO
	5475
	5476	! sb: interface with the cloud parameterization: ! cld
	5477
	5478	DO k = i + 1, nl
	5479	DO il = 1, ncum
	5480	IF (k<=inb(il) .AND. i<=inb(il)) THEN ! cld
	5481	! (saturated downdrafts resulting from mixing) ! cld
	5482	qcond(il, i) = qcond(il, i) + elij(il, k, i) ! cld
	5483	nqcond(il, i) = nqcond(il, i) + 1. ! cld
	5484	END IF ! cld
	5485	END DO ! cld
	5486	END DO ! cld
	5487
	5488	! (particular case: no detraining level is found) ! cld
	5489	DO il = 1, ncum ! cld
	5490	IF (i<=inb(il) .AND. nent(il,i)==0) THEN ! cld
	5491	qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i) ! cld
	5492	nqcond(il, i) = nqcond(il, i) + 1. ! cld
	5493	END IF ! cld
	5494	END DO ! cld
	5495
	5496	DO il = 1, ncum ! cld
	5497	IF (i<=inb(il) .AND. nqcond(il,i)/=0.) THEN ! cld
	5498	qcond(il, i) = qcond(il, i)/nqcond(il, i) ! cld
	5499	END IF ! cld
	5500	END DO
	5501
	5502	! do j=1,ntra
	5503	! do il=1,ncum
	5504	! if (i.le.inb(il)) then
	5505	! dpinv=1.0/(ph(il,i)-ph(il,i+1))
	5506	! cpinv=1.0/cpn(il,i)
	5507
	5508	! if (cvflag_grav) then
	5509	! ftra(il,i,j)=ftra(il,i,j)+0.01gravdpinv
	5510	! : (mp(il,i+1)(trap(il,i+1,j)-tra(il,i,j))
	5511	! : -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
	5512	! else
	5513	! ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
	5514	! : (mp(il,i+1)(trap(il,i+1,j)-tra(il,i,j))
	5515	! : -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
	5516	! endif
	5517	! endif ! i
	5518	! enddo
	5519	! enddo
	5520
	5521	500 END DO
	5522
	5523
	5524	! * move the detrainment at level inb down to level inb-1 *
	5525	! * in such a way as to preserve the vertically *
	5526	! * integrated enthalpy and water tendencies *
	5527
	5528	DO il = 1, ncum
	5529
	5530	! attention, on corrige un problème
	5531	IF ((cvflag_grav).and.(.not.essai_convergence)) THEN
	5532
	5533	ax = 0.01gravment(il, inb(il), inb(il))*(hp(il,inb(il))-h(il,inb(il))+t(il, &
	5534	inb(il))(cpv-cpd)(rr(il,inb(il))-qent(il,inb(il), &
	5535	inb(il))))/(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
	5536	ft(il, inb(il)) = ft(il, inb(il)) - ax
	5537	ft(il, inb(il)-1) = ft(il, inb(il)-1) + axcpn(il, inb(il))(ph(il,inb(il &
	5538	))-ph(il,inb(il)+1))/(cpn(il,inb(il)-1)*(ph(il,inb(il)-1)-ph(il, &
	5539	inb(il))))
	5540
	5541	bx = 0.01gravment(il, inb(il), inb(il))*(qent(il,inb(il),inb(il))-rr(il,inb( &
	5542	il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5543	fr(il, inb(il)) = fr(il, inb(il)) - bx
	5544	fr(il, inb(il)-1) = fr(il, inb(il)-1) + bx*(ph(il,inb(il))-ph(il,inb(il)+ &
	5545	1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
	5546
	5547	cx = 0.01gravment(il, inb(il), inb(il))*(uent(il,inb(il),inb(il))-u(il,inb(il &
	5548	)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5549	fu(il, inb(il)) = fu(il, inb(il)) - cx
	5550	fu(il, inb(il)-1) = fu(il, inb(il)-1) + cx*(ph(il,inb(il))-ph(il,inb(il)+ &
	5551	1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
	5552
	5553	dx = 0.01gravment(il, inb(il), inb(il))*(vent(il,inb(il),inb(il))-v(il,inb(il &
	5554	)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5555	fv(il, inb(il)) = fv(il, inb(il)) - dx
	5556	fv(il, inb(il)-1) = fv(il, inb(il)-1) + dx*(ph(il,inb(il))-ph(il,inb(il)+ &
	5557	1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
	5558
	5559
	5560	#ifdef ISO
	5561	do ixt = 1, ntraciso
	5562	xtbx(ixt)=0.01gravment(il,inb(il),inb(il)) &
	5563	& *(xtent(ixt,il,inb(il),inb(il)) &
	5564	& -xt(ixt,il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5565	fxt(ixt,il,inb(il))=fxt(ixt,il,inb(il))-xtbx(ixt)
	5566	fxt(ixt,il,inb(il)-1)=fxt(ixt,il,inb(il)-1) &
	5567	& +xtbx(ixt)*(ph(il,inb(il))-ph(il,inb(il)+1)) &
	5568	& /(ph(il,inb(il)-1)-ph(il,inb(il)))
	5569	enddo !do ixt = 1, niso
	5570	#endif
	5571
	5572	else !IF (cvflag_grav).and.(.not.essai_convergence) THEN
	5573
	5574	ax = 0.1ment(il, inb(il), inb(il))(hp(il,inb(il))-h(il,inb(il))+t(il, &
	5575	inb(il))(cpv-cpd)(rr(il,inb(il))-qent(il,inb(il), &
	5576	inb(il))))/(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
	5577	ft(il, inb(il)) = ft(il, inb(il)) - ax
	5578	ft(il, inb(il)-1) = ft(il, inb(il)-1) + axcpn(il, inb(il))(ph(il,inb(il &
	5579	))-ph(il,inb(il)+1))/(cpn(il,inb(il)-1)*(ph(il,inb(il)-1)-ph(il, &
	5580	inb(il))))
	5581
	5582	bx = 0.1ment(il, inb(il), inb(il))(qent(il,inb(il),inb(il))-rr(il,inb( &
	5583	il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5584	fr(il, inb(il)) = fr(il, inb(il)) - bx
	5585	fr(il, inb(il)-1) = fr(il, inb(il)-1) + bx*(ph(il,inb(il))-ph(il,inb(il)+ &
	5586	1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
	5587
	5588	cx = 0.1ment(il, inb(il), inb(il))(uent(il,inb(il),inb(il))-u(il,inb(il &
	5589	)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5590	fu(il, inb(il)) = fu(il, inb(il)) - cx
	5591	fu(il, inb(il)-1) = fu(il, inb(il)-1) + cx*(ph(il,inb(il))-ph(il,inb(il)+ &
	5592	1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
	5593
	5594	dx = 0.1ment(il, inb(il), inb(il))(vent(il,inb(il),inb(il))-v(il,inb(il &
	5595	)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5596	fv(il, inb(il)) = fv(il, inb(il)) - dx
	5597	fv(il, inb(il)-1) = fv(il, inb(il)-1) + dx*(ph(il,inb(il))-ph(il,inb(il)+ &
	5598	1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
	5599
	5600
	5601	#ifdef ISO
	5602	do ixt = 1, ntraciso
	5603	xtbx(ixt)=0.1*ment(il,inb(il),inb(il)) &
	5604	& *(xtent(ixt,il,inb(il),inb(il)) &
	5605	& -xt(ixt,il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5606	fxt(ixt,il,inb(il))=fxt(ixt,il,inb(il))-xtbx(ixt)
	5607	fxt(ixt,il,inb(il)-1)=fxt(ixt,il,inb(il)-1) &
	5608	& +xtbx(ixt)*(ph(il,inb(il))-ph(il,inb(il)+1)) &
	5609	& /(ph(il,inb(il)-1)-ph(il,inb(il)))
	5610	enddo !do ixt = 1, niso
	5611	#endif
	5612
	5613	endif !IF (cvflag_grav).and.(.not.essai_convergence) THEN
	5614
	5615	#ifdef ISO
	5616	#ifdef DIAGISO
	5617	fq_detrainement(il,inb(il))=fq_detrainement(il,inb(il))-bx
	5618	fq_detrainement(il,inb(il)-1)=fq_detrainement(il,inb(il)-1) &
	5619	& +bx*(ph(il,inb(il))-ph(il,inb(il)+1)) &
	5620	& /(ph(il,inb(il)-1)-ph(il,inb(il)))
	5621	do ixt = 1, niso
	5622	fxt_detrainement(ixt,il,inb(il))= &
	5623	& fxt_detrainement(ixt,il,inb(il))-xtbx(ixt)
	5624	fxt_detrainement(ixt,il,inb(il)-1)= &
	5625	& fxt_detrainement(ixt,il,inb(il)-1) &
	5626	& +xtbx(ixt)*(ph(il,inb(il))-ph(il,inb(il)+1)) &
	5627	& /(ph(il,inb(il)-1)-ph(il,inb(il)))
	5628	enddo
	5629	#endif
	5630	! cam verif
	5631	#ifdef ISOVERIF
	5632	do ixt=1,niso
	5633	call iso_verif_noNaN(fxt(ixt,il,inb(il)),'cv30_yield 5083')
	5634	enddo
	5635	if (iso_eau.gt.0) then
	5636	call iso_verif_egalite_choix(fxt(iso_eau,il,inb(il)), &
	5637	& fr(il,inb(il)),'cv30_routines 3638',errmax,errmaxrel)
	5638	call iso_verif_egalite_choix(fxt(iso_eau,il,inb(il)-1), &
	5639	& fr(il,inb(il)-1),'cv30_routines 3640',errmax,errmaxrel)
	5640	endif !if (iso_eau.gt.0) then
	5641	if ((iso_HDO.gt.0).and. &
	5642	& (rr(il,inb(il))+delt*fr(il,inb(il)).gt.ridicule)) then
	5643	call iso_verif_aberrant_encadre( &
	5644	& (xt(iso_HDO,il,inb(il))+delt*fxt(iso_HDO,il,inb(il))) &
	5645	& /(rr(il,inb(il))+delt*fr(il,inb(il))), &
	5646	& 'cv30_yield 3921, en inb')
	5647	if (iso_O18.gt.0) then
	5648	if (iso_verif_O18_aberrant_nostop( &
	5649	& (xt(iso_HDO,il,inb(il))+delt*fxt(iso_HDO,il,inb(il))) &
	5650	& /(rr(il,inb(il))+delt*fr(il,inb(il))), &
	5651	& (xt(iso_O18,il,inb(il))+delt*fxt(iso_O18,il,inb(il))) &
	5652	& /(rr(il,inb(il))+delt*fr(il,inb(il))), &
	5653	& 'cv30_yield 3921O18, en inb').eq.1) then
	5654	write(,) 'il,inb(il)=',il,inb(il)
	5655	k_tmp=0.1*ment(il,inb(il),inb(il))/(ph(il,inb(il))-ph(il,inb(il)+1))
	5656	write(,) 'fr,frprec=',fr(il,inb(il)),fr(il,inb(il))+bx
	5657	write(,) 'M,dt,k_tmpdt=',k_tmp,delt,k_tmpdelt
	5658	write(,) 'q,qe=',rr(il,inb(il)),qent(il,inb(il),inb(il))
	5659	write(,) 'r=',k_tmpdeltqent(il,inb(il),inb(il))/rr(il,inb(il))
	5660	write(,) 'deltaDR,Re=',deltaD(xt(iso_HDO,il,inb(il))/rr(il,inb(il))), &
	5661	& deltaD(xtent(iso_HDO,il,inb(il),inb(il))/qent(il,inb(il),inb(il)))
	5662	write(,) 'deltaO18R,Re=',deltaO(xt(iso_O18,il,inb(il))/rr(il,inb(il))), &
	5663	& deltaO(xtent(iso_O18,il,inb(il),inb(il))/qent(il,inb(il),inb(il)))
	5664	stop
	5665	endif !if (iso_verif_O18_aberrant_nostop
	5666	endif !if (iso_O18.gt.0) then
	5667	endif !if (iso_HDO.gt.0) then
	5668	if ((iso_HDO.gt.0).and. &
	5669	& (rr(il,inb(il)-1)+delt*fr(il,inb(il)-1).gt.ridicule)) then
	5670	call iso_verif_aberrant_encadre( &
	5671	& (xt(iso_HDO,il,inb(il)-1) &
	5672	& +delt*fxt(iso_HDO,il,inb(il)-1)) &
	5673	& /(rr(il,inb(il)-1)+delt*fr(il,inb(il)-1)), &
	5674	& 'cv30_yield 3921b, en inb-1')
	5675	if (iso_O18.gt.0) then
	5676	call iso_verif_O18_aberrant( &
	5677	& (xt(iso_HDO,il,inb(il)-1)+delt*fxt(iso_HDO,il,inb(il)-1)) &
	5678	& /(rr(il,inb(il)-1)+delt*fr(il,inb(il)-1)), &
	5679	& (xt(iso_O18,il,inb(il)-1)+delt*fxt(iso_O18,il,inb(il)-1)) &
	5680	& /(rr(il,inb(il)-1)+delt*fr(il,inb(il)-1)), &
	5681	& 'cv30_yield 3921cO18, en inb-1')
	5682	endif
	5683	endif !if (iso_HDO.gt.0) then
	5684	#ifdef ISOTRAC
	5685	call iso_verif_traceur_justmass(fxt(1,il,inb(il)-1), &
	5686	& 'cv30_routine 4364')
	5687	call iso_verif_traceur_justmass(fxt(1,il,inb(il)), &
	5688	& 'cv30_routine 4364b')
	5689	do ixt=1,ntraciso
	5690	xtnew(ixt)=xt(ixt,il,inb(il))+delt*fxt(ixt,il,inb(il))
	5691	enddo
	5692	if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4492',1e-5) &
	5693	& .eq.1) then
	5694	write(,) 'il,i=',il,i
	5695	endif
	5696	! call iso_verif_tracpos_choix(xtnew,'cv30_yield 4492',1e-5)
	5697	#endif
	5698	#endif
	5699	! end cam verif
	5700	#endif
	5701
	5702	END DO
	5703
	5704	! do j=1,ntra
	5705	! do il=1,ncum
	5706	! ex=0.1*ment(il,inb(il),inb(il))
	5707	! : *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
	5708	! : /(ph(il,inb(il))-ph(il,inb(il)+1))
	5709	! ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
	5710	! ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
	5711	! : +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
	5712	! : /(ph(il,inb(il)-1)-ph(il,inb(il)))
	5713	! enddo
	5714	! enddo
	5715
	5716
	5717	! * homoginize tendencies below cloud base *
	5718
	5719	#ifdef ISO
	5720	! pour les isotopes: on zappe cette partie d'homogénéisation.
	5721	! On ne la fait seulement dans le cas des tests de convergence avec la version
	5722	! originale d'LMDZ.
	5723	if (essai_convergence) then
	5724	#endif
	5725
	5726	DO il = 1, ncum
	5727	asum(il) = 0.0
	5728	bsum(il) = 0.0
	5729	csum(il) = 0.0
	5730	dsum(il) = 0.0
	5731	#ifdef ISO
	5732	frsum(il)=0.0
	5733	do ixt=1,ntraciso
	5734	fxtsum(ixt,il)=0.0
	5735	bxtsum(ixt,il)=0.0
	5736	enddo
	5737	#endif
	5738	END DO
	5739
	5740	DO i = 1, nl
	5741	DO il = 1, ncum
	5742	IF (i<=(icb(il)-1)) THEN
	5743	asum(il) = asum(il) + ft(il, i)*(ph(il,i)-ph(il,i+1))
	5744	bsum(il) = bsum(il) + fr(il, i)(lv(il,i)+(cl-cpd)(t(il,i)-t(il, &
	5745	1)))*(ph(il,i)-ph(il,i+1))
	5746	csum(il) = csum(il) + (lv(il,i)+(cl-cpd)*(t(il,i)-t(il, &
	5747	1)))*(ph(il,i)-ph(il,i+1))
	5748	dsum(il) = dsum(il) + t(il, i)*(ph(il,i)-ph(il,i+1))/th(il, i)
	5749	#ifdef ISO
	5750
	5751	frsum(il)=frsum(il)+fr(il,i)
	5752	do ixt=1,ntraciso
	5753	fxtsum(ixt,il)=fxtsum(ixt,il)+fxt(ixt,il,i)
	5754	bxtsum(ixt,il)=bxtsum(ixt,il)+fxt(ixt,il,i) &
	5755	& (lv(il,i)+(cl-cpd)(t(il,i)-t(il,1))) &
	5756	& *(ph(il,i)-ph(il,i+1))
	5757	enddo
	5758	#endif
	5759	END IF
	5760	END DO
	5761	END DO
	5762
	5763	! !!! do 700 i=1,icb(il)-1
	5764	DO i = 1, nl
	5765	DO il = 1, ncum
	5766	IF (i<=(icb(il)-1)) THEN
	5767	ft(il, i) = asum(il)t(il, i)/(th(il,i)dsum(il))
	5768	fr(il, i) = bsum(il)/csum(il)
	5769	#ifdef ISO
	5770	if (abs(csum(il)).gt.0.0) then
	5771	do ixt=1,ntraciso
	5772	fxt(ixt,il,i)=bxtsum(ixt,il)/csum(il)
	5773	enddo
	5774	else !if (frsum(il).gt.ridicule) then
	5775	if (abs(frsum(il)).gt.0.0) then
	5776	do ixt=1,ntraciso
	5777	fxt(ixt,il,i)=fr(il,i)*fxtsum(ixt,il)/frsum(il)
	5778	enddo
	5779	else !if (abs(frsum(il)).gt.0.0) then
	5780	if (abs(fr(il,i))*delt.gt.ridicule) then
	5781	write(,) 'cv30_yield 4048: fr(il,i)=',fr(il,i)
	5782	stop
	5783	else !if (abs(fr(il,i))*delt.gt.ridicule) then
	5784	do ixt=1,ntraciso
	5785	fxt(ixt,il,i)=0.0
	5786	enddo
	5787	if (iso_eau.gt.0) then
	5788	fxt(iso_eau,il,i)=1.0
	5789	endif
	5790	endif !if (abs(fr(il,i))*delt.gt.ridicule) then
	5791	endif !if (abs(frsum(il)).gt.0.0) then
	5792	endif !if (frsum(il).gt.0) then
	5793	#endif
	5794	END IF
	5795	END DO
	5796	END DO
	5797
	5798	#ifdef ISO
	5799	#ifdef ISOVERIF
	5800	do i=1,nl
	5801	do il=1,ncum
	5802	do ixt=1,ntraciso
	5803	call iso_verif_noNAN(fxt(ixt,il,i),'cv30_yield 3826')
	5804	enddo
	5805	enddo
	5806	enddo
	5807	#endif
	5808	#ifdef ISOVERIF
	5809	do i=1,nl
	5810	! write(,) 'cv30_routines temp 3967: i=',i
	5811	do il=1,ncum
	5812	! write(,) 'cv30_routines 3969: il=',il
	5813	! write(,) 'cv30_routines temp 3967: il,i,inb(il),ncum=',
	5814	! : il,i,inb(il),ncum
	5815	! write(,) 'cv30_routines 3974'
	5816	if (iso_eau.gt.0) then
	5817	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	5818	& fr(il,i),'cv30_yield 3830',errmax,errmaxrel)
	5819	endif !if (iso_eau.gt.0) then
	5820	! write(,) 'cv30_routines 3979'
	5821	if ((iso_HDO.gt.0).and. &
	5822	& (delt*fr(il,i).gt.ridicule)) then
	5823	if (iso_verif_aberrant_enc_nostop( &
	5824	& fxt(iso_HDO,il,i)/fr(il,i), &
	5825	& 'cv30_yield 3834').eq.1) then
	5826	if (fr(il,i).gt.ridicule*1e5) then
	5827	write(,) 'il,i,icb(il)=',il,i,icb(il)
	5828	write(,) 'frsum(il)=',frsum(il)
	5829	write(,) 'fr(il,i)=',fr(il,i)
	5830	write(,) 'csum(il)=',csum(il)
	5831	write(,) &
	5832	& 'deltaD(bxtsum(iso_HDO,il)/csum(il))=', &
	5833	& deltaD(bxtsum(iso_HDO,il)/csum(il))
	5834	! stop
	5835	endif
	5836	! write(,) 'cv30_routines 3986: temporaire'
	5837	endif !if (iso_verif_aberrant_enc_nostop
	5838	endif !if (iso_HDO.gt.0) then
	5839	if ((iso_HDO.gt.0).and. &
	5840	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5841	if (iso_verif_aberrant_enc_nostop( &
	5842	& (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) &
	5843	& /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3921c, dans la CL') &
	5844	& .eq.1) then
	5845	write(,) 'il,i,icb(il)=',il,i,icb(il)
	5846	write(,) 'frsum(il)=',frsum(il)
	5847	write(,) 'fr(il,i)=',fr(il,i)
	5848	stop
	5849	endif
	5850	endif !if (iso_HDO.gt.0) then
	5851
	5852	if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
	5853	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5854	call iso_verif_O18_aberrant( &
	5855	& (xt(iso_HDO,il,i)+deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	5856	& (xt(iso_O18,il,i)+deltfxt(iso_O18,il,i))/(rr(il,i)+deltfr(il,i)), &
	5857	& 'cv30_yield 3921d, dans la CL')
	5858	endif !if (iso_HDO.gt.0) then
	5859	#ifdef ISOTRAC
	5860	call iso_verif_traceur_justmass(fxt(1,il,i), &
	5861	& 'cv30_routine 4523')
	5862	#endif
	5863	! write(,) 'cv30_routines 3994'
	5864	enddo !do il=1,ncum
	5865	! write(,) 'cv30_routine 3990: fin des il pour i=',i
	5866	enddo !do i=1,nl
	5867	! write(,) 'cv30_routine 3990: fin des vérifs sur homogen'
	5868	#endif
	5869	#endif
	5870
	5871	#ifdef ISO
	5872	endif ! if essai_convergence
	5873	#endif
	5874
	5875	#ifdef ISOVERIF
	5876	! verif finale des tendances:
	5877	do i=1,nl
	5878	do il=1,ncum
	5879	if (iso_eau.gt.0) then
	5880	call iso_verif_egalite_choix(fxt(iso_eau,il,i), &
	5881	& fr(il,i),'cv30_yield 3830',errmax,errmaxrel)
	5882	endif !if (iso_eau.gt.0) then
	5883	if ((iso_HDO.gt.0).and. &
	5884	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5885	call iso_verif_aberrant_encadre((xt(iso_HDO,il,i) &
	5886	& +delt*fxt(iso_HDO,il,i)) &
	5887	& /(rr(il,i)+delt*fr(il,i)), &
	5888	& 'cv30_yield 5710a, final')
	5889	endif !if (iso_HDO.gt.0) then
	5890	if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
	5891	& (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
	5892	call iso_verif_O18_aberrant( &
	5893	& (xt(iso_HDO,il,i)+deltfxt(iso_HDO,il,i))/(rr(il,i)+deltfr(il,i)), &
	5894	& (xt(iso_O18,il,i)+deltfxt(iso_O18,il,i))/(rr(il,i)+deltfr(il,i)), &
	5895	& 'cv30_yield 5710b, final')
	5896	endif !if (iso_HDO.gt.0) then
	5897	enddo !do il=1,ncum
	5898	enddo !do i=1,nl
	5899	#endif
	5900
	5901
	5902	! * reset counter and return *
	5903
	5904	DO il = 1, ncum
	5905	sig(il, nd) = 2.0
	5906	END DO
	5907
	5908
	5909	DO i = 1, nd
	5910	DO il = 1, ncum
	5911	upwd(il, i) = 0.0
	5912	dnwd(il, i) = 0.0
	5913	END DO
	5914	END DO
	5915
	5916	DO i = 1, nl
	5917	DO il = 1, ncum
	5918	dnwd0(il, i) = -mp(il, i)
	5919	END DO
	5920	END DO
	5921	DO i = nl + 1, nd
	5922	DO il = 1, ncum
	5923	dnwd0(il, i) = 0.
	5924	END DO
	5925	END DO
	5926
	5927
	5928	DO i = 1, nl
	5929	DO il = 1, ncum
	5930	IF (i>=icb(il) .AND. i<=inb(il)) THEN
	5931	upwd(il, i) = 0.0
	5932	dnwd(il, i) = 0.0
	5933	END IF
	5934	END DO
	5935	END DO
	5936
	5937	DO i = 1, nl
	5938	DO k = 1, nl
	5939	DO il = 1, ncum
	5940	up1(il, k, i) = 0.0
	5941	dn1(il, k, i) = 0.0
	5942	END DO
	5943	END DO
	5944	END DO
	5945
	5946	DO i = 1, nl
	5947	DO k = i, nl
	5948	DO n = 1, i - 1
	5949	DO il = 1, ncum
	5950	IF (i>=icb(il) .AND. i<=inb(il) .AND. k<=inb(il)) THEN
	5951	up1(il, k, i) = up1(il, k, i) + ment(il, n, k)
	5952	dn1(il, k, i) = dn1(il, k, i) - ment(il, k, n)
	5953	END IF
	5954	END DO
	5955	END DO
	5956	END DO
	5957	END DO
	5958
	5959	DO i = 2, nl
	5960	DO k = i, nl
	5961	DO il = 1, ncum
	5962	! test if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il))
	5963	! then
	5964	IF (i<=inb(il) .AND. k<=inb(il)) THEN
	5965	upwd(il, i) = upwd(il, i) + m(il, k) + up1(il, k, i)
	5966	dnwd(il, i) = dnwd(il, i) + dn1(il, k, i)
	5967	END IF
	5968	END DO
	5969	END DO
	5970	END DO
	5971
	5972
	5973	! !!! DO il=1,ncum
	5974	! !!! do i=icb(il),inb(il)
	5975	! !!!
	5976	! !!! upwd(il,i)=0.0
	5977	! !!! dnwd(il,i)=0.0
	5978	! !!! do k=i,inb(il)
	5979	! !!! up1=0.0
	5980	! !!! dn1=0.0
	5981	! !!! do n=1,i-1
	5982	! !!! up1=up1+ment(il,n,k)
	5983	! !!! dn1=dn1-ment(il,k,n)
	5984	! !!! enddo
	5985	! !!! upwd(il,i)=upwd(il,i)+m(il,k)+up1
	5986	! !!! dnwd(il,i)=dnwd(il,i)+dn1
	5987	! !!! enddo
	5988	! !!! enddo
	5989	! !!!
	5990	! !!! ENDDO
	5991
	5992	! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	5993	! determination de la variation de flux ascendant entre
	5994	! deux niveau non dilue mike
	5995	! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	5996
	5997	DO i = 1, nl
	5998	DO il = 1, ncum
	5999	mike(il, i) = m(il, i)
	6000	END DO
	6001	END DO
	6002
	6003	DO i = nl + 1, nd
	6004	DO il = 1, ncum
	6005	mike(il, i) = 0.
	6006	END DO
	6007	END DO
	6008
	6009	DO i = 1, nd
	6010	DO il = 1, ncum
	6011	ma(il, i) = 0
	6012	END DO
	6013	END DO
	6014
	6015	DO i = 1, nl
	6016	DO j = i, nl
	6017	DO il = 1, ncum
	6018	ma(il, i) = ma(il, i) + m(il, j)
	6019	END DO
	6020	END DO
	6021	END DO
	6022
	6023	DO i = nl + 1, nd
	6024	DO il = 1, ncum
	6025	ma(il, i) = 0.
	6026	END DO
	6027	END DO
	6028
	6029	DO i = 1, nl
	6030	DO il = 1, ncum
	6031	IF (i<=(icb(il)-1)) THEN
	6032	ma(il, i) = 0
	6033	END IF
	6034	END DO
	6035	END DO
	6036
	6037	! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	6038	! icb represente de niveau ou se trouve la
	6039	! base du nuage , et inb le top du nuage
	6040	! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	6041
	6042	DO i = 1, nd
	6043	DO il = 1, ncum
	6044	mke(il, i) = upwd(il, i) + dnwd(il, i)
	6045	END DO
	6046	END DO
	6047
	6048	DO i = 1, nd
	6049	DO il = 1, ncum
	6050	rdcp = (rrd(1.-rr(il,i))-rr(il,i)rrv)/(cpd*(1.-rr(il, &
	6051	i))+rr(il,i)*cpv)
	6052	tls(il, i) = t(il, i)(1000.0/p(il,i))*rdcp
	6053	tps(il, i) = tp(il, i)
	6054	END DO
	6055	END DO
	6056
	6057
	6058	! * diagnose the in-cloud mixing ratio * ! cld
	6059	! * of condensed water * ! cld
	6060	! ! cld
	6061
	6062	DO i = 1, nd ! cld
	6063	DO il = 1, ncum ! cld
	6064	mac(il, i) = 0.0 ! cld
	6065	wa(il, i) = 0.0 ! cld
	6066	siga(il, i) = 0.0 ! cld
	6067	sax(il, i) = 0.0 ! cld
	6068	END DO ! cld
	6069	END DO ! cld
	6070
	6071	DO i = minorig, nl ! cld
	6072	DO k = i + 1, nl + 1 ! cld
	6073	DO il = 1, ncum ! cld
	6074	IF (i<=inb(il) .AND. k<=(inb(il)+1)) THEN ! cld
	6075	mac(il, i) = mac(il, i) + m(il, k) ! cld
	6076	END IF ! cld
	6077	END DO ! cld
	6078	END DO ! cld
	6079	END DO ! cld
	6080
	6081	DO i = 1, nl ! cld
	6082	DO j = 1, i ! cld
	6083	DO il = 1, ncum ! cld
	6084	IF (i>=icb(il) .AND. i<=(inb(il)-1) & ! cld
	6085	.AND. j>=icb(il)) THEN ! cld
	6086	sax(il, i) = sax(il, i) + rrd*(tvp(il,j)-tv(il,j)) & ! cld
	6087	*(ph(il,j)-ph(il,j+1))/p(il, j) ! cld
	6088	END IF ! cld
	6089	END DO ! cld
	6090	END DO ! cld
	6091	END DO ! cld
	6092
	6093	DO i = 1, nl ! cld
	6094	DO il = 1, ncum ! cld
	6095	IF (i>=icb(il) .AND. i<=(inb(il)-1) & ! cld
	6096	.AND. sax(il,i)>0.0) THEN ! cld
	6097	wa(il, i) = sqrt(2.*sax(il,i)) ! cld
	6098	END IF ! cld
	6099	END DO ! cld
	6100	END DO ! cld
	6101
	6102	DO i = 1, nl ! cld
	6103	DO il = 1, ncum ! cld
	6104	IF (wa(il,i)>0.0) & ! cld
	6105	siga(il, i) = mac(il, i)/wa(il, i) & ! cld
	6106	rrdtvp(il, i)/p(il, i)/100./delta ! cld
	6107	siga(il, i) = min(siga(il,i), 1.0) ! cld
	6108	! IM cf. FH
	6109	IF (iflag_clw==0) THEN
	6110	qcondc(il, i) = siga(il, i)clw(il, i)(1.-ep(il,i)) & ! cld
	6111	+(1.-siga(il,i))*qcond(il, i) ! cld
	6112	ELSE IF (iflag_clw==1) THEN
	6113	qcondc(il, i) = qcond(il, i) ! cld
	6114	END IF
	6115
	6116	END DO ! cld
	6117	END DO ! cld
	6118
	6119	RETURN
	6120	END SUBROUTINE cv30_yield
	6121
	6122	! !RomP >>>
	6123	SUBROUTINE cv30_tracer(nloc, len, ncum, nd, na, ment, sij, da, phi, phi2, &
	6124	d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
	6125	IMPLICIT NONE
	6126
	6127	include "cv30param.h"
	6128
	6129	! inputs:
	6130	INTEGER ncum, nd, na, nloc, len
	6131	REAL ment(nloc, na, na), sij(nloc, na, na)
	6132	REAL clw(nloc, nd), elij(nloc, na, na)
	6133	REAL ep(nloc, na)
	6134	INTEGER icb(nloc), inb(nloc)
	6135	REAL vprecip(nloc, nd+1)
	6136	! ouputs:
	6137	REAL da(nloc, na), phi(nloc, na, na)
	6138	REAL phi2(nloc, na, na)
	6139	REAL d1a(nloc, na), dam(nloc, na)
	6140	REAL epmlmmm(nloc, na, na), eplamm(nloc, na)
	6141	! variables pour tracer dans precip de l'AA et des mel
	6142	! local variables:
	6143	INTEGER i, j, k
	6144	REAL epm(nloc, na, na)
	6145
	6146	! variables d'Emanuel : du second indice au troisieme
	6147	! ---> tab(i,k,j) -> de l origine k a l arrivee j
	6148	! ment, sij, elij
	6149	! variables personnelles : du troisieme au second indice
	6150	! ---> tab(i,j,k) -> de k a j
	6151	! phi, phi2
	6152
	6153	! initialisations
	6154	DO j = 1, na
	6155	DO i = 1, ncum
	6156	da(i, j) = 0.
	6157	d1a(i, j) = 0.
	6158	dam(i, j) = 0.
	6159	eplamm(i, j) = 0.
	6160	END DO
	6161	END DO
	6162	DO k = 1, na
	6163	DO j = 1, na
	6164	DO i = 1, ncum
	6165	epm(i, j, k) = 0.
	6166	epmlmmm(i, j, k) = 0.
	6167	phi(i, j, k) = 0.
	6168	phi2(i, j, k) = 0.
	6169	END DO
	6170	END DO
	6171	END DO
	6172
	6173	! fraction deau condensee dans les melanges convertie en precip : epm
	6174	! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
	6175	DO j = 1, na
	6176	DO k = 1, j - 1
	6177	DO i = 1, ncum
	6178	IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
	6179	! !jyg epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
	6180	epm(i, j, k) = 1. - (1.-ep(i,j))*clw(i, j)/max(elij(i,k,j), 1.E-16)
	6181	! !
	6182	epm(i, j, k) = max(epm(i,j,k), 0.0)
	6183	END IF
	6184	END DO
	6185	END DO
	6186	END DO
	6187
	6188	DO j = 1, na
	6189	DO k = 1, na
	6190	DO i = 1, ncum
	6191	IF (k>=icb(i) .AND. k<=inb(i)) THEN
	6192	eplamm(i, j) = eplamm(i, j) + ep(i, j)clw(i, j)ment(i, j, k)*(1.- &
	6193	sij(i,j,k))
	6194	END IF
	6195	END DO
	6196	END DO
	6197	END DO
	6198
	6199	DO j = 1, na
	6200	DO k = 1, j - 1
	6201	DO i = 1, ncum
	6202	IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
	6203	epmlmmm(i, j, k) = epm(i, j, k)elij(i, k, j)ment(i, k, j)
	6204	END IF
	6205	END DO
	6206	END DO
	6207	END DO
	6208
	6209	! matrices pour calculer la tendance des concentrations dans cvltr.F90
	6210	DO j = 1, na
	6211	DO k = 1, na
	6212	DO i = 1, ncum
	6213	da(i, j) = da(i, j) + (1.-sij(i,k,j))*ment(i, k, j)
	6214	phi(i, j, k) = sij(i, k, j)*ment(i, k, j)
	6215	d1a(i, j) = d1a(i, j) + ment(i, k, j)ep(i, k)(1.-sij(i,k,j))
	6216	END DO
	6217	END DO
	6218	END DO
	6219
	6220	DO j = 1, na
	6221	DO k = 1, j - 1
	6222	DO i = 1, ncum
	6223	dam(i, j) = dam(i, j) + ment(i, k, j)epm(i, j, k)(1.-ep(i,k))*(1.- &
	6224	sij(i,k,j))
	6225	phi2(i, j, k) = phi(i, j, k)*epm(i, j, k)
	6226	END DO
	6227	END DO
	6228	END DO
	6229
	6230	RETURN
	6231	END SUBROUTINE cv30_tracer
	6232	! RomP <<<
	6233
	6234	SUBROUTINE cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
	6235	vprecip, evap, ep, sig, w0, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, &
	6236	dnwd0, qcondc, wd, cape, da, phi, mp, phi2, d1a, dam, sij, elij, clw, &
	6237	epmlmmm, eplamm, wdtraina, wdtrainm,epmax_diag, iflag1, precip1, vprecip1, evap1, &
	6238	ep1, sig1, w01, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, &
	6239	dnwd01, qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, &
	6240	elij1, clw1, epmlmmm1, eplamm1, wdtraina1, wdtrainm1,epmax_diag1 &
	6241	#ifdef ISO
	6242	& ,xtprecip,fxt,xtVPrecip &
	6243	& ,xtprecip1,fxt1,xtVPrecip1 &
	6244	#ifdef DIAGISO
	6245	& , water,xtwater,qp,xtp,xtevap &
	6246	& , xtclw &
	6247	& , wdtrain,xtwdtrain,taux_cond_conv &
	6248	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	6249	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse &
	6250	& , fxt_evapprecip,m,Amp_diag,tg_save &
	6251	& , f_detrainement,q_detrainement,xt_detrainement &
	6252	& , water1,xtwater1,qp1,xtp1,xtevap1 &
	6253	& , xtclw1 &
	6254	& , wdtrain1,xtwdtrain1,taux_cond_conv1 &
	6255	& , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
	6256	& , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1 &
	6257	& , fxt_evapprecip1,Mi1,Amp_diag1,tg_save1 &
	6258	& , f_detrainement1,q_detrainement1,xt_detrainement1 &
	6259	#endif
	6260	#endif
	6261	& )
	6262
	6263	#ifdef ISO
	6264	use infotrac_phy, ONLY: ntraciso
	6265	#ifdef ISOVERIF
	6266	use isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &
	6267	iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, &
	6268	iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, &
	6269	iso_verif_positif,iso_verif_egalite_vect2D
	6270	#endif
	6271	#endif
	6272	IMPLICIT NONE
	6273
	6274	include "cv30param.h"
	6275
	6276
	6277	! inputs:
	6278	INTEGER len, ncum, nd, ntra, nloc
	6279	INTEGER idcum(nloc)
	6280	INTEGER iflag(nloc)
	6281	INTEGER inb(nloc)
	6282	REAL precip(nloc)
	6283	REAL vprecip(nloc, nd+1), evap(nloc, nd)
	6284	REAL ep(nloc, nd)
	6285	REAL sig(nloc, nd), w0(nloc, nd)
	6286	REAL ft(nloc, nd), fq(nloc, nd), fu(nloc, nd), fv(nloc, nd)
	6287	REAL ftra(nloc, nd, ntra)
	6288	REAL ma(nloc, nd)
	6289	REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
	6290	REAL qcondc(nloc, nd)
	6291	REAL wd(nloc), cape(nloc)
	6292	REAL da(nloc, nd), phi(nloc, nd, nd), mp(nloc, nd)
	6293	REAL epmax_diag(nloc) ! epmax_cape
	6294	! RomP >>>
	6295	REAL phi2(nloc, nd, nd)
	6296	REAL d1a(nloc, nd), dam(nloc, nd)
	6297	REAL wdtraina(nloc, nd), wdtrainm(nloc, nd)
	6298	REAL sij(nloc, nd, nd)
	6299	REAL elij(nloc, nd, nd), clw(nloc, nd)
	6300	REAL epmlmmm(nloc, nd, nd), eplamm(nloc, nd)
	6301	! RomP <<<
	6302	#ifdef ISO
	6303	!integer niso
	6304	real xtprecip(ntraciso,nloc)
	6305	real fxt(ntraciso,nloc,nd)
	6306	real xtVPrecip(ntraciso,nloc,nd+1)
	6307	#endif
	6308
	6309	! outputs:
	6310	INTEGER iflag1(len)
	6311	INTEGER inb1(len)
	6312	REAL precip1(len)
	6313	REAL vprecip1(len, nd+1), evap1(len, nd) !<<< RomP
	6314	REAL ep1(len, nd) !<<< RomP
	6315	REAL sig1(len, nd), w01(len, nd)
	6316	REAL ft1(len, nd), fq1(len, nd), fu1(len, nd), fv1(len, nd)
	6317	REAL ftra1(len, nd, ntra)
	6318	REAL ma1(len, nd)
	6319	REAL upwd1(len, nd), dnwd1(len, nd), dnwd01(len, nd)
	6320	REAL qcondc1(nloc, nd)
	6321	REAL wd1(nloc), cape1(nloc)
	6322	REAL da1(nloc, nd), phi1(nloc, nd, nd), mp1(nloc, nd)
	6323	REAL epmax_diag1(len) ! epmax_cape
	6324	! RomP >>>
	6325	REAL phi21(len, nd, nd)
	6326	REAL d1a1(len, nd), dam1(len, nd)
	6327	REAL wdtraina1(len, nd), wdtrainm1(len, nd)
	6328	REAL sij1(len, nd, nd)
	6329	REAL elij1(len, nd, nd), clw1(len, nd)
	6330	REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
	6331	! RomP <<<
	6332	#ifdef ISO
	6333	real xtprecip1(ntraciso,len)
	6334	real fxt1(ntraciso,len,nd)
	6335	real xtVPrecip1(ntraciso,len,nd+1)
	6336	#endif
	6337
	6338	! local variables:
	6339	INTEGER i, k, j
	6340	#ifdef ISO
	6341	integer ixt
	6342	#endif
	6343
	6344	#ifdef DIAGISO
	6345	real water(nloc,nd)
	6346	real xtwater(ntraciso,nloc,nd)
	6347	real qp(nloc,nd),xtp(ntraciso,nloc,nd)
	6348	real xtevap(ntraciso,nloc,nd)
	6349	real wdtrain(nloc,nd)
	6350	real xtwdtrain(niso,nloc,nd)
	6351	real taux_cond_conv(nloc,nd)
	6352	real xtclw(niso,nloc,nd)
	6353	real fq_detrainement(nloc,nd)
	6354	real f_detrainement(nloc,nd)
	6355	real q_detrainement(nloc,nd)
	6356	real fq_ddft(nloc,nd)
	6357	real fq_fluxmasse(nloc,nd)
	6358	real Amp_diag(nloc,nd)
	6359	real tg_save(nloc,nd) ! temperature de cond pour les isos
	6360	real fq_evapprecip(nloc,nd)
	6361	real fxt_detrainement(niso,nloc,nd)
	6362	real xt_detrainement(niso,nloc,nd)
	6363	real fxt_ddft(niso,nloc,nd)
	6364	real fxt_fluxmasse(niso,nloc,nd)
	6365	real fxt_evapprecip(niso,nloc,nd)
	6366	real m(nloc,nd)
	6367	real epmax_diag(nloc)
	6368	! real ment(nloc,nd,nd)
	6369	! real qent(nloc,nd,nd), xtent(niso,nloc,nd,nd)
	6370
	6371	real water1(len,nd)
	6372	real xtwater1(niso,len,nd)
	6373	real qp1(len,nd),xtp1(ntraciso,len,nd)
	6374	real xtevap1(niso,nloc,nd)
	6375	real wdtrain1(len,nd)
	6376	real xtwdtrain1(niso,len,nd)
	6377	real taux_cond_conv1(len,nd)
	6378	real xtclw1(niso,len,nd)
	6379	real fq_detrainement1(len,nd)
	6380	real f_detrainement1(len,nd)
	6381	real q_detrainement1(len,nd)
	6382	real fq_ddft1(len,nd)
	6383	real fq_fluxmasse1(len,nd)
	6384	real Amp_diag1(len,nd)
	6385	real tg_save1(len,nd)
	6386	real fq_evapprecip1(len,nd)
	6387	real fxt_detrainement1(niso,len,nd)
	6388	real xt_detrainement1(niso,len,nd)
	6389	real fxt_ddft1(niso,len,nd)
	6390	real fxt_fluxmasse1(niso,len,nd)
	6391	real fxt_evapprecip1(niso,len,nd)
	6392	real Mi1(nloc,nd)
	6393	real epmax_diag1(len)
	6394	! real mentbas1(nloc,nd)
	6395	! real qentbas1(nloc,nd),xtentbas1(niso,nloc,nd)
	6396	#endif
	6397
	6398	#ifdef ISOVERIF
	6399	write(,) 'cv30_routines 4293: entrée dans cv3_uncompress'
	6400	#endif
	6401	DO i = 1, ncum
	6402	precip1(idcum(i)) = precip(i)
	6403	iflag1(idcum(i)) = iflag(i)
	6404	wd1(idcum(i)) = wd(i)
	6405	inb1(idcum(i)) = inb(i)
	6406	cape1(idcum(i)) = cape(i)
	6407	epmax_diag1(idcum(i))=epmax_diag(i) ! epmax_cape
	6408	#ifdef ISO
	6409	do ixt = 1, ntraciso
	6410	xtprecip1(ixt,idcum(i))=xtprecip(ixt,i)
	6411	enddo
	6412	#endif
	6413	END DO
	6414
	6415	DO k = 1, nl
	6416	DO i = 1, ncum
	6417	vprecip1(idcum(i), k) = vprecip(i, k)
	6418	evap1(idcum(i), k) = evap(i, k) !<<< RomP
	6419	sig1(idcum(i), k) = sig(i, k)
	6420	w01(idcum(i), k) = w0(i, k)
	6421	ft1(idcum(i), k) = ft(i, k)
	6422	fq1(idcum(i), k) = fq(i, k)
	6423	fu1(idcum(i), k) = fu(i, k)
	6424	fv1(idcum(i), k) = fv(i, k)
	6425	ma1(idcum(i), k) = ma(i, k)
	6426	upwd1(idcum(i), k) = upwd(i, k)
	6427	dnwd1(idcum(i), k) = dnwd(i, k)
	6428	dnwd01(idcum(i), k) = dnwd0(i, k)
	6429	qcondc1(idcum(i), k) = qcondc(i, k)
	6430	da1(idcum(i), k) = da(i, k)
	6431	mp1(idcum(i), k) = mp(i, k)
	6432	! RomP >>>
	6433	ep1(idcum(i), k) = ep(i, k)
	6434	d1a1(idcum(i), k) = d1a(i, k)
	6435	dam1(idcum(i), k) = dam(i, k)
	6436	clw1(idcum(i), k) = clw(i, k)
	6437	eplamm1(idcum(i), k) = eplamm(i, k)
	6438	wdtraina1(idcum(i), k) = wdtraina(i, k)
	6439	wdtrainm1(idcum(i), k) = wdtrainm(i, k)
	6440	! RomP <<<
	6441	#ifdef ISO
	6442	do ixt = 1, ntraciso
	6443	fxt1(ixt,idcum(i),k)=fxt(ixt,i,k)
	6444	xtVPrecip1(ixt,idcum(i),k)=xtVPrecip(ixt,i,k)
	6445	enddo
	6446	#endif
	6447	END DO
	6448	END DO
	6449
	6450	DO i = 1, ncum
	6451	sig1(idcum(i), nd) = sig(i, nd)
	6452	END DO
	6453
	6454
	6455	#ifdef ISO
	6456	#ifdef DIAGISO
	6457	do k=1,nl
	6458	do i=1,ncum
	6459	water1(idcum(i),k)=water(i,k)
	6460	qp1(idcum(i),k)=qp(i,k)
	6461	evap1(idcum(i),k)=evap(i,k)
	6462	Mp1(idcum(i),k)=Mp(i,k)
	6463	ep1(idcum(i),k)=ep(i,k)
	6464	wdtrain1(idcum(i),k)=wdtrain(i,k)
	6465	taux_cond_conv1(idcum(i),k)=taux_cond_conv(i,k)
	6466	clw1(idcum(i),k)=clw(i,k)
	6467	fq_detrainement1(idcum(i),k)=fq_detrainement(i,k)
	6468	f_detrainement1(idcum(i),k)=f_detrainement(i,k)
	6469	q_detrainement1(idcum(i),k)=q_detrainement(i,k)
	6470	fq_ddft1(idcum(i),k)=fq_ddft(i,k)
	6471	fq_fluxmasse1(idcum(i),k)=fq_fluxmasse(i,k)
	6472	Amp_diag1(idcum(i),k)=Amp_diag(i,k)
	6473	tg_save1(idcum(i),k)=tg_save(i,k)
	6474	#ifdef ISOVERIF
	6475	call iso_verif_positif(tg_save(i,k)-Tmin_verif, &
	6476	& 'cv30_routines 5763')
	6477	call iso_verif_positif(abs(fq_ddft(i,k))*86400-0.1, &
	6478	& 'cv30_routines 5764')
	6479	call iso_verif_positif(abs(fq_detrainement(i,k))*86400-0.1, &
	6480	& 'cv30_routines 5765')
	6481	#endif
	6482	fq_evapprecip1(idcum(i),k)=fq_evapprecip(i,k)
	6483	Mi1(idcum(i),k)=m(i,k)
	6484	! mentbas1(idcum(i),k)=ment(i,k,1)
	6485	! qentbas1(idcum(i),k)=qent(i,k,1)
	6486	do ixt = 1, niso
	6487	xtwater1(ixt,idcum(i),k)=xtwater(ixt,i,k)
	6488	xtp1(ixt,idcum(i),k)=xtp(ixt,i,k)
	6489	xtevap1(ixt,idcum(i),k)=xtevap(ixt,i,k)
	6490	xtwdtrain1(ixt,idcum(i),k)=xtwdtrain(ixt,i,k)
	6491	xtclw1(ixt,idcum(i),k)=xtclw(ixt,i,k)
	6492	fxt_detrainement1(ixt,idcum(i),k)=fxt_detrainement(ixt,i,k)
	6493	xt_detrainement1(ixt,idcum(i),k)=xt_detrainement(ixt,i,k)
	6494	fxt_ddft1(ixt,idcum(i),k)=fxt_ddft(ixt,i,k)
	6495	fxt_fluxmasse1(ixt,idcum(i),k)=fxt_fluxmasse(ixt,i,k)
	6496	fxt_evapprecip1(ixt,idcum(i),k)=fxt_evapprecip(ixt,i,k)
	6497	! xtentbas1(ixt,idcum(i),k)=xtent(ixt,i,k,1)
	6498	enddo
	6499	#ifdef ISOTRAC
	6500	do ixt = 1+niso,ntraciso
	6501	xtp1(ixt,idcum(i),k)=xtp(ixt,i,k)
	6502	enddo
	6503	#endif
	6504	enddo
	6505	enddo
	6506	do i=1,ncum
	6507	epmax_diag1(idcum(i))=epmax_diag(i)
	6508	enddo
	6509
	6510	#endif
	6511	#endif
	6512
	6513	! do 2100 j=1,ntra
	6514	! do 2110 k=1,nd ! oct3
	6515	! do 2120 i=1,ncum
	6516	! ftra1(idcum(i),k,j)=ftra(i,k,j)
	6517	! 2120 continue
	6518	! 2110 continue
	6519	! 2100 continue
	6520	DO j = 1, nd
	6521	DO k = 1, nd
	6522	DO i = 1, ncum
	6523	sij1(idcum(i), k, j) = sij(i, k, j)
	6524	phi1(idcum(i), k, j) = phi(i, k, j)
	6525	phi21(idcum(i), k, j) = phi2(i, k, j)
	6526	elij1(idcum(i), k, j) = elij(i, k, j)
	6527	epmlmmm1(idcum(i), k, j) = epmlmmm(i, k, j)
	6528	END DO
	6529	END DO
	6530	END DO
	6531
	6532	RETURN
	6533	END SUBROUTINE cv30_uncompress
	6534
	6535	subroutine cv30_epmax_fn_cape(nloc,ncum,nd &
	6536	,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
	6537	,epmax_diag)
	6538	implicit none
	6539
	6540	! On fait varier epmax en fn de la cape
	6541	! Il faut donc recalculer ep, et hp qui a déjà été calculé et
	6542	! qui en dépend
	6543	! Toutes les autres variables fn de ep sont calculées plus bas.
	6544
	6545	#include "cvthermo.h"
	6546	#include "cv30param.h"
	6547	#include "conema3.h"
	6548
	6549	! inputs:
	6550	integer ncum, nd, nloc
	6551	integer icb(nloc), inb(nloc)
	6552	real cape(nloc)
	6553	real clw(nloc,nd),lv(nloc,nd),t(nloc,nd),h(nloc,nd)
	6554	integer nk(nloc)
	6555	! inouts:
	6556	real ep(nloc,nd)
	6557	real hp(nloc,nd)
	6558	! outputs ou local
	6559	real epmax_diag(nloc)
	6560	! locals
	6561	integer i,k
	6562	real hp_bak(nloc,nd)
	6563
	6564	! on recalcule ep et hp
	6565
	6566	if (coef_epmax_cape.gt.1e-12) then
	6567	do i=1,ncum
	6568	epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
	6569	do k=1,nl
	6570	ep(i,k)=ep(i,k)/epmax*epmax_diag(i)
	6571	ep(i,k)=amax1(ep(i,k),0.0)
	6572	ep(i,k)=amin1(ep(i,k),epmax_diag(i))
	6573	enddo
	6574	enddo
	6575
	6576	! On recalcule hp:
	6577	do k=1,nl
	6578	do i=1,ncum
	6579	hp_bak(i,k)=hp(i,k)
	6580	enddo
	6581	enddo
	6582	do k=1,nlp
	6583	do i=1,ncum
	6584	hp(i,k)=h(i,k)
	6585	enddo
	6586	enddo
	6587	do k=minorig+1,nl
	6588	do i=1,ncum
	6589	if((k.ge.icb(i)).and.(k.le.inb(i)))then
	6590	hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)t(i,k))ep(i,k)*clw(i,k)
	6591	endif
	6592	enddo
	6593	enddo !do k=minorig+1,n
	6594	! write(,) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
	6595	do i=1,ncum
	6596	do k=1,nl
	6597	if (abs(hp_bak(i,k)-hp(i,k)).gt.0.01) then
	6598	write(,) 'i,k=',i,k
	6599	write(,) 'coef_epmax_cape=',coef_epmax_cape
	6600	write(,) 'epmax_diag(i)=',epmax_diag(i)
	6601	write(,) 'ep(i,k)=',ep(i,k)
	6602	write(,) 'hp(i,k)=',hp(i,k)
	6603	write(,) 'hp_bak(i,k)=',hp_bak(i,k)
	6604	write(,) 'h(i,k)=',h(i,k)
	6605	write(,) 'nk(i)=',nk(i)
	6606	write(,) 'h(i,nk(i))=',h(i,nk(i))
	6607	write(,) 'lv(i,k)=',lv(i,k)
	6608	write(,) 't(i,k)=',t(i,k)
	6609	write(,) 'clw(i,k)=',clw(i,k)
	6610	write(,) 'cpd,cpv=',cpd,cpv
	6611	stop
	6612	endif
	6613	enddo !do k=1,nl
	6614	enddo !do i=1,ncum
	6615	endif !if (coef_epmax_cape.gt.1e-12) then
	6616
	6617	return
	6618	end subroutine cv30_epmax_fn_cape
	6619
	6620

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

Download in other formats:

Original Format