Context Navigation

cv_driver.F90 @ 5331

Last change on this file since 5331 was 3410, checked in by acozic, 6 years ago
merge with rev 3409 of trunk (Anne Cozic)
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: 25.3 KB

Rev	Line
[1992]	1
[524]	2	! $Header$
	3
[1992]	4	SUBROUTINE cv_driver(len, nd, ndp1, ntra, iflag_con, t1, q1, qs1, u1, v1, &
	5	tra1, p1, ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, vprecip1, &
	6	cbmf1, sig1, w01, icb1, inb1, delt, ma1, upwd1, dnwd1, dnwd01, qcondc1, &
	7	wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, clw1, elij1, & !
	8	! RomP
	9	evap1, ep1, epmlmmm1, eplamm1, & ! RomP
[2481]	10	wdtraina1, wdtrainm1, & ! RomP
	11	epmax_diag1) ! epmax_cape
[524]	12
[1992]	13	USE dimphy
	14	IMPLICIT NONE
[524]	15
[1992]	16	! .............................START PROLOGUE............................
[524]	17
	18
[1992]	19	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
	20	! "1" appended.
	21	! The "1" is removed for the corresponding compressed (local) variables.
[524]	22
[1992]	23	! PARAMETERS:
	24	! Name Type Usage Description
	25	! ---------- ---------- ------- ----------------------------
	26
	27	! len Integer Input first (i) dimension
	28	! nd Integer Input vertical (k) dimension
	29	! ndp1 Integer Input nd + 1
	30	! ntra Integer Input number of tracors
	31	! iflag_con Integer Input version of convect (3/4)
	32	! t1 Real Input temperature
	33	! q1 Real Input specific hum
	34	! qs1 Real Input sat specific hum
	35	! u1 Real Input u-wind
	36	! v1 Real Input v-wind
	37	! tra1 Real Input tracors
	38	! p1 Real Input full level pressure
	39	! ph1 Real Input half level pressure
	40	! iflag1 Integer Output flag for Emanuel conditions
	41	! ft1 Real Output temp tend
	42	! fq1 Real Output spec hum tend
	43	! fu1 Real Output u-wind tend
	44	! fv1 Real Output v-wind tend
	45	! ftra1 Real Output tracor tend
	46	! precip1 Real Output precipitation
	47	! VPrecip1 Real Output vertical profile of
	48	! precipitations
	49	! cbmf1 Real Output cloud base mass flux
	50	! sig1 Real In/Out section adiabatic updraft
	51	! w01 Real In/Out vertical velocity within adiab
	52	! updraft
	53	! delt Real Input time step
	54	! Ma1 Real Output mass flux adiabatic updraft
	55	! upwd1 Real Output total upward mass flux
	56	! (adiab+mixed)
	57	! dnwd1 Real Output saturated downward mass flux
	58	! (mixed)
	59	! dnwd01 Real Output unsaturated downward mass flux
	60	! qcondc1 Real Output in-cld mixing ratio of
	61	! condensed water
	62	! wd1 Real Output downdraft velocity scale for
	63	! sfc fluxes
	64	! cape1 Real Output CAPE
	65
	66	! wdtrainA1 Real Output precipitation detrained from
	67	! adiabatic draught;
	68	! used in tracer transport (cvltr)
	69	! wdtrainM1 Real Output precipitation detrained from mixed
	70	! draughts;
	71	! used in tracer transport (cvltr)
	72	! da1 Real Output used in tracer transport (cvltr)
	73	! phi1 Real Output used in tracer transport (cvltr)
	74	! mp1 Real Output used in tracer transport (cvltr)
	75
	76	! phi21 Real Output used in tracer transport (cvltr)
	77
	78	! d1a1 Real Output used in tracer transport (cvltr)
	79	! dam1 Real Output used in tracer transport (cvltr)
	80
	81	! evap1 Real Output
	82	! ep1 Real Output
	83	! sij1 Real Output
	84	! elij1 Real Output
	85
	86	! S. Bony, Mar 2002:
	87	! * Several modules corresponding to different physical processes
	88	! * Several versions of convect may be used:
	89	! - iflag_con=3: version lmd (previously named convect3)
	90	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
	91	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
	92	! S. Bony, Oct 2002:
	93	! * Vectorization of convect3 (ie version lmd)
	94
	95	! ..............................END PROLOGUE.............................
	96
	97
	98	! Input
	99	INTEGER len
	100	INTEGER nd
	101	INTEGER ndp1
	102	INTEGER noff
	103	INTEGER iflag_con
	104	INTEGER ntra
	105	REAL delt
	106	REAL t1(len, nd)
	107	REAL q1(len, nd)
	108	REAL qs1(len, nd)
	109	REAL u1(len, nd)
	110	REAL v1(len, nd)
	111	REAL tra1(len, nd, ntra)
	112	REAL p1(len, nd)
	113	REAL ph1(len, ndp1)
	114
	115	! Output
	116	INTEGER iflag1(len)
	117	REAL ft1(len, nd)
	118	REAL fq1(len, nd)
	119	REAL fu1(len, nd)
	120	REAL fv1(len, nd)
	121	REAL ftra1(len, nd, ntra)
	122	REAL precip1(len)
	123	REAL cbmf1(len)
	124	REAL sig1(klon, klev)
	125	REAL w01(klon, klev)
	126	REAL vprecip1(len, nd+1)
	127	REAL evap1(len, nd) !RomP
	128	REAL ep1(len, nd) !RomP
	129	REAL ma1(len, nd)
	130	REAL upwd1(len, nd)
	131	REAL dnwd1(len, nd)
	132	REAL dnwd01(len, nd)
	133
	134	REAL qcondc1(len, nd) ! cld
	135	REAL wd1(len) ! gust
	136	REAL cape1(len)
	137
	138	! RomP >>>
	139	REAL wdtraina1(len, nd), wdtrainm1(len, nd)
	140	REAL sij1(len, nd, nd), elij1(len, nd, nd)
	141	REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
	142
	143	REAL phi21(len, nd, nd)
	144	REAL d1a1(len, nd), dam1(len, nd)
	145	REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
	146	! RomP <<<
