Context Navigation

cva_driver.F90 @ 2031

Last change on this file since 2031 was 2007, checked in by fhourdin, 11 years ago

Modification pour garantir la conservation des espèces traces.

Modification for tracer conservation

Jean-Yves Grandpeix

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: 38.8 KB

Rev	Line
[1992]	1
[1403]	2	! $Id: cva_driver.F90 2007 2014-04-06 12:20:38Z fhourdin $
[1774]	3
[2007]	4	SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, &
	5	iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
	6	delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
	7	u1, v1, tra1, &
	8	p1, ph1, &
	9	Ale1, Alp1, &
	10	sig1feed1, sig2feed1, wght1, &
	11	iflag1, ft1, fq1, fu1, fv1, ftra1, &
	12	precip1, kbas1, ktop1, &
	13	cbmf1, plcl1, plfc1, wbeff1, &
	14	sig1, w01, & !input/output
	15	ptop21, sigd1, &
	16	ma1, mip1, Vprecip1, upwd1, dnwd1, dnwd01, &
	17	qcondc1, wd1, &
	18	cape1, cin1, tvp1, &
	19	ftd1, fqd1, &
	20	Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
	21	lalim_conv, &
	22	!! da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, & ! RomP
	23	!! elij1,evap1,ep1,epmlmMm1,eplaMm1, & ! RomP
	24	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
	25	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP, RL
	26	wdtrainA1, wdtrainM1) ! RomP
	27	! **************************************************************
	28	! *
	29	! CV_DRIVER *
	30	! *
	31	! *
	32	! written by : Sandrine Bony-Lena , 17/05/2003, 11.19.41 *
	33	! modified by : *
	34	! **************************************************************
	35	! **************************************************************
[1403]	36
[1992]	37	USE dimphy
	38	IMPLICIT NONE
[879]	39
[2007]	40	! .............................START PROLOGUE............................
[879]	41
	42
[2007]	43	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
	44	! The "1" is removed for the corresponding compressed variables.
	45	! PARAMETERS:
	46	! Name Type Usage Description
	47	! ---------- ---------- ------- ----------------------------
[879]	48
[2007]	49	! len Integer Input first (i) dimension
	50	! nd Integer Input vertical (k) dimension
	51	! ndp1 Integer Input nd + 1
	52	! ntra Integer Input number of tracors
	53	! iflag_con Integer Input version of convect (3/4)
	54	! iflag_mix Integer Input version of mixing (0/1/2)
	55	! iflag_ice_thermo Integer Input accounting for ice thermodynamics (0/1)
	56	! iflag_clos Integer Input version of closure (0/1)
	57	! ok_conserv_q Logical Input when true corrections for water conservation are swtiched on
	58	! delt Real Input time step
	59	! t1 Real Input temperature (sat draught envt)
	60	! q1 Real Input specific hum (sat draught envt)
	61	! qs1 Real Input sat specific hum (sat draught envt)
	62	! t1_wake Real Input temperature (unsat draught envt)
	63	! q1_wake Real Input specific hum(unsat draught envt)
	64	! qs1_wake Real Input sat specific hum(unsat draughts envt)
	65	! s1_wake Real Input fractionnal area covered by wakes
	66	! u1 Real Input u-wind
	67	! v1 Real Input v-wind
	68	! tra1 Real Input tracors
	69	! p1 Real Input full level pressure
	70	! ph1 Real Input half level pressure
	71	! ALE1 Real Input Available lifting Energy
	72	! ALP1 Real Input Available lifting Power
	73	! sig1feed1 Real Input sigma coord at lower bound of feeding layer
	74	! sig2feed1 Real Input sigma coord at upper bound of feeding layer
	75	! wght1 Real Input weight density determining the feeding mixture
	76	! iflag1 Integer Output flag for Emanuel conditions
	77	! ft1 Real Output temp tend
	78	! fq1 Real Output spec hum tend
	79	! fu1 Real Output u-wind tend
	80	! fv1 Real Output v-wind tend
	81	! ftra1 Real Output tracor tend
	82	! precip1 Real Output precipitation
	83	! kbas1 Integer Output cloud base level
	84	! ktop1 Integer Output cloud top level
	85	! cbmf1 Real Output cloud base mass flux
	86	! sig1 Real In/Out section adiabatic updraft
	87	! w01 Real In/Out vertical velocity within adiab updraft
	88	! ptop21 Real In/Out top of entraining zone
	89	! Ma1 Real Output mass flux adiabatic updraft
	90	! mip1 Real Output mass flux shed by the adiabatic updraft
	91	! Vprecip1 Real Output vertical profile of precipitations
	92	! upwd1 Real Output total upward mass flux (adiab+mixed)
	93	! dnwd1 Real Output saturated downward mass flux (mixed)
	94	! dnwd01 Real Output unsaturated downward mass flux
	95	! qcondc1 Real Output in-cld mixing ratio of condensed water
	96	! wd1 Real Output downdraft velocity scale for sfc fluxes
	97	! cape1 Real Output CAPE
	98	! cin1 Real Output CIN
	99	! tvp1 Real Output adiab lifted parcell virt temp
	100	! ftd1 Real Output precip temp tend
	101	! fqt1 Real Output precip spec hum tend
	102	! Plim11 Real Output
	103	! Plim21 Real Output
	104	! asupmax1 Real Output
	105	! supmax01 Real Output
	106	! asupmaxmin1 Real Output
