Context Navigation

cva_driver.F90 @ 2248

Last change on this file since 2248 was 2207, checked in by fhourdin, 10 years ago
Bi-gauussienne, suite.
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 39.6 KB

Rev	Line
[1992]	1
[1403]	2	! $Id: cva_driver.F90 2207 2015-02-13 08:40:30Z lguez $
[1774]	3
[2007]	4	SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, &
	5	iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
	6	delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
	7	u1, v1, tra1, &
	8	p1, ph1, &
[2201]	9	Ale1, Alp1, omega1, &
[2007]	10	sig1feed1, sig2feed1, wght1, &
	11	iflag1, ft1, fq1, fu1, fv1, ftra1, &
	12	precip1, kbas1, ktop1, &
	13	cbmf1, plcl1, plfc1, wbeff1, &
	14	sig1, w01, & !input/output
	15	ptop21, sigd1, &
	16	ma1, mip1, Vprecip1, upwd1, dnwd1, dnwd01, &
	17	qcondc1, wd1, &
	18	cape1, cin1, tvp1, &
	19	ftd1, fqd1, &
	20	Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
	21	lalim_conv, &
	22	!! da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, & ! RomP
	23	!! elij1,evap1,ep1,epmlmMm1,eplaMm1, & ! RomP
	24	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
	25	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP, RL
[2207]	26	wdtrainA1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &
[2205]	27	coefw_cld_cv) ! RomP, AJ
[2007]	28	! **************************************************************
	29	! *
	30	! CV_DRIVER *
	31	! *
	32	! *
	33	! written by : Sandrine Bony-Lena , 17/05/2003, 11.19.41 *
	34	! modified by : *
	35	! **************************************************************
	36	! **************************************************************
[1403]	37
[1992]	38	USE dimphy
	39	IMPLICIT NONE
[879]	40
[2007]	41	! .............................START PROLOGUE............................
[879]	42
	43
[2007]	44	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
	45	! The "1" is removed for the corresponding compressed variables.
	46	! PARAMETERS:
	47	! Name Type Usage Description
	48	! ---------- ---------- ------- ----------------------------
[879]	49
[2007]	50	! len Integer Input first (i) dimension
	51	! nd Integer Input vertical (k) dimension
	52	! ndp1 Integer Input nd + 1
	53	! ntra Integer Input number of tracors
	54	! iflag_con Integer Input version of convect (3/4)
	55	! iflag_mix Integer Input version of mixing (0/1/2)
	56	! iflag_ice_thermo Integer Input accounting for ice thermodynamics (0/1)
	57	! iflag_clos Integer Input version of closure (0/1)
[2205]	58	! tau_cld_cv Real Input characteristic time of dissipation of mixing fluxes
	59	! coefw_cld_cv Real Input coefficient for updraft velocity in convection
[2007]	60	! ok_conserv_q Logical Input when true corrections for water conservation are swtiched on
	61	! delt Real Input time step
	62	! t1 Real Input temperature (sat draught envt)
	63	! q1 Real Input specific hum (sat draught envt)
	64	! qs1 Real Input sat specific hum (sat draught envt)
	65	! t1_wake Real Input temperature (unsat draught envt)
	66	! q1_wake Real Input specific hum(unsat draught envt)
	67	! qs1_wake Real Input sat specific hum(unsat draughts envt)
	68	! s1_wake Real Input fractionnal area covered by wakes
	69	! u1 Real Input u-wind
	70	! v1 Real Input v-wind
	71	! tra1 Real Input tracors
	72	! p1 Real Input full level pressure
	73	! ph1 Real Input half level pressure
	74	! ALE1 Real Input Available lifting Energy
	75	! ALP1 Real Input Available lifting Power
	76	! sig1feed1 Real Input sigma coord at lower bound of feeding layer
	77	! sig2feed1 Real Input sigma coord at upper bound of feeding layer
	78	! wght1 Real Input weight density determining the feeding mixture
	79	! iflag1 Integer Output flag for Emanuel conditions
	80	! ft1 Real Output temp tend
	81	! fq1 Real Output spec hum tend
	82	! fu1 Real Output u-wind tend
	83	! fv1 Real Output v-wind tend
	84	! ftra1 Real Output tracor tend
	85	! precip1 Real Output precipitation
	86	! kbas1 Integer Output cloud base level
	87	! ktop1 Integer Output cloud top level
	88	! cbmf1 Real Output cloud base mass flux
	89	! sig1 Real In/Out section adiabatic updraft
	90	! w01 Real In/Out vertical velocity within adiab updraft
	91	! ptop21 Real In/Out top of entraining zone
	92	! Ma1 Real Output mass flux adiabatic updraft
	93	! mip1 Real Output mass flux shed by the adiabatic updraft
	94	! Vprecip1 Real Output vertical profile of precipitations
	95	! upwd1 Real Output total upward mass flux (adiab+mixed)
	96	! dnwd1 Real Output saturated downward mass flux (mixed)
	97	! dnwd01 Real Output unsaturated downward mass flux
	98	! qcondc1 Real Output in-cld mixing ratio of condensed water
	99	! wd1 Real Output downdraft velocity scale for sfc fluxes
	100	! cape1 Real Output CAPE
	101	! cin1 Real Output CIN
	102	! tvp1 Real Output adiab lifted parcell virt temp
	103	! ftd1 Real Output precip temp tend
	104	! fqt1 Real Output precip spec hum tend
	105	! Plim11 Real Output
	106	! Plim21 Real Output
	107	! asupmax1 Real Output
	108	! supmax01 Real Output
	109	! asupmaxmin1 Real Output