[2481]	147	REAL epmax_diag1 (len) ! epmax_cape
[1992]	148
	149	! -------------------------------------------------------------------
	150	! Original Prologue by Kerry Emanuel.
	151	! -------------------------------------------------------------------
	152	! --- ARGUMENTS
	153	! -------------------------------------------------------------------
	154	! --- On input:
	155
	156	! t: Array of absolute temperature (K) of dimension ND, with first
	157	! index corresponding to lowest model level. Note that this array
	158	! will be altered by the subroutine if dry convective adjustment
	159	! occurs and if IPBL is not equal to 0.
	160
	161	! q: Array of specific humidity (gm/gm) of dimension ND, with first
	162	! index corresponding to lowest model level. Must be defined
	163	! at same grid levels as T. Note that this array will be altered
	164	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	165
	166	! qs: Array of saturation specific humidity of dimension ND, with first
	167	! index corresponding to lowest model level. Must be defined
	168	! at same grid levels as T. Note that this array will be altered
	169	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	170
	171	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
	172	! index corresponding with the lowest model level. Defined at
	173	! same levels as T. Note that this array will be altered if
	174	! dry convective adjustment occurs and if IPBL is not equal to 0.
	175
	176	! v: Same as u but for meridional velocity.
	177
	178	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
	179	! where NTRA is the number of different tracers. If no
	180	! convective tracer transport is needed, define a dummy
	181	! input array of dimension (ND,1). Tracers are defined at
	182	! same vertical levels as T. Note that this array will be altered
	183	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	184
	185	! p: Array of pressure (mb) of dimension ND, with first
	186	! index corresponding to lowest model level. Must be defined
	187	! at same grid levels as T.
	188
	189	! ph: Array of pressure (mb) of dimension ND+1, with first index
	190	! corresponding to lowest level. These pressures are defined at
	191	! levels intermediate between those of P, T, Q and QS. The first
	192	! value of PH should be greater than (i.e. at a lower level than)
	193	! the first value of the array P.
	194
	195	! nl: The maximum number of levels to which convection can penetrate, plus
	196	! 1.
	197	! NL MUST be less than or equal to ND-1.
	198
	199	! delt: The model time step (sec) between calls to CONVECT
	200
	201	! ----------------------------------------------------------------------------
	202	! --- On Output:
	203
	204	! iflag: An output integer whose value denotes the following:
	205	! VALUE INTERPRETATION
	206	! ----- --------------
	207	! 0 Moist convection occurs.
	208	! 1 Moist convection occurs, but a CFL condition
	209	! on the subsidence warming is violated. This
	210	! does not cause the scheme to terminate.
	211	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
	212	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
	213	! 4 No moist convection; atmosphere is not
	214	! unstable
	215	! 6 No moist convection because ihmin le minorig.
	216	! 7 No moist convection because unreasonable
	217	! parcel level temperature or specific humidity.
	218	! 8 No moist convection: lifted condensation
	219	! level is above the 200 mb level.
	220	! 9 No moist convection: cloud base is higher
	221	! then the level NL-1.
	222
	223	! ft: Array of temperature tendency (K/s) of dimension ND, defined at
	224	! same
	225	! grid levels as T, Q, QS and P.
	226
	227	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
	228	! defined at same grid levels as T, Q, QS and P.
	229
	230	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
	231	! defined at same grid levels as T.
	232
	233	! fv: Same as FU, but for forcing of meridional velocity.
	234
	235	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
	236	! second, defined at same levels as T. Dimensioned (ND,NTRA).
	237
	238	! precip: Scalar convective precipitation rate (mm/day).
	239
	240	! VPrecip: Vertical profile of convective precipitation (kg/m2/s).
	241
	242	! wd: A convective downdraft velocity scale. For use in surface
	243	! flux parameterizations. See convect.ps file for details.
	244
	245	! tprime: A convective downdraft temperature perturbation scale (K).
	246	! For use in surface flux parameterizations. See convect.ps
	247	! file for details.
	248
	249	! qprime: A convective downdraft specific humidity
	250	! perturbation scale (gm/gm).
	251	! For use in surface flux parameterizations. See convect.ps
	252	! file for details.
	253
	254	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
	255	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
	256	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
	257	! by the calling program between calls to CONVECT.
	258
	259	! det: Array of detrainment mass flux of dimension ND.
	260
	261	! -------------------------------------------------------------------
	262
	263	! Local arrays
	264
	265
	266	INTEGER i, k, n, il, j
	267	INTEGER icbmax
	268	INTEGER nk1(klon)
	269	INTEGER icb1(klon)
	270	INTEGER inb1(klon)
	271	INTEGER icbs1(klon)
	272
	273	REAL plcl1(klon)
	274	REAL tnk1(klon)
	275	REAL qnk1(klon)
	276	REAL gznk1(klon)
	277	REAL pnk1(klon)
	278	REAL qsnk1(klon)
	279	REAL pbase1(klon)
	280	REAL buoybase1(klon)
	281
	282	REAL lv1(klon, klev)
	283	REAL cpn1(klon, klev)
	284	REAL tv1(klon, klev)
	285	REAL gz1(klon, klev)
	286	REAL hm1(klon, klev)
	287	REAL h1(klon, klev)
	288	REAL tp1(klon, klev)
	289	REAL tvp1(klon, klev)
	290	REAL clw1(klon, klev)
	291	REAL th1(klon, klev)
	292
	293	INTEGER ncum
	294
	295	! (local) compressed fields:
	296
	297	! ym integer nloc
	298	! ym parameter (nloc=klon) ! pour l'instant