[879]	107
[2007]	108	! ftd1 Real Output Array of temperature tendency due to precipitations (K/s) of dimension ND,
	109	! defined at same grid levels as T, Q, QS and P.
[879]	110
[2007]	111	! fqd1 Real Output Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
	112	! of dimension ND, defined at same grid levels as T, Q, QS and P.
[879]	113
[2007]	114	! wdtrainA1 Real Output precipitation detrained from adiabatic draught;
	115	! used in tracer transport (cvltr)
	116	! wdtrainM1 Real Output precipitation detrained from mixed draughts;
	117	! used in tracer transport (cvltr)
	118	! da1 Real Output used in tracer transport (cvltr)
	119	! phi1 Real Output used in tracer transport (cvltr)
	120	! mp1 Real Output used in tracer transport (cvltr)
	121
	122	! phi21 Real Output used in tracer transport (cvltr)
	123
	124	! d1a1 Real Output used in tracer transport (cvltr)
	125	! dam1 Real Output used in tracer transport (cvltr)
	126
	127	! epmlmMm1 Real Output used in tracer transport (cvltr)
	128	! eplaMm1 Real Output used in tracer transport (cvltr)
	129
	130	! evap1 Real Output
	131	! ep1 Real Output
	132	! sigij1 Real Output used in tracer transport (cvltr)
	133	! elij1 Real Output
	134	! wghti1 Real Output final weight of the feeding layers,
	135	! used in tracer transport (cvltr)
[879]	136
	137
[2007]	138	! S. Bony, Mar 2002:
	139	! * Several modules corresponding to different physical processes
	140	! * Several versions of convect may be used:
	141	! - iflag_con=3: version lmd (previously named convect3)
	142	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
	143	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
	144	! S. Bony, Oct 2002:
	145	! * Vectorization of convect3 (ie version lmd)
[879]	146
[2007]	147	! ..............................END PROLOGUE.............................
[879]	148
	149
[1992]	150	include "dimensions.h"
[2007]	151	!!!!!#include "dimphy.h"
[1992]	152	include 'iniprint.h'
[879]	153
	154
[2007]	155	! Input
[1992]	156	INTEGER len
	157	INTEGER nd
	158	INTEGER ndp1
	159	INTEGER ntra
	160	INTEGER iflag_con
	161	INTEGER iflag_mix
	162	INTEGER iflag_ice_thermo
	163	INTEGER iflag_clos
[2007]	164	LOGICAL ok_conserv_q
[1992]	165	REAL delt
	166	REAL t1(len, nd)
	167	REAL q1(len, nd)
	168	REAL qs1(len, nd)
	169	REAL t1_wake(len, nd)
	170	REAL q1_wake(len, nd)
	171	REAL qs1_wake(len, nd)
	172	REAL s1_wake(len)
	173	REAL u1(len, nd)
	174	REAL v1(len, nd)
	175	REAL tra1(len, nd, ntra)
	176	REAL p1(len, nd)
	177	REAL ph1(len, ndp1)
[2007]	178	REAL Ale1(len)
	179	REAL Alp1(len)
[1992]	180	REAL sig1feed1 ! pressure at lower bound of feeding layer
	181	REAL sig2feed1 ! pressure at upper bound of feeding layer
	182	REAL wght1(nd) ! weight density determining the feeding mixture
[879]	183
[2007]	184	! Output
[1992]	185	INTEGER iflag1(len)
	186	REAL ft1(len, nd)
	187	REAL fq1(len, nd)
	188	REAL fu1(len, nd)
	189	REAL fv1(len, nd)
	190	REAL ftra1(len, nd, ntra)
	191	REAL precip1(len)
	192	INTEGER kbas1(len)
	193	INTEGER ktop1(len)
	194	REAL cbmf1(len)
	195	REAL plcl1(klon)
	196	REAL plfc1(klon)
	197	REAL wbeff1(klon)
	198	REAL sig1(len, klev) !input/output
	199	REAL w01(len, klev) !input/output
	200	REAL ptop21(len)
	201	REAL sigd1(len)
	202	REAL ma1(len, nd)
	203	REAL mip1(len, nd)
[2007]	204	! real Vprecip1(len,nd)
[1992]	205	REAL vprecip1(len, nd+1)
	206	REAL upwd1(len, nd)
	207	REAL dnwd1(len, nd)
	208	REAL dnwd01(len, nd)
	209	REAL qcondc1(len, nd) ! cld
	210	REAL wd1(len) ! gust
	211	REAL cape1(len)
	212	REAL cin1(len)
	213	REAL tvp1(len, nd)
[879]	214
[2007]	215	!AC!
	216	!! real da1(len,nd),phi1(len,nd,nd)
	217	!! real da(len,nd),phi(len,nd,nd)
	218	!AC!
[1992]	219	REAL ftd1(len, nd)
	220	REAL fqd1(len, nd)
[2007]	221	REAL Plim11(len)
	222	REAL Plim21(len)
[1992]	223	REAL asupmax1(len, nd)
	224	REAL supmax01(len)
	225	REAL asupmaxmin1(len)
	226	INTEGER lalim_conv(len)
[2007]	227	! RomP >>>
	228	REAL wdtrainA1(len, nd), wdtrainM1(len, nd)