[879]	110
[2007]	111	! ftd1 Real Output Array of temperature tendency due to precipitations (K/s) of dimension ND,
	112	! defined at same grid levels as T, Q, QS and P.
[879]	113
[2007]	114	! fqd1 Real Output Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
	115	! of dimension ND, defined at same grid levels as T, Q, QS and P.
[879]	116
[2007]	117	! wdtrainA1 Real Output precipitation detrained from adiabatic draught;
	118	! used in tracer transport (cvltr)
	119	! wdtrainM1 Real Output precipitation detrained from mixed draughts;
	120	! used in tracer transport (cvltr)
	121	! da1 Real Output used in tracer transport (cvltr)
	122	! phi1 Real Output used in tracer transport (cvltr)
	123	! mp1 Real Output used in tracer transport (cvltr)
[2207]	124	! qtc1 Real Output specific humidity in convection
	125	! sigt1 Real Output surface fraction in adiabatic updrafts
[2007]	126	! phi21 Real Output used in tracer transport (cvltr)
	127
	128	! d1a1 Real Output used in tracer transport (cvltr)
	129	! dam1 Real Output used in tracer transport (cvltr)
	130
	131	! epmlmMm1 Real Output used in tracer transport (cvltr)
	132	! eplaMm1 Real Output used in tracer transport (cvltr)
	133
	134	! evap1 Real Output
	135	! ep1 Real Output
	136	! sigij1 Real Output used in tracer transport (cvltr)
	137	! elij1 Real Output
	138	! wghti1 Real Output final weight of the feeding layers,
	139	! used in tracer transport (cvltr)
[879]	140
	141
[2007]	142	! S. Bony, Mar 2002:
	143	! * Several modules corresponding to different physical processes
	144	! * Several versions of convect may be used:
	145	! - iflag_con=3: version lmd (previously named convect3)
	146	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
	147	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
	148	! S. Bony, Oct 2002:
	149	! * Vectorization of convect3 (ie version lmd)
[879]	150
[2007]	151	! ..............................END PROLOGUE.............................
[879]	152
	153
[1992]	154	include "dimensions.h"
[2007]	155	!!!!!#include "dimphy.h"
[1992]	156	include 'iniprint.h'
[879]	157
	158
[2007]	159	! Input
[1992]	160	INTEGER len
	161	INTEGER nd
	162	INTEGER ndp1
	163	INTEGER ntra
	164	INTEGER iflag_con
	165	INTEGER iflag_mix
	166	INTEGER iflag_ice_thermo
	167	INTEGER iflag_clos
[2007]	168	LOGICAL ok_conserv_q
[2205]	169	REAL tau_cld_cv
	170	REAL coefw_cld_cv
[1992]	171	REAL delt
	172	REAL t1(len, nd)
	173	REAL q1(len, nd)
	174	REAL qs1(len, nd)
	175	REAL t1_wake(len, nd)
	176	REAL q1_wake(len, nd)
	177	REAL qs1_wake(len, nd)
	178	REAL s1_wake(len)
	179	REAL u1(len, nd)
	180	REAL v1(len, nd)
	181	REAL tra1(len, nd, ntra)
	182	REAL p1(len, nd)
	183	REAL ph1(len, ndp1)
[2007]	184	REAL Ale1(len)
	185	REAL Alp1(len)
[2201]	186	REAL omega1(len,nd)
[1992]	187	REAL sig1feed1 ! pressure at lower bound of feeding layer
	188	REAL sig2feed1 ! pressure at upper bound of feeding layer
	189	REAL wght1(nd) ! weight density determining the feeding mixture
[879]	190
[2007]	191	! Output
[1992]	192	INTEGER iflag1(len)
	193	REAL ft1(len, nd)
	194	REAL fq1(len, nd)
	195	REAL fu1(len, nd)
	196	REAL fv1(len, nd)
	197	REAL ftra1(len, nd, ntra)
	198	REAL precip1(len)
	199	INTEGER kbas1(len)
	200	INTEGER ktop1(len)
	201	REAL cbmf1(len)
	202	REAL plcl1(klon)
	203	REAL plfc1(klon)
	204	REAL wbeff1(klon)
	205	REAL sig1(len, klev) !input/output
	206	REAL w01(len, klev) !input/output
	207	REAL ptop21(len)
	208	REAL sigd1(len)
	209	REAL ma1(len, nd)
	210	REAL mip1(len, nd)
[2007]	211	! real Vprecip1(len,nd)
[1992]	212	REAL vprecip1(len, nd+1)
	213	REAL upwd1(len, nd)
	214	REAL dnwd1(len, nd)
	215	REAL dnwd01(len, nd)
	216	REAL qcondc1(len, nd) ! cld
	217	REAL wd1(len) ! gust
	218	REAL cape1(len)
	219	REAL cin1(len)
	220	REAL tvp1(len, nd)
[879]	221
[2007]	222	!AC!
	223	!! real da1(len,nd),phi1(len,nd,nd)
	224	!! real da(len,nd),phi(len,nd,nd)
	225	!AC!
[1992]	226	REAL ftd1(len, nd)
	227	REAL fqd1(len, nd)
[2007]	228	REAL Plim11(len)
	229	REAL Plim21(len)
[1992]	230	REAL asupmax1(len, nd)
	231	REAL supmax01(len)
	232	REAL asupmaxmin1(len)
	233	INTEGER lalim_conv(len)
