Context Navigation

cva_driver.F90 @ 2590

Last change on this file since 2590 was 2481, checked in by fhourdin, 9 years ago
Introduction d'une dependance epmax=f(Cape) sur proposition de Camille Risi
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: 46.9 KB

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

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

Download in other formats:

Original Format