[1992]	229	REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
[2007]	230	REAL epmlmMm1(len, nd, nd), eplaMm1(len, nd)
[1992]	231	REAL evap1(len, nd), ep1(len, nd)
	232	REAL sigij1(len, nd, nd), elij1(len, nd, nd)
[2007]	233	!JYG,RL
	234	REAL wghti1(len, nd) ! final weight of the feeding layers
	235	!JYG,RL
[1992]	236	REAL phi21(len, nd, nd)
	237	REAL d1a1(len, nd), dam1(len, nd)
[2007]	238	! RomP <<<
[879]	239
[2007]	240	! -------------------------------------------------------------------
	241	! Prolog by Kerry Emanuel.
	242	! -------------------------------------------------------------------
	243	! --- ARGUMENTS
	244	! -------------------------------------------------------------------
	245	! --- On input:
[879]	246
[2007]	247	! t: Array of absolute temperature (K) of dimension ND, with first
	248	! index corresponding to lowest model level. Note that this array
	249	! will be altered by the subroutine if dry convective adjustment
	250	! occurs and if IPBL is not equal to 0.
[879]	251
[2007]	252	! q: Array of specific humidity (gm/gm) of dimension ND, with first
	253	! index corresponding to lowest model level. Must be defined
	254	! at same grid levels as T. Note that this array will be altered
	255	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	256
[2007]	257	! qs: Array of saturation specific humidity of dimension ND, with first
	258	! index corresponding to lowest model level. Must be defined
	259	! at same grid levels as T. Note that this array will be altered
	260	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	261
[2007]	262	! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
	263	! of dimension ND, with first index corresponding to lowest model level.
[879]	264
[2007]	265	! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
	266	! of dimension ND, with first index corresponding to lowest model level.
	267	! Must be defined at same grid levels as T.
[879]	268
[2007]	269	! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
	270	! of dimension ND, with first index corresponding to lowest model level.
	271	! Must be defined at same grid levels as T.
[879]	272
[2007]	273	! s_wake: Array of fractionnal area occupied by the wakes.
[879]	274
[2007]	275	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
	276	! index corresponding with the lowest model level. Defined at
	277	! same levels as T. Note that this array will be altered if
	278	! dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	279
[2007]	280	! v: Same as u but for meridional velocity.
[1146]	281
[2007]	282	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
	283	! where NTRA is the number of different tracers. If no
	284	! convective tracer transport is needed, define a dummy
	285	! input array of dimension (ND,1). Tracers are defined at
	286	! same vertical levels as T. Note that this array will be altered
	287	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	288
[2007]	289	! p: Array of pressure (mb) of dimension ND, with first
	290	! index corresponding to lowest model level. Must be defined
	291	! at same grid levels as T.
[879]	292
[2007]	293	! ph: Array of pressure (mb) of dimension ND+1, with first index
	294	! corresponding to lowest level. These pressures are defined at
	295	! levels intermediate between those of P, T, Q and QS. The first
	296	! value of PH should be greater than (i.e. at a lower level than)
	297	! the first value of the array P.
[879]	298
[2007]	299	! ALE: Available lifting Energy
[879]	300
[2007]	301	! ALP: Available lifting Power
[879]	302
[2007]	303	! nl: The maximum number of levels to which convection can penetrate, plus 1.
	304	! NL MUST be less than or equal to ND-1.
[879]	305
[2007]	306	! delt: The model time step (sec) between calls to CONVECT
[879]	307
[2007]	308	! ----------------------------------------------------------------------------
	309	! --- On Output:
[879]	310
[2007]	311	! iflag: An output integer whose value denotes the following:
	312	! VALUE INTERPRETATION
	313	! ----- --------------
	314	! 0 Moist convection occurs.
	315	! 1 Moist convection occurs, but a CFL condition
	316	! on the subsidence warming is violated. This
	317	! does not cause the scheme to terminate.
	318	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
	319	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
	320	! 4 No moist convection; atmosphere is not
	321	! unstable
	322	! 6 No moist convection because ihmin le minorig.
	323	! 7 No moist convection because unreasonable
	324	! parcel level temperature or specific humidity.
	325	! 8 No moist convection: lifted condensation
	326	! level is above the 200 mb level.
	327	! 9 No moist convection: cloud base is higher
	328	! then the level NL-1.
[879]	329
[2007]	330	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
	331	! grid levels as T, Q, QS and P.
[1652]	332
[2007]	333	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
	334	! defined at same grid levels as T, Q, QS and P.
[1652]	335
[2007]	336	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
	337	! defined at same grid levels as T.
[1652]	338
[2007]	339	! fv: Same as FU, but for forcing of meridional velocity.
[879]	340
[2007]	341	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
	342	! second, defined at same levels as T. Dimensioned (ND,NTRA).
[879]	343
[2007]	344	! precip: Scalar convective precipitation rate (mm/day).
[879]	345
[2007]	346	! wd: A convective downdraft velocity scale. For use in surface
	347	! flux parameterizations. See convect.ps file for details.
[879]	348
[2007]	349	! tprime: A convective downdraft temperature perturbation scale (K).
	350	! For use in surface flux parameterizations. See convect.ps
	351	! file for details.
[879]	352
[2007]	353	! qprime: A convective downdraft specific humidity
	354	! perturbation scale (gm/gm).
	355	! For use in surface flux parameterizations. See convect.ps
	356	! file for details.
