Context Navigation

cva_driver.F90 @ 4947

Last change on this file since 4947 was 2870, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2842:2865 into testing branch
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: 49.6 KB

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

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

Download in other formats:

Original Format