Context Navigation

cva_driver.F90 @ 5128

Last change on this file since 5128 was 5117, checked in by abarral, 5 months ago
rename modules properly lmdz_* move some unused files to obsolete/ (lint) uppercase fortran keywords
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: 52.1 KB

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

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

Download in other formats:

Original Format