Context Navigation

cva_driver.F90 @ 5434

Last change on this file since 5434 was 3798, checked in by lguez, 4 years ago
Sync latest trunk changes to Ocean_skin
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: 51.6 KB

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

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

Download in other formats:

Original Format