Context Navigation

cva_driver.F90 @ 2314

Last change on this file since 2314 was 2298, checked in by Laurent Fairhead, 9 years ago
Merged trunk changes -r2237:2291 into testing branch
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: 44.5 KB

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

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

Download in other formats:

Original Format