[766]	299	#define nloc klon
[1992]	300	INTEGER idcum(nloc)
	301	INTEGER iflag(nloc), nk(nloc), icb(nloc)
	302	INTEGER nent(nloc, klev)
	303	INTEGER icbs(nloc)
	304	INTEGER inb(nloc), inbis(nloc)
[524]	305
[1992]	306	REAL cbmf(nloc), plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)
	307	REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
	308	REAL u(nloc, klev), v(nloc, klev)
	309	REAL gz(nloc, klev), h(nloc, klev), lv(nloc, klev), cpn(nloc, klev)
	310	REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
	311	REAL clw(nloc, klev)
	312	REAL dph(nloc, klev)
	313	REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
	314	REAL tvp(nloc, klev)
	315	REAL sig(nloc, klev), w0(nloc, klev)
	316	REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
	317	REAL frac(nloc), buoy(nloc, klev)
	318	REAL cape(nloc)
	319	REAL m(nloc, klev), ment(nloc, klev, klev), qent(nloc, klev, klev)
	320	REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
	321	REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
	322	REAL sij(nloc, klev, klev), elij(nloc, klev, klev)
	323	REAL qp(nloc, klev), up(nloc, klev), vp(nloc, klev)
	324	REAL wt(nloc, klev), water(nloc, klev), evap(nloc, klev)
	325	REAL b(nloc, klev), ft(nloc, klev), fq(nloc, klev)
	326	REAL fu(nloc, klev), fv(nloc, klev)
	327	REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
	328	REAL ma(nloc, klev), mike(nloc, klev), tls(nloc, klev)
	329	REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
	330	REAL precip(nloc)
	331	REAL vprecip(nloc, klev+1)
	332	REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
	333	REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
	334	REAL qcondc(nloc, klev) ! cld
	335	REAL wd(nloc) ! gust