[1992]	357
[2007]	358	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
	359	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
	360	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
	361	! by the calling program between calls to CONVECT.
[1992]	362
[2007]	363	! det: Array of detrainment mass flux of dimension ND.
	364	! -------------------------------------------------------------------
[1992]	365
[2007]	366	! Local (non compressed) arrays
[1992]	367
	368
	369	INTEGER i, k, n, il, j
	370	INTEGER nword1, nword2, nword3, nword4
	371	INTEGER icbmax
	372	INTEGER nk1(klon)
	373	INTEGER icb1(klon)
	374	INTEGER icbs1(klon)
	375
	376	LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
	377	LOGICAL, SAVE :: debut = .TRUE.
[2007]	378	!$OMP THREADPRIVATE(debut)
[1992]	379
	380	REAL tnk1(klon)
	381	REAL thnk1(klon)
	382	REAL qnk1(klon)
	383	REAL gznk1(klon)
	384	REAL pnk1(klon)
	385	REAL qsnk1(klon)
	386	REAL unk1(klon)
	387	REAL vnk1(klon)
	388	REAL cpnk1(klon)
	389	REAL hnk1(klon)
	390	REAL pbase1(klon)
	391	REAL buoybase1(klon)
	392
	393	REAL lf1(klon, klev), lf1_wake(klon, klev)
	394	REAL lv1(klon, klev), lv1_wake(klon, klev)
	395	REAL cpn1(klon, klev), cpn1_wake(klon, klev)
	396	REAL tv1(klon, klev), tv1_wake(klon, klev)
	397	REAL gz1(klon, klev), gz1_wake(klon, klev)
	398	REAL hm1(klon, klev), hm1_wake(klon, klev)
	399	REAL h1(klon, klev), h1_wake(klon, klev)
	400	REAL tp1(klon, klev)
	401	REAL clw1(klon, klev)
	402	REAL th1(klon, klev), th1_wake(klon, klev)
	403
	404	REAL bid(klon, klev) ! dummy array
	405
	406	INTEGER ncum
	407
	408	INTEGER j1feed(klon)
	409	INTEGER j2feed(klon)
	410	REAL p1feed1(len) ! pressure at lower bound of feeding layer
	411	REAL p2feed1(len) ! pressure at upper bound of feeding layer
[2007]	412	!JYG,RL
	413	!! real wghti1(len,nd) ! weights of the feeding layers
	414	!JYG,RL
[1992]	415
[2007]	416	! (local) compressed fields:
[1992]	417
	418	INTEGER nloc
[2007]	419	! parameter (nloc=klon) ! pour l'instant
[1992]	420
	421	INTEGER idcum(nloc)
	422	INTEGER iflag(nloc), nk(nloc), icb(nloc)
	423	INTEGER nent(nloc, klev)
	424	INTEGER icbs(nloc)
	425	INTEGER inb(nloc), inbis(nloc)
	426
	427	REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
	428	REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
	429	REAL t_wake(nloc, klev), q_wake(nloc, klev), qs_wake(nloc, klev)
	430	REAL s_wake(nloc)
	431	REAL u(nloc, klev), v(nloc, klev)
	432	REAL gz(nloc, klev), h(nloc, klev), hm(nloc, klev)
	433	REAL h_wake(nloc, klev), hm_wake(nloc, klev)
	434	REAL lv(nloc, klev), lf(nloc, klev), cpn(nloc, klev)
	435	REAL lv_wake(nloc, klev), lf_wake(nloc, klev), cpn_wake(nloc, klev)
	436	REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
	437	REAL tv_wake(nloc, klev)
	438	REAL clw(nloc, klev)
	439	REAL dph(nloc, klev)
	440	REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
	441	REAL th_wake(nloc, klev)
	442	REAL tvp(nloc, klev)
	443	REAL sig(nloc, klev), w0(nloc, klev), ptop2(nloc)
	444	REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
	445	REAL buoy(nloc, klev)
	446	REAL cape(nloc)
	447	REAL cin(nloc)
	448	REAL m(nloc, klev)
	449	REAL ment(nloc, klev, klev), sigij(nloc, klev, klev)
	450	REAL qent(nloc, klev, klev)
	451	REAL hent(nloc, klev, klev)
	452	REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
	453	REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
	454	REAL elij(nloc, klev, klev)
	455	REAL supmax(nloc, klev)
[2007]	456	REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
[1992]	457	REAL sigd(nloc)
[2007]	458	! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
	459	! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
	460	! real b(nloc,klev), sigd(nloc)
	461	! save mp,qp,up,vp,wt,water,evap,b
[1992]	462	REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
	463	REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
	464	REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
	465	REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
[2007]	466	!$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
[1992]	467	REAL ft(nloc, klev), fq(nloc, klev)
	468	REAL ftd(nloc, klev), fqd(nloc, klev)
	469	REAL fu(nloc, klev), fv(nloc, klev)
	470	REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
	471	REAL ma(nloc, klev), mip(nloc, klev), tls(nloc, klev)
	472	REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
	473	REAL precip(nloc)
[2007]	474	! real Vprecip(nloc,klev)
[1992]	475	REAL vprecip(nloc, klev+1)
	476	REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
	477	REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