[2207]	234	REAL qtc1(len, nd) ! cld
	235	REAL sigt1(len, nd) ! cld
	236
[2007]	237	! RomP >>>
	238	REAL wdtrainA1(len, nd), wdtrainM1(len, nd)
[1992]	239	REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
[2007]	240	REAL epmlmMm1(len, nd, nd), eplaMm1(len, nd)
[1992]	241	REAL evap1(len, nd), ep1(len, nd)
	242	REAL sigij1(len, nd, nd), elij1(len, nd, nd)
[2007]	243	!JYG,RL
	244	REAL wghti1(len, nd) ! final weight of the feeding layers
	245	!JYG,RL
[1992]	246	REAL phi21(len, nd, nd)
	247	REAL d1a1(len, nd), dam1(len, nd)
[2007]	248	! RomP <<<
[879]	249
[2007]	250	! -------------------------------------------------------------------
	251	! Prolog by Kerry Emanuel.
	252	! -------------------------------------------------------------------
	253	! --- ARGUMENTS
	254	! -------------------------------------------------------------------
	255	! --- On input:
[879]	256
[2007]	257	! t: Array of absolute temperature (K) of dimension ND, with first
	258	! index corresponding to lowest model level. Note that this array
	259	! will be altered by the subroutine if dry convective adjustment
	260	! occurs and if IPBL is not equal to 0.
[879]	261
[2007]	262	! q: Array of specific humidity (gm/gm) of dimension ND, with first
	263	! index corresponding to lowest model level. Must be defined
	264	! at same grid levels as T. Note that this array will be altered
	265	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	266
[2007]	267	! qs: Array of saturation specific humidity of dimension ND, with first
	268	! index corresponding to lowest model level. Must be defined
	269	! at same grid levels as T. Note that this array will be altered
	270	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	271
[2007]	272	! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
	273	! of dimension ND, with first index corresponding to lowest model level.
[879]	274
[2007]	275	! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
	276	! of dimension ND, with first index corresponding to lowest model level.
	277	! Must be defined at same grid levels as T.
[879]	278
[2007]	279	! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
	280	! of dimension ND, with first index corresponding to lowest model level.
	281	! Must be defined at same grid levels as T.
[879]	282
[2007]	283	! s_wake: Array of fractionnal area occupied by the wakes.
[879]	284
[2007]	285	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
	286	! index corresponding with the lowest model level. Defined at
	287	! same levels as T. Note that this array will be altered if
	288	! dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	289
[2007]	290	! v: Same as u but for meridional velocity.
[1146]	291
[2007]	292	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
	293	! where NTRA is the number of different tracers. If no
	294	! convective tracer transport is needed, define a dummy
	295	! input array of dimension (ND,1). Tracers are defined at
	296	! same vertical levels as T. Note that this array will be altered
	297	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	298
[2007]	299	! p: Array of pressure (mb) of dimension ND, with first
	300	! index corresponding to lowest model level. Must be defined
	301	! at same grid levels as T.
[879]	302
[2007]	303	! ph: Array of pressure (mb) of dimension ND+1, with first index
	304	! corresponding to lowest level. These pressures are defined at
	305	! levels intermediate between those of P, T, Q and QS. The first
	306	! value of PH should be greater than (i.e. at a lower level than)
	307	! the first value of the array P.
[879]	308
[2007]	309	! ALE: Available lifting Energy
[879]	310
[2007]	311	! ALP: Available lifting Power
[879]	312
[2007]	313	! nl: The maximum number of levels to which convection can penetrate, plus 1.
	314	! NL MUST be less than or equal to ND-1.
[879]	315
[2007]	316	! delt: The model time step (sec) between calls to CONVECT
[879]	317
[2007]	318	! ----------------------------------------------------------------------------
	319	! --- On Output:
[879]	320
[2007]	321	! iflag: An output integer whose value denotes the following:
	322	! VALUE INTERPRETATION
	323	! ----- --------------
	324	! 0 Moist convection occurs.
	325	! 1 Moist convection occurs, but a CFL condition
	326	! on the subsidence warming is violated. This
	327	! does not cause the scheme to terminate.
	328	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
	329	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
	330	! 4 No moist convection; atmosphere is not
	331	! unstable
	332	! 6 No moist convection because ihmin le minorig.
	333	! 7 No moist convection because unreasonable
	334	! parcel level temperature or specific humidity.
	335	! 8 No moist convection: lifted condensation
	336	! level is above the 200 mb level.
	337	! 9 No moist convection: cloud base is higher
	338	! then the level NL-1.
[879]	339
[2007]	340	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
	341	! grid levels as T, Q, QS and P.
[1652]	342
[2007]	343	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
	344	! defined at same grid levels as T, Q, QS and P.
[1652]	345
[2007]	346	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
	347	! defined at same grid levels as T.
[1652]	348
[2007]	349	! fv: Same as FU, but for forcing of meridional velocity.
[879]	350
[2007]	351	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
	352	! second, defined at same levels as T. Dimensioned (ND,NTRA).
[879]	353
[2007]	354	! precip: Scalar convective precipitation rate (mm/day).
[879]	355
[2007]	356	! wd: A convective downdraft velocity scale. For use in surface
	357	! flux parameterizations. See convect.ps file for details.
[879]	358
[2007]	359	! tprime: A convective downdraft temperature perturbation scale (K).
	360	! For use in surface flux parameterizations. See convect.ps
	361	! file for details.