[524]	336
[1992]	337	! RomP >>>
	338	REAL da(nloc, klev), phi(nloc, klev, klev), mp(nloc, klev)
	339	REAL epmlmmm(nloc, klev, klev), eplamm(nloc, klev)
	340	REAL phi2(nloc, klev, klev)
	341	REAL d1a(nloc, klev), dam(nloc, klev)
	342	REAL wdtraina(nloc, klev), wdtrainm(nloc, klev)
	343	REAL sigd(nloc)
	344	! RomP <<<
[2481]	345	REAL epmax_diag(nloc) ! epmax_cape
[524]	346
[1992]	347	nent(:, :) = 0
	348	! -------------------------------------------------------------------
	349	! --- SET CONSTANTS AND PARAMETERS
	350	! -------------------------------------------------------------------
	351	! print *, '-> cv_driver' !jyg
	352	! -- set simulation flags:
	353	! (common cvflag)
[524]	354
[1992]	355	CALL cv_flag(0)
[524]	356
[1992]	357	! -- set thermodynamical constants:
	358	! (common cvthermo)
[524]	359
[1992]	360	CALL cv_thermo(iflag_con)
[524]	361
[1992]	362	! -- set convect parameters
[879]	363
[1992]	364	! includes microphysical parameters and parameters that
	365	! control the rate of approach to quasi-equilibrium)
	366	! (common cvparam)
[524]	367
	368
[1992]	369	IF (iflag_con==30) THEN
	370	CALL cv30_param(nd, delt)
	371	END IF
[524]	372
[1992]	373	IF (iflag_con==4) THEN
	374	CALL cv_param(nd)
	375	END IF
[524]	376
[1992]	377	! ---------------------------------------------------------------------
	378	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
	379	! ---------------------------------------------------------------------
[524]	380
[3410]	381	inb(:) = 0.0
	382	inb1(:) = 0.0
	383	icb1(:) = 0.0
	384
[1992]	385	ft1(:, :) = 0.0
	386	fq1(:, :) = 0.0
	387	fu1(:, :) = 0.0
	388	fv1(:, :) = 0.0
	389	tvp1(:, :) = 0.0
	390	tp1(:, :) = 0.0
	391	clw1(:, :) = 0.0
	392	! ym
	393	clw(:, :) = 0.0
	394	gz1(:, :) = 0.
	395	vprecip1(:, :) = 0.
	396	ma1(:, :) = 0.0
	397	upwd1(:, :) = 0.0
	398	dnwd1(:, :) = 0.0
	399	dnwd01(:, :) = 0.0
	400	qcondc1(:, :) = 0.0
[524]	401
[1992]	402	ftra1(:, :, :) = 0.0
[1742]	403
[1992]	404	elij1(:, :, :) = 0.0
	405	sij1(:, :, :) = 0.0
[524]	406
[1992]	407	precip1(:) = 0.0
	408	iflag1(:) = 0
	409	wd1(:) = 0.0
	410	cape1(:) = 0.0
