Context Navigation

cv_driver.F90 @ 5441

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

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

Download in other formats:

Original Format