Context Navigation

cv_driver.F90 @ 5306

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

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

Download in other formats:

Original Format