[2007]	478	REAL qcondc(nloc, klev) ! cld
	479	REAL wd(nloc) ! gust
	480	REAL Plim1(nloc), plim2(nloc)
[1992]	481	REAL asupmax(nloc, klev)
	482	REAL supmax0(nloc)
	483	REAL asupmaxmin(nloc)
	484
	485	REAL tnk(nloc), qnk(nloc), gznk(nloc)
	486	REAL wghti(nloc, nd)
	487	REAL hnk(nloc), unk(nloc), vnk(nloc)
	488
[2007]	489	! RomP >>>
	490	REAL wdtrainA(nloc, klev), wdtrainM(nloc, klev)
[1992]	491	REAL da(len, nd), phi(len, nd, nd)
[2007]	492	REAL epmlmMm(nloc, klev, klev), eplaMm(nloc, klev)
[1992]	493	REAL phi2(len, nd, nd)
	494	REAL d1a(len, nd), dam(len, nd)
[2007]	495	! RomP <<<
[1992]	496
	497	LOGICAL, SAVE :: first = .TRUE.
[2007]	498	!$OMP THREADPRIVATE(first)
[1992]	499	CHARACTER (LEN=20) :: modname = 'cva_driver'
	500	CHARACTER (LEN=80) :: abort_message
	501
	502
[2007]	503	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
	504	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
[1992]	505
[2007]	506	! -------------------------------------------------------------------
	507	! --- SET CONSTANTS AND PARAMETERS
	508	! -------------------------------------------------------------------
[1992]	509
	510	IF (first) THEN
	511	ALLOCATE (mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
	512	ALLOCATE (vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
	513	ALLOCATE (ice(nloc,klev), fondue(nloc,klev))
	514	ALLOCATE (evap(nloc,klev), b(nloc,klev))
	515	ALLOCATE (frac(nloc,klev), faci(nloc,klev))
	516	first = .FALSE.
	517	END IF
[2007]	518	! -- set simulation flags:
	519	! (common cvflag)
[1992]	520
	521	CALL cv_flag(iflag_ice_thermo)
	522
[2007]	523	! -- set thermodynamical constants:
	524	! (common cvthermo)
[1992]	525
	526	CALL cv_thermo(iflag_con)
	527
[2007]	528	! -- set convect parameters
[1992]	529
[2007]	530	! includes microphysical parameters and parameters that
	531	! control the rate of approach to quasi-equilibrium)
	532	! (common cvparam)
[1992]	533
	534	IF (iflag_con==3) THEN
	535	CALL cv3_param(nd, delt)
	536
	537	END IF
	538
	539	IF (iflag_con==4) THEN
	540	CALL cv_param(nd)
	541	END IF
	542
[2007]	543	! ---------------------------------------------------------------------
	544	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
	545	! ---------------------------------------------------------------------
[1992]	546	nword1 = len
	547	nword2 = len*nd
	548	nword3 = lenndntra
	549	nword4 = lenndnd
	550
	551	iflag1(:) = 0
	552	ktop1(:) = 0
	553	kbas1(:) = 0
	554	ft1(:, :) = 0.0
	555	fq1(:, :) = 0.0
	556	fu1(:, :) = 0.0
	557	fv1(:, :) = 0.0
	558	ftra1(:, :, :) = 0.
	559	precip1(:) = 0.
	560	cbmf1(:) = 0.
	561	ptop21(:) = 0.
	562	sigd1(:) = 0.
	563	ma1(:, :) = 0.
	564	mip1(:, :) = 0.
	565	vprecip1(:, :) = 0.
	566	upwd1(:, :) = 0.
	567	dnwd1(:, :) = 0.
	568	dnwd01(:, :) = 0.
	569	qcondc1(:, :) = 0.
	570	wd1(:) = 0.
	571	cape1(:) = 0.
	572	cin1(:) = 0.
	573	tvp1(:, :) = 0.
	574	ftd1(:, :) = 0.
	575	fqd1(:, :) = 0.
[2007]	576	Plim11(:) = 0.
	577	Plim21(:) = 0.
[1992]	578	asupmax1(:, :) = 0.
	579	supmax01(:) = 0.
	580	asupmaxmin1(:) = 0.
	581
	582	DO il = 1, len
	583	cin1(il) = -100000.
	584	cape1(il) = -1.
	585	END DO
	586
	587	IF (iflag_con==3) THEN
	588	DO il = 1, len
	589	sig1(il, nd) = sig1(il, nd) + 1.
	590	sig1(il, nd) = amin1(sig1(il,nd), 12.1)
	591	END DO
	592	END IF
	593
[2007]	594	! RomP >>>
	595	wdtrainA1(:, :) = 0.
	596	wdtrainM1(:, :) = 0.
[1992]	597	da1(:, :) = 0.
	598	phi1(:, :, :) = 0.
[2007]	599	epmlmMm1(:, :, :) = 0.
	600	eplaMm1(:, :) = 0.
[1992]	601	mp1(:, :) = 0.
	602	evap1(:, :) = 0.
	603	ep1(:, :) = 0.
	604	sigij1(:, :, :) = 0.
	605	elij1(:, :, :) = 0.
	606	phi21(:, :, :) = 0.
	607	d1a1(:, :) = 0.
	608	dam1(:, :) = 0.
[2007]	609	! RomP <<<
	610	! ---------------------------------------------------------------------
	611	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
	612	! ---------------------------------------------------------------------
[1992]	613
	614	DO il = 1, nloc
	615	coef_clos(il) = 1.
	616	END DO
	617
[2007]	618	! --------------------------------------------------------------------
	619	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	620	! --------------------------------------------------------------------
[1992]	621
	622	IF (iflag_con==3) THEN
	623
	624	IF (debut) THEN
	625	PRINT *, 'Emanuel version 3 nouvelle'
	626	END IF
[2007]	627	! print*,'t1, q1 ',t1,q1
	628	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
	629	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
[1992]	630
	631
[2007]	632	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
	633	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
	634	h1_wake, bid, th1_wake)
