Context Navigation

cva_driver.F90 @ 354

Last change on this file since 354 was 265, checked in by lfita, 10 years ago
Adding control error values on convection, since with this it has ran!!!
File size: 46.7 KB

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

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

Download in other formats:

Original Format