[879]	362
[2007]	363	! qprime: A convective downdraft specific humidity
	364	! perturbation scale (gm/gm).
	365	! For use in surface flux parameterizations. See convect.ps
	366	! file for details.
[1992]	367
[2007]	368	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
	369	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
	370	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
	371	! by the calling program between calls to CONVECT.
[1992]	372
[2007]	373	! det: Array of detrainment mass flux of dimension ND.
	374	! -------------------------------------------------------------------
[1992]	375
[2007]	376	! Local (non compressed) arrays
[1992]	377
	378
	379	INTEGER i, k, n, il, j
	380	INTEGER nword1, nword2, nword3, nword4
	381	INTEGER icbmax
	382	INTEGER nk1(klon)
	383	INTEGER icb1(klon)
	384	INTEGER icbs1(klon)
	385
	386	LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
	387	LOGICAL, SAVE :: debut = .TRUE.
[2007]	388	!$OMP THREADPRIVATE(debut)
[1992]	389
	390	REAL tnk1(klon)
	391	REAL thnk1(klon)
	392	REAL qnk1(klon)
	393	REAL gznk1(klon)
	394	REAL pnk1(klon)
	395	REAL qsnk1(klon)
	396	REAL unk1(klon)
	397	REAL vnk1(klon)
	398	REAL cpnk1(klon)
	399	REAL hnk1(klon)
	400	REAL pbase1(klon)
	401	REAL buoybase1(klon)
	402
	403	REAL lf1(klon, klev), lf1_wake(klon, klev)
	404	REAL lv1(klon, klev), lv1_wake(klon, klev)
	405	REAL cpn1(klon, klev), cpn1_wake(klon, klev)
	406	REAL tv1(klon, klev), tv1_wake(klon, klev)
	407	REAL gz1(klon, klev), gz1_wake(klon, klev)
	408	REAL hm1(klon, klev), hm1_wake(klon, klev)
	409	REAL h1(klon, klev), h1_wake(klon, klev)
	410	REAL tp1(klon, klev)
	411	REAL clw1(klon, klev)
	412	REAL th1(klon, klev), th1_wake(klon, klev)
	413
	414	REAL bid(klon, klev) ! dummy array
	415
	416	INTEGER ncum
	417
	418	INTEGER j1feed(klon)
	419	INTEGER j2feed(klon)
	420	REAL p1feed1(len) ! pressure at lower bound of feeding layer
	421	REAL p2feed1(len) ! pressure at upper bound of feeding layer
[2007]	422	!JYG,RL
	423	!! real wghti1(len,nd) ! weights of the feeding layers
	424	!JYG,RL
[1992]	425
[2007]	426	! (local) compressed fields:
[1992]	427
	428	INTEGER nloc
[2007]	429	! parameter (nloc=klon) ! pour l'instant
[1992]	430
	431	INTEGER idcum(nloc)
	432	INTEGER iflag(nloc), nk(nloc), icb(nloc)
	433	INTEGER nent(nloc, klev)
	434	INTEGER icbs(nloc)
	435	INTEGER inb(nloc), inbis(nloc)
	436
	437	REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
	438	REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
	439	REAL t_wake(nloc, klev), q_wake(nloc, klev), qs_wake(nloc, klev)
	440	REAL s_wake(nloc)
	441	REAL u(nloc, klev), v(nloc, klev)
	442	REAL gz(nloc, klev), h(nloc, klev), hm(nloc, klev)
	443	REAL h_wake(nloc, klev), hm_wake(nloc, klev)
	444	REAL lv(nloc, klev), lf(nloc, klev), cpn(nloc, klev)
	445	REAL lv_wake(nloc, klev), lf_wake(nloc, klev), cpn_wake(nloc, klev)
	446	REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
	447	REAL tv_wake(nloc, klev)
	448	REAL clw(nloc, klev)
	449	REAL dph(nloc, klev)
	450	REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
	451	REAL th_wake(nloc, klev)
	452	REAL tvp(nloc, klev)
	453	REAL sig(nloc, klev), w0(nloc, klev), ptop2(nloc)
	454	REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
	455	REAL buoy(nloc, klev)
	456	REAL cape(nloc)
	457	REAL cin(nloc)
	458	REAL m(nloc, klev)
	459	REAL ment(nloc, klev, klev), sigij(nloc, klev, klev)
	460	REAL qent(nloc, klev, klev)
	461	REAL hent(nloc, klev, klev)
	462	REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
	463	REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
	464	REAL elij(nloc, klev, klev)
	465	REAL supmax(nloc, klev)
[2007]	466	REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
[2201]	467	REAL omega(nloc,klev)
[1992]	468	REAL sigd(nloc)
[2007]	469	! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
	470	! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
	471	! real b(nloc,klev), sigd(nloc)
	472	! save mp,qp,up,vp,wt,water,evap,b
[1992]	473	REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
	474	REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
	475	REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
	476	REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
[2007]	477	!$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
[1992]	478	REAL ft(nloc, klev), fq(nloc, klev)
	479	REAL ftd(nloc, klev), fqd(nloc, klev)
	480	REAL fu(nloc, klev), fv(nloc, klev)
	481	REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
	482	REAL ma(nloc, klev), mip(nloc, klev), tls(nloc, klev)
	483	REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
	484	REAL precip(nloc)