[2481]	411	epmax_diag1(:) = 0.0 ! epmax_cape
[1774]	412
[2481]	413
[1992]	414	IF (iflag_con==30) THEN
	415	DO il = 1, len
	416	sig1(il, nd) = sig1(il, nd) + 1.
	417	sig1(il, nd) = amin1(sig1(il,nd), 12.1)
	418	END DO
	419	END IF
[524]	420
[1992]	421	! RomP >>>
	422	wdtraina1(:, :) = 0.
	423	wdtrainm1(:, :) = 0.
	424	da1(:, :) = 0.
	425	phi1(:, :, :) = 0.
	426	epmlmmm1(:, :, :) = 0.
	427	eplamm1(:, :) = 0.
	428	mp1(:, :) = 0.
	429	evap1(:, :) = 0.
	430	ep1(:, :) = 0.
	431	sij1(:, :, :) = 0.
	432	elij1(:, :, :) = 0.
	433	phi21(:, :, :) = 0.
	434	d1a1(:, :) = 0.
	435	dam1(:, :) = 0.
	436	! RomP <<<
[879]	437
[1992]	438	! --------------------------------------------------------------------
	439	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	440	! --------------------------------------------------------------------
[524]	441
[1992]	442	IF (iflag_con==30) THEN
[524]	443
[1992]	444	! print*,'Emanuel version 30 '
	445	CALL cv30_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
	446	, lv1, cpn1, tv1, gz1, h1, hm1, th1)
	447	END IF
[524]	448
[1992]	449	IF (iflag_con==4) THEN
	450	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
	451	hm1)
	452	END IF
[524]	453
[1992]	454	! --------------------------------------------------------------------
	455	! --- CONVECTIVE FEED
	456	! --------------------------------------------------------------------
[524]	457
[1992]	458	IF (iflag_con==30) THEN
	459	CALL cv30_feed(len, nd, t1, q1, qs1, p1, ph1, hm1, gz1 & !
	460	! nd->na
	461	, nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
	462	END IF
[524]	463
[1992]	464	IF (iflag_con==4) THEN
	465	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
	466	iflag1, tnk1, qnk1, gznk1, plcl1)
	467	END IF
[524]	468
[1992]	469	! --------------------------------------------------------------------
	470	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
	471	! (up through ICB for convect4, up through ICB+1 for convect3)
	472	! Calculates the lifted parcel virtual temperature at nk, the
	473	! actual temperature, and the adiabatic liquid water content.
	474	! --------------------------------------------------------------------
[524]	475
[1992]	476	IF (iflag_con==30) THEN
	477	CALL cv30_undilute1(len, nd, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1 & ! nd->na
	478	, tp1, tvp1, clw1, icbs1)
	479	END IF
[524]	480
[1992]	481	IF (iflag_con==4) THEN
	482	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
	483	tvp1, clw1)
	484	END IF
[524]	485
[1992]	486	! -------------------------------------------------------------------
	487	! --- TRIGGERING
	488	! -------------------------------------------------------------------
[524]	489
[1992]	490	IF (iflag_con==30) THEN
	491	CALL cv30_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1 & !
	492	! nd->na
	493	, pbase1, buoybase1, iflag1, sig1, w01)
	494	END IF
[524]	495
[1992]	496	IF (iflag_con==4) THEN
	497	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
	498	END IF
[524]	499
[1992]	500	! =====================================================================
	501	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
	502	! =====================================================================
[524]	503
[1992]	504	ncum = 0
	505	DO i = 1, len
	506	IF (iflag1(i)==0) THEN
	507	ncum = ncum + 1
	508	idcum(ncum) = i
	509	END IF
	510	END DO
[524]	511
[1992]	512	! print*,'cv_driver : klon, ncum = ',len,ncum
[524]	513
[1992]	514	IF (ncum>0) THEN
[524]	515
[1992]	516	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	517	! --- COMPRESS THE FIELDS
	518	! (-> vectorization over convective gridpoints)
	519	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[524]	520
[1992]	521	IF (iflag_con==30) THEN
	522	CALL cv30_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
	523	plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, &
	524	gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, &
	525	w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, &
	526	q, qs, u, v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, &
	527	w0)
	528	END IF
