Context Navigation

cv_driver.F90 @ 5144

Last change on this file since 5144 was 5144, checked in by abarral, 3 months ago
Put YOMCST.h into modules
Property svn:keywords set to `Id`
File size: 43.5 KB

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

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

Download in other formats:

Original Format