[2007]	485	! real Vprecip(nloc,klev)
[1992]	486	REAL vprecip(nloc, klev+1)
	487	REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
	488	REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
[2007]	489	REAL qcondc(nloc, klev) ! cld
	490	REAL wd(nloc) ! gust
	491	REAL Plim1(nloc), plim2(nloc)
[1992]	492	REAL asupmax(nloc, klev)
	493	REAL supmax0(nloc)
	494	REAL asupmaxmin(nloc)
	495
	496	REAL tnk(nloc), qnk(nloc), gznk(nloc)
	497	REAL wghti(nloc, nd)
	498	REAL hnk(nloc), unk(nloc), vnk(nloc)
	499
[2207]	500	REAL qtc(nloc, klev) ! cld
	501	REAL sigt(nloc, klev) ! cld
	502
[2007]	503	! RomP >>>
	504	REAL wdtrainA(nloc, klev), wdtrainM(nloc, klev)
[1992]	505	REAL da(len, nd), phi(len, nd, nd)
[2007]	506	REAL epmlmMm(nloc, klev, klev), eplaMm(nloc, klev)
[1992]	507	REAL phi2(len, nd, nd)
	508	REAL d1a(len, nd), dam(len, nd)
[2007]	509	! RomP <<<
[1992]	510
	511	LOGICAL, SAVE :: first = .TRUE.
[2007]	512	!$OMP THREADPRIVATE(first)
[1992]	513	CHARACTER (LEN=20) :: modname = 'cva_driver'
	514	CHARACTER (LEN=80) :: abort_message
	515
	516
[2007]	517	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
	518	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
[1992]	519
[2007]	520	! -------------------------------------------------------------------
	521	! --- SET CONSTANTS AND PARAMETERS
	522	! -------------------------------------------------------------------
[1992]	523
	524	IF (first) THEN
	525	ALLOCATE (mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
	526	ALLOCATE (vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
	527	ALLOCATE (ice(nloc,klev), fondue(nloc,klev))
	528	ALLOCATE (evap(nloc,klev), b(nloc,klev))
	529	ALLOCATE (frac(nloc,klev), faci(nloc,klev))
	530	first = .FALSE.
	531	END IF
[2007]	532	! -- set simulation flags:
	533	! (common cvflag)
[1992]	534
	535	CALL cv_flag(iflag_ice_thermo)
	536
[2007]	537	! -- set thermodynamical constants:
	538	! (common cvthermo)
[1992]	539
	540	CALL cv_thermo(iflag_con)
	541
[2007]	542	! -- set convect parameters
[1992]	543
[2007]	544	! includes microphysical parameters and parameters that
	545	! control the rate of approach to quasi-equilibrium)
	546	! (common cvparam)
[1992]	547
	548	IF (iflag_con==3) THEN
	549	CALL cv3_param(nd, delt)
	550
	551	END IF
	552
	553	IF (iflag_con==4) THEN
	554	CALL cv_param(nd)
	555	END IF
	556
[2007]	557	! ---------------------------------------------------------------------
	558	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
	559	! ---------------------------------------------------------------------
[1992]	560	nword1 = len
	561	nword2 = len*nd
	562	nword3 = lenndntra
	563	nword4 = lenndnd
	564
	565	iflag1(:) = 0
	566	ktop1(:) = 0
	567	kbas1(:) = 0
	568	ft1(:, :) = 0.0
	569	fq1(:, :) = 0.0
	570	fu1(:, :) = 0.0
	571	fv1(:, :) = 0.0
	572	ftra1(:, :, :) = 0.
	573	precip1(:) = 0.
	574	cbmf1(:) = 0.
	575	ptop21(:) = 0.
	576	sigd1(:) = 0.
	577	ma1(:, :) = 0.
	578	mip1(:, :) = 0.
	579	vprecip1(:, :) = 0.
	580	upwd1(:, :) = 0.
	581	dnwd1(:, :) = 0.
	582	dnwd01(:, :) = 0.
	583	qcondc1(:, :) = 0.
	584	wd1(:) = 0.
	585	cape1(:) = 0.
	586	cin1(:) = 0.
	587	tvp1(:, :) = 0.
	588	ftd1(:, :) = 0.
	589	fqd1(:, :) = 0.
[2007]	590	Plim11(:) = 0.
	591	Plim21(:) = 0.
[1992]	592	asupmax1(:, :) = 0.
	593	supmax01(:) = 0.
	594	asupmaxmin1(:) = 0.
	595
	596	DO il = 1, len
	597	cin1(il) = -100000.
	598	cape1(il) = -1.
	599	END DO
	600
	601	IF (iflag_con==3) THEN
	602	DO il = 1, len
	603	sig1(il, nd) = sig1(il, nd) + 1.
	604	sig1(il, nd) = amin1(sig1(il,nd), 12.1)
	605	END DO
	606	END IF
	607
[2007]	608	! RomP >>>
[2207]	609	sigt1(:, :) = 0.
	610	qtc1(:, :) = 0.
[2007]	611	wdtrainA1(:, :) = 0.
	612	wdtrainM1(:, :) = 0.
[1992]	613	da1(:, :) = 0.
	614	phi1(:, :, :) = 0.
[2007]	615	epmlmMm1(:, :, :) = 0.
	616	eplaMm1(:, :) = 0.
[1992]	617	mp1(:, :) = 0.
	618	evap1(:, :) = 0.
	619	ep1(:, :) = 0.
	620	sigij1(:, :, :) = 0.
	621	elij1(:, :, :) = 0.
	622	phi21(:, :, :) = 0.
	623	d1a1(:, :) = 0.
	624	dam1(:, :) = 0.
[2007]	625	! RomP <<<
	626	! ---------------------------------------------------------------------
	627	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
	628	! ---------------------------------------------------------------------
[1992]	629
	630	DO il = 1, nloc
	631	coef_clos(il) = 1.
	632	END DO
	633
[2007]	634	! --------------------------------------------------------------------
	635	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	636	! --------------------------------------------------------------------
[1992]	637
	638	IF (iflag_con==3) THEN
	639
	640	IF (debut) THEN
	641	PRINT *, 'Emanuel version 3 nouvelle'
	642	END IF
[2007]	643	! print*,'t1, q1 ',t1,q1
	644	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
	645	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
[1992]	646
	647
[2007]	648	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
	649	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
	650	h1_wake, bid, th1_wake)
