Context Navigation

cva_driver.F90 @ 2397

Last change on this file since 2397 was 2397, checked in by jyg, 9 years ago
Implementation of ice thermodynamics in cv3p_mixing.F90 . Needs debugging.
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.3 KB

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

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

Download in other formats:

Original Format