[1992]	635
	636	END IF
	637
	638	IF (iflag_con==4) THEN
	639	PRINT *, 'Emanuel version 4 '
[2007]	640	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
	641	lv1, cpn1, tv1, gz1, h1, hm1)
[1992]	642	END IF
	643
[2007]	644	! --------------------------------------------------------------------
	645	! --- CONVECTIVE FEED
	646	! --------------------------------------------------------------------
[1992]	647
[2007]	648	! compute feeding layer potential temperature and mixing ratio :
[1992]	649
[2007]	650	! get bounds of feeding layer
[1992]	651
[2007]	652	! test niveaux couche alimentation KE
[1992]	653	IF (sig1feed1==sig2feed1) THEN
	654	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
	655	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
	656	abort_message = ''
	657	CALL abort_gcm(modname, abort_message, 1)
	658	END IF
	659
	660	DO i = 1, len
	661	p1feed1(i) = sig1feed1*ph1(i, 1)
	662	p2feed1(i) = sig2feed1*ph1(i, 1)
[2007]	663	!test maf
	664	! p1feed1(i)=ph1(i,1)
	665	! p2feed1(i)=ph1(i,2)
	666	! p2feed1(i)=ph1(i,3)
	667	!testCR: on prend la couche alim des thermiques
	668	! p2feed1(i)=ph1(i,lalim_conv(i)+1)
	669	! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
[1992]	670	END DO
	671
	672	IF (iflag_con==3) THEN
	673	END IF
	674	DO i = 1, len
[2007]	675	! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
[1992]	676	END DO
	677	IF (iflag_con==3) THEN
	678
[2007]	679	! print*, 'IFLAG1 avant cv3_feed'
	680	! print*,'len,nd',len,nd
	681	! write(*,'(64i1)') iflag1(2:klon-1)
[1992]	682
[2007]	683	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
	684	t1, q1, u1, v1, p1, ph1, hm1, gz1, &
	685	p1feed1, p2feed1, wght1, &
	686	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
	687	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
[1992]	688	END IF
	689
[2007]	690	! print*, 'IFLAG1 apres cv3_feed'
	691	! print*,'len,nd',len,nd
	692	! write(*,'(64i1)') iflag1(2:klon-1)
[1992]	693
	694	IF (iflag_con==4) THEN
[2007]	695	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
	696	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
[1992]	697	END IF
	698
[2007]	699	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
[1992]	700
[2007]	701	! --------------------------------------------------------------------
	702	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
	703	! (up through ICB for convect4, up through ICB+1 for convect3)
	704	! Calculates the lifted parcel virtual temperature at nk, the
	705	! actual temperature, and the adiabatic liquid water content.
	706	! --------------------------------------------------------------------
[1992]	707
	708	IF (iflag_con==3) THEN
	709
[2007]	710	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
	711	gznk1, tp1, tvp1, clw1, icbs1)
[1992]	712	END IF
	713
	714
	715	IF (iflag_con==4) THEN
[2007]	716	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
	717	tp1, tvp1, clw1)
[1992]	718	END IF
	719
[2007]	720	! -------------------------------------------------------------------
	721	! --- TRIGGERING
	722	! -------------------------------------------------------------------
[1992]	723
[2007]	724	! print *,' avant triggering, iflag_con ',iflag_con
[1992]	725
	726	IF (iflag_con==3) THEN
	727
[2007]	728	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
	729	pbase1, buoybase1, iflag1, sig1, w01)
[1992]	730
	731
[2007]	732	! print*, 'IFLAG1 apres cv3_triger'
	733	! print*,'len,nd',len,nd
	734	! write(*,'(64i1)') iflag1(2:klon-1)