[1992]	651
	652	END IF
	653
	654	IF (iflag_con==4) THEN
	655	PRINT *, 'Emanuel version 4 '
[2007]	656	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
	657	lv1, cpn1, tv1, gz1, h1, hm1)
[1992]	658	END IF
	659
[2007]	660	! --------------------------------------------------------------------
	661	! --- CONVECTIVE FEED
	662	! --------------------------------------------------------------------
[1992]	663
[2007]	664	! compute feeding layer potential temperature and mixing ratio :
[1992]	665
[2007]	666	! get bounds of feeding layer
[1992]	667
[2007]	668	! test niveaux couche alimentation KE
[1992]	669	IF (sig1feed1==sig2feed1) THEN
	670	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
	671	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
	672	abort_message = ''
	673	CALL abort_gcm(modname, abort_message, 1)
	674	END IF
	675
	676	DO i = 1, len
	677	p1feed1(i) = sig1feed1*ph1(i, 1)
	678	p2feed1(i) = sig2feed1*ph1(i, 1)
[2007]	679	!test maf
	680	! p1feed1(i)=ph1(i,1)
	681	! p2feed1(i)=ph1(i,2)
	682	! p2feed1(i)=ph1(i,3)
	683	!testCR: on prend la couche alim des thermiques
	684	! p2feed1(i)=ph1(i,lalim_conv(i)+1)
	685	! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
[1992]	686	END DO
	687
	688	IF (iflag_con==3) THEN
	689	END IF
	690	DO i = 1, len
[2007]	691	! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
[1992]	692	END DO
	693	IF (iflag_con==3) THEN
	694
[2007]	695	! print*, 'IFLAG1 avant cv3_feed'
	696	! print*,'len,nd',len,nd
	697	! write(*,'(64i1)') iflag1(2:klon-1)
[1992]	698
[2007]	699	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
	700	t1, q1, u1, v1, p1, ph1, hm1, gz1, &
	701	p1feed1, p2feed1, wght1, &
	702	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
	703	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
[1992]	704	END IF
	705
[2007]	706	! print*, 'IFLAG1 apres cv3_feed'
	707	! print*,'len,nd',len,nd
	708	! write(*,'(64i1)') iflag1(2:klon-1)
[1992]	709
	710	IF (iflag_con==4) THEN
[2007]	711	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
	712	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
[1992]	713	END IF
	714
[2007]	715	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
[1992]	716
[2007]	717	! --------------------------------------------------------------------
	718	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
	719	! (up through ICB for convect4, up through ICB+1 for convect3)
	720	! Calculates the lifted parcel virtual temperature at nk, the
	721	! actual temperature, and the adiabatic liquid water content.
	722	! --------------------------------------------------------------------
[1992]	723
	724	IF (iflag_con==3) THEN
	725
[2007]	726	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
	727	gznk1, tp1, tvp1, clw1, icbs1)
[1992]	728	END IF
	729
	730
	731	IF (iflag_con==4) THEN
[2007]	732	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
	733	tp1, tvp1, clw1)
[1992]	734	END IF
	735
[2007]	736	! -------------------------------------------------------------------
	737	! --- TRIGGERING
	738	! -------------------------------------------------------------------
[1992]	739
[2007]	740	! print *,' avant triggering, iflag_con ',iflag_con
[1992]	741
	742	IF (iflag_con==3) THEN
	743
[2007]	744	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
	745	pbase1, buoybase1, iflag1, sig1, w01)
[1992]	746
	747
[2007]	748	! print*, 'IFLAG1 apres cv3_triger'
	749	! print*,'len,nd',len,nd
	750	! write(*,'(64i1)') iflag1(2:klon-1)