[524]	529
[1992]	530	IF (iflag_con==4) THEN
	531	CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
	532	tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
	533	tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
	534	q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
	535	END IF
[524]	536
[1992]	537	! -------------------------------------------------------------------
	538	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
	539	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	540	! --- &
	541	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	542	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	543	! --- &
	544	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
	545	! -------------------------------------------------------------------
[524]	546
[1992]	547	IF (iflag_con==30) THEN
	548	CALL cv30_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
	549	, tnk, qnk, gznk, t, q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, &
	550	inb, tp, tvp, clw, hp, ep, sigp, buoy)
	551	END IF
[524]	552
[1992]	553	IF (iflag_con==4) THEN
	554	CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
	555	gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
	556	END IF
[524]	557
[1992]	558	! -------------------------------------------------------------------
	559	! --- CLOSURE
	560	! -------------------------------------------------------------------
[524]	561
[1992]	562	IF (iflag_con==30) THEN
	563	CALL cv30_closure(nloc, ncum, nd, icb, inb & ! na->nd
	564	, pbase, p, ph, tv, buoy, sig, w0, cape, m)
[2481]	565
	566	! epmax_cape
	567	call cv30_epmax_fn_cape(nloc,ncum,nd &
	568	,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
	569	,epmax_diag)
	570	! on écrase ep et recalcule hp
[1992]	571	END IF
[524]	572
[1992]	573	IF (iflag_con==4) THEN
	574	CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
	575	cpn, iflag, cbmf)
	576	END IF
[2481]	577
[524]	578
[1992]	579	! -------------------------------------------------------------------
	580	! --- MIXING
	581	! -------------------------------------------------------------------
[524]	582
[1992]	583	IF (iflag_con==30) THEN
	584	CALL cv30_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
	585	! na->nd
	586	, ph, t, q, qs, u, v, tra, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, &
	587	ment, qent, uent, vent, sij, elij, ments, qents, traent)
	588	END IF
[524]	589
[1992]	590	IF (iflag_con==4) THEN
	591	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
	592	h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
	593	nent, sij, elij)
	594	END IF
[524]	595
[1992]	596	! -------------------------------------------------------------------
	597	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
	598	! -------------------------------------------------------------------
[524]	599
[1992]	600	IF (iflag_con==30) THEN
	601	! RomP >>>
	602	CALL cv30_unsat(nloc, ncum, nd, nd, ntra, icb, inb & ! na->nd
	603	, t, q, qs, gz, u, v, tra, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, &
	604	ment, elij, delt, plcl, mp, qp, up, vp, trap, wt, water, evap, b, &
	605	wdtraina, wdtrainm)
	606	! RomP <<<
	607	END IF
[524]	608
[1992]	609	IF (iflag_con==4) THEN
	610	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
	611	ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
	612	END IF
[524]	613
[1992]	614	! -------------------------------------------------------------------
	615	! --- YIELD
	616	! (tendencies, precipitation, variables of interface with other
	617	! processes, etc)
	618	! -------------------------------------------------------------------
[524]	619
[1992]	620	IF (iflag_con==30) THEN
	621	CALL cv30_yield(nloc, ncum, nd, nd, ntra & ! na->nd
	622	, icb, inb, delt, t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th, ep, &
	623	clw, m, tp, mp, qp, up, vp, trap, wt, water, evap, b, ment, qent, &
	624	uent, vent, nent, elij, traent, sig, tv, tvp, iflag, precip, vprecip, &
	625	ft, fq, fu, fv, ftra, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, &
	626	wd)
	627	END IF
[524]	628
[1992]	629	IF (iflag_con==4) THEN
	630	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
	631	ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
	632	evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
	633	tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
	634	END IF
[524]	635
[1992]	636	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	637	! --- passive tracers
	638	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[524]	639