[1992]	735
[2007]	736	! call dump2d(iim,jjm-1,sig1(2)
[1992]	737	END IF
	738
	739	IF (iflag_con==4) THEN
	740	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
	741	END IF
	742
	743
[2007]	744	! =====================================================================
	745	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
	746	! =====================================================================
[1992]	747
	748	ncum = 0
	749	DO i = 1, len
	750	IF (iflag1(i)==0) THEN
	751	ncum = ncum + 1
	752	idcum(ncum) = i
	753	END IF
	754	END DO
	755
[2007]	756	! print*,'klon, ncum = ',len,ncum
[1992]	757
	758	IF (ncum>0) THEN
	759
[2007]	760	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	761	! --- COMPRESS THE FIELDS
	762	! (-> vectorization over convective gridpoints)
	763	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	764
	765	IF (iflag_con==3) THEN
[2007]	766	! print*,'ncum tv1 ',ncum,tv1
	767	! print*,'tvp1 ',tvp1
	768	CALL cv3a_compress(len, nloc, ncum, nd, ntra, &
	769	iflag1, nk1, icb1, icbs1, &
	770	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
	771	wghti1, pbase1, buoybase1, &
	772	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
	773	u1, v1, gz1, th1, th1_wake, &
	774	tra1, &
	775	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	776	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
	777	sig1, w01, ptop21, &
	778	Ale1, Alp1, &
	779	iflag, nk, icb, icbs, &
	780	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
	781	wghti, pbase, buoybase, &
	782	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
	783	u, v, gz, th, th_wake, &
	784	tra, &
	785	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
	786	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
	787	sig, w0, ptop2, &
	788	Ale, Alp)
[1992]	789
[2007]	790	! print*,'tv ',tv
	791	! print*,'tvp ',tvp
[1992]	792
	793	END IF
	794
	795	IF (iflag_con==4) THEN
[2007]	796	CALL cv_compress(len, nloc, ncum, nd, &
	797	iflag1, nk1, icb1, &
	798	cbmf1, plcl1, tnk1, qnk1, gznk1, &
	799	t1, q1, qs1, u1, v1, gz1, &
	800	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	801	iflag, nk, icb, &
	802	cbmf, plcl, tnk, qnk, gznk, &
	803	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
	804	dph)
[1992]	805	END IF
	806
[2007]	807	! -------------------------------------------------------------------
	808	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
	809	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	810	! --- &
	811	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	812	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	813	! --- &
	814	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
	815	! -------------------------------------------------------------------
[1992]	816
	817	IF (iflag_con==3) THEN
[2007]	818	CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, & !na->nd
	819	tnk, qnk, gznk, hnk, t, q, qs, gz, &
	820	p, h, tv, lv, lf, pbase, buoybase, plcl, &
	821	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
	822	frac)
[1992]	823
	824	END IF
	825
	826	IF (iflag_con==4) THEN
[2007]	827	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
	828	tnk, qnk, gznk, t, q, qs, gz, &
	829	p, dph, h, tv, lv, &
	830	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
[1992]	831	END IF
	832
[2007]	833	! -------------------------------------------------------------------
	834	! --- MIXING(1) (if iflag_mix .ge. 1)
	835	! -------------------------------------------------------------------
[1992]	836	IF (iflag_con==3) THEN
	837	IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
[2007]	838	WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
	839	'. Might as well stop here.'
[1992]	840	STOP
	841	END IF
	842	IF (iflag_mix>=1) THEN
	843	CALL zilch(supmax, nloc*klev)
[2007]	844	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
	845	ph, t, q, qs, u, v, tra, h, lv, qnk, &
	846	unk, vnk, hp, tv, tvp, ep, clw, sig, &
	847	ment, qent, hent, uent, vent, nent, &
	848	sigij, elij, supmax, ments, qents, traent)
	849	! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
[1992]	850
	851	ELSE
	852	CALL zilch(supmax, nloc*klev)
	853	END IF
	854	END IF
[2007]	855	! -------------------------------------------------------------------
	856	! --- CLOSURE
	857	! -------------------------------------------------------------------
[1992]	858
	859
	860	IF (iflag_con==3) THEN
	861	IF (iflag_clos==0) THEN
[2007]	862	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	863	pbase, p, ph, tv, buoy, &
	864	sig, w0, cape, m, iflag)
[1992]	865	END IF
	866
	867	ok_inhib = iflag_mix == 2
	868
	869	IF (iflag_clos==1) THEN
	870	PRINT *, ' pas d appel cv3p_closure'
[2007]	871	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
	872	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
	873	! c : ,supmax
	874	! c o ,sig,w0,ptop2,cape,cin,m)
[1992]	875	END IF
	876	IF (iflag_clos==2) THEN
[2007]	877	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	878	pbase, plcl, p, ph, tv, tvp, buoy, &
	879	supmax, ok_inhib, Ale, Alp, &
	880	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
	881	Plim1, plim2, asupmax, supmax0, &
	882	asupmaxmin, cbmf, plfc, wbeff)
[1992]	883
	884	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
	885	END IF
	886	END IF ! iflag_con.eq.3
	887
	888	IF (iflag_con==4) THEN
[2007]	889	CALL cv_closure(nloc, ncum, nd, nk, icb, &
	890	tv, tvp, p, ph, dph, plcl, cpn, &
	891	iflag, cbmf)
[1992]	892	END IF
	893
[2007]	894	! print *,'cv_closure-> cape ',cape(1)
[1992]	895
[2007]	896	! -------------------------------------------------------------------
	897	! --- MIXING(2)
	898	! -------------------------------------------------------------------
[1992]	899
	900	IF (iflag_con==3) THEN
	901	IF (iflag_mix==0) THEN
[2007]	902	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
	903	ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
	904	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
	905	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
[1992]	906	CALL zilch(hent, nlocklevklev)
	907	ELSE
	908	CALL cv3_mixscale(nloc, ncum, nd, ment, m)
	909	IF (debut) THEN
	910	PRINT *, ' cv3_mixscale-> '
	911	END IF !(debut) THEN
	912	END IF
	913	END IF
	914
	915	IF (iflag_con==4) THEN