[1992]	751
[2007]	752	! call dump2d(iim,jjm-1,sig1(2)
[1992]	753	END IF
	754
	755	IF (iflag_con==4) THEN
	756	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
	757	END IF
	758
	759
[2007]	760	! =====================================================================
	761	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
	762	! =====================================================================
[1992]	763
	764	ncum = 0
	765	DO i = 1, len
	766	IF (iflag1(i)==0) THEN
	767	ncum = ncum + 1
	768	idcum(ncum) = i
	769	END IF
	770	END DO
	771
[2007]	772	! print*,'klon, ncum = ',len,ncum
[1992]	773
	774	IF (ncum>0) THEN
	775
[2007]	776	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	777	! --- COMPRESS THE FIELDS
	778	! (-> vectorization over convective gridpoints)
	779	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	780
	781	IF (iflag_con==3) THEN
[2007]	782	! print*,'ncum tv1 ',ncum,tv1
	783	! print*,'tvp1 ',tvp1
	784	CALL cv3a_compress(len, nloc, ncum, nd, ntra, &
	785	iflag1, nk1, icb1, icbs1, &
	786	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
	787	wghti1, pbase1, buoybase1, &
	788	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
	789	u1, v1, gz1, th1, th1_wake, &
	790	tra1, &
	791	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	792	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
	793	sig1, w01, ptop21, &
[2201]	794	Ale1, Alp1, omega1, &
[2007]	795	iflag, nk, icb, icbs, &
	796	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
	797	wghti, pbase, buoybase, &
	798	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
	799	u, v, gz, th, th_wake, &
	800	tra, &
	801	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
	802	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
	803	sig, w0, ptop2, &
[2201]	804	Ale, Alp, omega)
[1992]	805
[2007]	806	! print*,'tv ',tv
	807	! print*,'tvp ',tvp
[1992]	808
	809	END IF
	810
	811	IF (iflag_con==4) THEN
[2007]	812	CALL cv_compress(len, nloc, ncum, nd, &
	813	iflag1, nk1, icb1, &
	814	cbmf1, plcl1, tnk1, qnk1, gznk1, &
	815	t1, q1, qs1, u1, v1, gz1, &
	816	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	817	iflag, nk, icb, &
	818	cbmf, plcl, tnk, qnk, gznk, &
	819	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
	820	dph)
[1992]	821	END IF
	822
[2007]	823	! -------------------------------------------------------------------
	824	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
	825	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	826	! --- &
	827	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	828	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	829	! --- &
	830	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
	831	! -------------------------------------------------------------------
[1992]	832
	833	IF (iflag_con==3) THEN
[2007]	834	CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, & !na->nd
	835	tnk, qnk, gznk, hnk, t, q, qs, gz, &
	836	p, h, tv, lv, lf, pbase, buoybase, plcl, &
	837	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
	838	frac)
[1992]	839
	840	END IF
	841
	842	IF (iflag_con==4) THEN
[2007]	843	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
	844	tnk, qnk, gznk, t, q, qs, gz, &
	845	p, dph, h, tv, lv, &
	846	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
[1992]	847	END IF
	848
[2007]	849	! -------------------------------------------------------------------
	850	! --- MIXING(1) (if iflag_mix .ge. 1)
	851	! -------------------------------------------------------------------
[1992]	852	IF (iflag_con==3) THEN
	853	IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
[2007]	854	WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
	855	'. Might as well stop here.'
[1992]	856	STOP
	857	END IF
	858	IF (iflag_mix>=1) THEN
	859	CALL zilch(supmax, nloc*klev)
[2007]	860	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
	861	ph, t, q, qs, u, v, tra, h, lv, qnk, &
	862	unk, vnk, hp, tv, tvp, ep, clw, sig, &
	863	ment, qent, hent, uent, vent, nent, &
	864	sigij, elij, supmax, ments, qents, traent)
	865	! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
[1992]	866
	867	ELSE
	868	CALL zilch(supmax, nloc*klev)
	869	END IF
	870	END IF
[2007]	871	! -------------------------------------------------------------------
	872	! --- CLOSURE
	873	! -------------------------------------------------------------------
[1992]	874
	875
	876	IF (iflag_con==3) THEN
	877	IF (iflag_clos==0) THEN
[2007]	878	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	879	pbase, p, ph, tv, buoy, &
	880	sig, w0, cape, m, iflag)
[1992]	881	END IF
	882
	883	ok_inhib = iflag_mix == 2
	884
	885	IF (iflag_clos==1) THEN
	886	PRINT *, ' pas d appel cv3p_closure'
[2007]	887	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
	888	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
	889	! c : ,supmax
	890	! c o ,sig,w0,ptop2,cape,cin,m)
[1992]	891	END IF
	892	IF (iflag_clos==2) THEN
[2007]	893	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	894	pbase, plcl, p, ph, tv, tvp, buoy, &
[2201]	895	supmax, ok_inhib, Ale, Alp, omega, &
[2007]	896	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
	897	Plim1, plim2, asupmax, supmax0, &
	898	asupmaxmin, cbmf, plfc, wbeff)
[1992]	899
[2079]	900	if (prt_level >= 10) &
	901	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
[1992]	902	END IF
	903	END IF ! iflag_con.eq.3
	904
	905	IF (iflag_con==4) THEN
[2007]	906	CALL cv_closure(nloc, ncum, nd, nk, icb, &
	907	tv, tvp, p, ph, dph, plcl, cpn, &
	908	iflag, cbmf)
[1992]	909	END IF
	910
[2007]	911	! print *,'cv_closure-> cape ',cape(1)
[1992]	912
[2007]	913	! -------------------------------------------------------------------
	914	! --- MIXING(2)
	915	! -------------------------------------------------------------------
[1992]	916
	917	IF (iflag_con==3) THEN
	918	IF (iflag_mix==0) THEN
[2007]	919	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
	920	ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
	921	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
	922	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
[1992]	923	CALL zilch(hent, nlocklevklev)
	924	ELSE
	925	CALL cv3_mixscale(nloc, ncum, nd, ment, m)
	926	IF (debut) THEN
	927	PRINT *, ' cv3_mixscale-> '
	928	END IF !(debut) THEN
	929	END IF
	930	END IF
	931
	932	IF (iflag_con==4) THEN