[1992]	640	IF (iflag_con==30) THEN
	641	! RomP >>>
	642	CALL cv30_tracer(nloc, len, ncum, nd, nd, ment, sij, da, phi, phi2, &
	643	d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
	644	! RomP <<<
	645	END IF
[524]	646
[1992]	647	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	648	! --- UNCOMPRESS THE FIELDS
	649	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	650	! set iflag1 =42 for non convective points
	651	DO i = 1, len
	652	iflag1(i) = 42
	653	END DO
[524]	654
[1992]	655	IF (iflag_con==30) THEN
	656	CALL cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
	657	vprecip, evap, ep, sig, w0 & !RomP
	658	, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
	659	da, phi, mp, phi2, d1a, dam, sij & !RomP
	660	, elij, clw, epmlmmm, eplamm & !RomP
[2481]	661	, wdtraina, wdtrainm,epmax_diag & !RomP
[1992]	662	, iflag1, precip1, vprecip1, evap1, ep1, sig1, w01 & !RomP
	663	, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, dnwd01, &
	664	qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1 & !RomP
	665	, elij1, clw1, epmlmmm1, eplamm1 & !RomP
[2481]	666	, wdtraina1, wdtrainm1,epmax_diag1) !RomP
[1992]	667	END IF
[524]	668
[1992]	669	IF (iflag_con==4) THEN
	670	CALL cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
	671	fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
	672	ma1, qcondc1)
	673	END IF
[524]	674
[1992]	675	END IF ! ncum>0
[524]	676
[1992]	677	! print *, 'fin cv_driver ->' !jyg
	678	RETURN
	679	END SUBROUTINE cv_driver
[1849]	680
[1992]	681	! ==================================================================
	682	SUBROUTINE cv_flag(iflag_ice_thermo)
	683	IMPLICIT NONE
[524]	684
[1992]	685	! Argument : iflag_ice_thermo : ice thermodynamics is taken into account if
	686	! iflag_ice_thermo >=1
	687	INTEGER iflag_ice_thermo
[524]	688
[1992]	689	include "cvflag.h"
[524]	690
[1992]	691	! -- si .TRUE., on rend la gravite plus explicite et eventuellement
	692	! differente de 10.0 dans convect3:
	693	cvflag_grav = .TRUE.
	694	cvflag_ice = iflag_ice_thermo >= 1
[524]	695
[1992]	696	RETURN
	697	END SUBROUTINE cv_flag
[524]	698
[1992]	699	! ==================================================================
	700	SUBROUTINE cv_thermo(iflag_con)
	701	IMPLICIT NONE
[524]	702
[1992]	703	! -------------------------------------------------------------
	704	! Set thermodynamical constants for convectL
	705	! -------------------------------------------------------------
[524]	706
[1992]	707	include "YOMCST.h"
	708	include "cvthermo.h"
[524]	709
[1992]	710	INTEGER iflag_con
[524]	711
	712
[1992]	713	! original set from convect:
	714	IF (iflag_con==4) THEN
	715	cpd = 1005.7
	716	cpv = 1870.0
	717	cl = 4190.0
	718	rrv = 461.5
	719	rrd = 287.04
	720	lv0 = 2.501E6
	721	g = 9.8
	722	t0 = 273.15
	723	grav = g
	724	ELSE
[524]	725
[1992]	726	! constants consistent with LMDZ:
	727	cpd = rcpd
	728	cpv = rcpv
	729	cl = rcw
	730	ci = rcs
	731	rrv = rv
	732	rrd = rd
	733	lv0 = rlvtt
	734	lf0 = rlstt - rlvtt
	735	g = rg ! not used in convect3
	736	! ori t0 = RTT
	737	t0 = 273.15 ! convect3 (RTT=273.16)
	738	! maf grav= 10. ! implicitely or explicitely used in convect3
	739	grav = g ! implicitely or explicitely used in convect3
	740	END IF
[524]	741
[1992]	742	rowl = 1000.0 !(a quelle variable de YOMCST cela correspond-il?)
	743
	744	clmcpv = cl - cpv
	745	clmcpd = cl - cpd
	746	clmci = cl - ci
	747	cpdmcp = cpd - cpv
	748	cpvmcpd = cpv - cpd
	749	cpvmcl = cl - cpv ! for convect3
	750	eps = rrd/rrv
	751	epsi = 1.0/eps
	752	epsim1 = epsi - 1.0
	753	! ginv=1.0/g
	754	ginv = 1.0/grav
	755	hrd = 0.5*rrd
	756
	757	RETURN
	758	END SUBROUTINE cv_thermo

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

Download in other formats:

Original Format