[2007]	916	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
	917	ph, t, q, qs, u, v, h, lv, qnk, &
	918	hp, tv, tvp, ep, clw, cbmf, &
	919	m, ment, qent, uent, vent, nent, sigij, elij)
	920	END IF
[1992]	921
	922	IF (debut) THEN
	923	PRINT *, ' cv_mixing ->'
	924	END IF !(debut) THEN
[2007]	925	! do i = 1,klev
	926	! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
	927	! enddo
[1992]	928
[2007]	929	! -------------------------------------------------------------------
	930	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
	931	! -------------------------------------------------------------------
[1992]	932	IF (iflag_con==3) THEN
	933	IF (debut) THEN
	934	PRINT *, ' cva_driver -> cv3_unsat '
	935	END IF !(debut) THEN
	936
[2007]	937	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
	938	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
	939	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
	940	ep, sigp, clw, &
	941	m, ment, elij, delt, plcl, coef_clos, &
	942	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
	943	faci, b, sigd, &
	944	wdtrainA, wdtrainM) ! RomP
[1992]	945	END IF
	946
	947	IF (iflag_con==4) THEN
[2007]	948	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
	949	h, lv, ep, sigp, clw, m, ment, elij, &
	950	iflag, mp, qp, up, vp, wt, water, evap)
[1992]	951	END IF
	952
	953	IF (debut) THEN
	954	PRINT *, 'cv_unsat-> '
	955	END IF !(debut) THEN
	956
[2007]	957	! print *,'cv_unsat-> mp ',mp
	958	! print *,'cv_unsat-> water ',water
	959	! -------------------------------------------------------------------
	960	! --- YIELD
	961	! (tendencies, precipitation, variables of interface with other
	962	! processes, etc)
	963	! -------------------------------------------------------------------
[1992]	964
	965	IF (iflag_con==3) THEN
	966
[2007]	967	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
	968	icb, inb, delt, &
	969	t, q, t_wake, q_wake, s_wake, u, v, tra, &
	970	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
	971	ep, clw, m, tp, mp, qp, up, vp, trap, &
	972	wt, water, ice, evap, fondue, faci, b, sigd, &
	973	ment, qent, hent, iflag_mix, uent, vent, &
	974	nent, elij, traent, sig, &
	975	tv, tvp, wghti, &
	976	iflag, precip, vprecip, ft, fq, fu, fv, ftra, &
	977	cbmf, upwd, dnwd, dnwd0, ma, mip, &
	978	tls, tps, qcondc, wd, &
	979	ftd, fqd)
[1992]	980	END IF
	981
	982	IF (debut) THEN
	983	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(1, 1)
	984	END IF !(debut) THEN
	985
	986	IF (iflag_con==4) THEN
[2007]	987	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
	988	t, q, u, v, &
	989	gz, p, ph, h, hp, lv, cpn, &
	990	ep, clw, frac, m, mp, qp, up, vp, &
	991	wt, water, evap, &
	992	ment, qent, uent, vent, nent, elij, &
	993	tv, tvp, &
	994	iflag, wd, qprime, tprime, &
	995	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
[1992]	996	END IF
	997
[2007]	998	!AC!
	999	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1000	!--- passive tracers
	1001	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	1002
	1003	IF (iflag_con==3) THEN
[2007]	1004	!RomP >>>
	1005	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
	1006	ment, sigij, da, phi, phi2, d1a, dam, &
	1007	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
	1008	icb, inb)
	1009	!RomP <<<
[1992]	1010	END IF
	1011
[2007]	1012	!AC!
[1992]	1013
[2007]	1014	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1015	! --- UNCOMPRESS THE FIELDS
	1016	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	1017
	1018
	1019	IF (iflag_con==3) THEN
[2007]	1020	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, &
	1021	iflag, icb, inb, &
	1022	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
	1023	ft, fq, fu, fv, ftra, &
	1024	sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, &
	1025	qcondc, wd, cape, cin, &
	1026	tvp, &
	1027	ftd, fqd, &
	1028	Plim1, plim2, asupmax, supmax0, &
	1029	asupmaxmin, &
	1030	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
	1031	clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
	1032	wdtrainA, wdtrainM, & ! RomP
	1033	iflag1, kbas1, ktop1, &
	1034	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
	1035	ft1, fq1, fu1, fv1, ftra1, &
	1036	sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, &
	1037	qcondc1, wd1, cape1, cin1, &
	1038	tvp1, &
	1039	ftd1, fqd1, &
	1040	Plim11, plim21, asupmax1, supmax01, &
	1041	asupmaxmin1, &
	1042	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
	1043	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
	1044	wdtrainA1, wdtrainM1) ! RomP
[1992]	1045	END IF
	1046
	1047	IF (iflag_con==4) THEN
[2007]	1048	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
	1049	iflag, &
	1050	precip, cbmf, &
	1051	ft, fq, fu, fv, &
	1052	ma, qcondc, &
	1053	iflag1, &
	1054	precip1,cbmf1, &
	1055	ft1, fq1, fu1, fv1, &
	1056	ma1, qcondc1)
[1992]	1057	END IF
	1058
	1059	END IF ! ncum>0
	1060
	1061	IF (debut) THEN
	1062	PRINT *, ' cv_compress -> '
	1063	debut = .FALSE.
[2007]	1064	END IF !(debut) THEN
[1992]	1065
[2007]	1066
[1992]	1067	RETURN
	1068	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format