[2007]	933	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
	934	ph, t, q, qs, u, v, h, lv, qnk, &
	935	hp, tv, tvp, ep, clw, cbmf, &
	936	m, ment, qent, uent, vent, nent, sigij, elij)
	937	END IF
[1992]	938
	939	IF (debut) THEN
	940	PRINT *, ' cv_mixing ->'
	941	END IF !(debut) THEN
[2007]	942	! do i = 1,klev
	943	! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
	944	! enddo
[1992]	945
[2007]	946	! -------------------------------------------------------------------
	947	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
	948	! -------------------------------------------------------------------
[1992]	949	IF (iflag_con==3) THEN
	950	IF (debut) THEN
	951	PRINT *, ' cva_driver -> cv3_unsat '
	952	END IF !(debut) THEN
	953
[2007]	954	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
	955	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
	956	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
	957	ep, sigp, clw, &
	958	m, ment, elij, delt, plcl, coef_clos, &
	959	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
	960	faci, b, sigd, &
	961	wdtrainA, wdtrainM) ! RomP
[1992]	962	END IF
	963
	964	IF (iflag_con==4) THEN
[2007]	965	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
	966	h, lv, ep, sigp, clw, m, ment, elij, &
	967	iflag, mp, qp, up, vp, wt, water, evap)
[1992]	968	END IF
	969
	970	IF (debut) THEN
	971	PRINT *, 'cv_unsat-> '
	972	END IF !(debut) THEN
	973
[2007]	974	! print *,'cv_unsat-> mp ',mp
	975	! print *,'cv_unsat-> water ',water
	976	! -------------------------------------------------------------------
	977	! --- YIELD
	978	! (tendencies, precipitation, variables of interface with other
	979	! processes, etc)
	980	! -------------------------------------------------------------------
[1992]	981
	982	IF (iflag_con==3) THEN
	983
[2007]	984	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
	985	icb, inb, delt, &
	986	t, q, t_wake, q_wake, s_wake, u, v, tra, &
	987	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
	988	ep, clw, m, tp, mp, qp, up, vp, trap, &
	989	wt, water, ice, evap, fondue, faci, b, sigd, &
	990	ment, qent, hent, iflag_mix, uent, vent, &
	991	nent, elij, traent, sig, &
	992	tv, tvp, wghti, &
	993	iflag, precip, vprecip, ft, fq, fu, fv, ftra, &
	994	cbmf, upwd, dnwd, dnwd0, ma, mip, &
	995	tls, tps, qcondc, wd, &
[2205]	996	ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
[1992]	997	END IF
	998
	999	IF (debut) THEN
	1000	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(1, 1)
	1001	END IF !(debut) THEN
	1002
	1003	IF (iflag_con==4) THEN
[2007]	1004	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
	1005	t, q, u, v, &
	1006	gz, p, ph, h, hp, lv, cpn, &
	1007	ep, clw, frac, m, mp, qp, up, vp, &
	1008	wt, water, evap, &
	1009	ment, qent, uent, vent, nent, elij, &
	1010	tv, tvp, &
	1011	iflag, wd, qprime, tprime, &
	1012	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
[1992]	1013	END IF
	1014
[2007]	1015	!AC!
	1016	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1017	!--- passive tracers
	1018	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	1019
	1020	IF (iflag_con==3) THEN
[2007]	1021	!RomP >>>
	1022	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
	1023	ment, sigij, da, phi, phi2, d1a, dam, &
	1024	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
	1025	icb, inb)
	1026	!RomP <<<
[1992]	1027	END IF
	1028
[2007]	1029	!AC!
[1992]	1030
[2007]	1031	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1032	! --- UNCOMPRESS THE FIELDS
	1033	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	1034
	1035
	1036	IF (iflag_con==3) THEN
[2007]	1037	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, &
	1038	iflag, icb, inb, &
	1039	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
	1040	ft, fq, fu, fv, ftra, &
	1041	sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, &
	1042	qcondc, wd, cape, cin, &
	1043	tvp, &
	1044	ftd, fqd, &
	1045	Plim1, plim2, asupmax, supmax0, &
	1046	asupmaxmin, &
	1047	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
	1048	clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
	1049	wdtrainA, wdtrainM, & ! RomP
[2207]	1050	qtc, sigt, &
[2007]	1051	iflag1, kbas1, ktop1, &
	1052	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
	1053	ft1, fq1, fu1, fv1, ftra1, &
	1054	sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, &
	1055	qcondc1, wd1, cape1, cin1, &
	1056	tvp1, &
	1057	ftd1, fqd1, &
	1058	Plim11, plim21, asupmax1, supmax01, &
	1059	asupmaxmin1, &
	1060	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
	1061	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
[2207]	1062	wdtrainA1, wdtrainM1, & ! RomP
	1063	qtc1, sigt1)
[1992]	1064	END IF
	1065
	1066	IF (iflag_con==4) THEN
[2007]	1067	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
	1068	iflag, &
	1069	precip, cbmf, &
	1070	ft, fq, fu, fv, &
	1071	ma, qcondc, &
	1072	iflag1, &
	1073	precip1,cbmf1, &
	1074	ft1, fq1, fu1, fv1, &
	1075	ma1, qcondc1)
[1992]	1076	END IF
	1077
	1078	END IF ! ncum>0
	1079
	1080	IF (debut) THEN
	1081	PRINT *, ' cv_compress -> '
	1082	debut = .FALSE.
[2007]	1083	END IF !(debut) THEN
[1992]	1084
[2007]	1085
[1992]	1086	RETURN
	1087	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format