Context Navigation

cva_driver.F90 @ 5132

Last change on this file since 5132 was 5132, checked in by abarral, 4 months ago
Correct arguments order in abort_gcm Merge r5085 r5097 r5109 r5124 r5125 r5126 r5127 Replace calls to get_ioipsl* by IOIPSL in phylmdiso/ Symlink inlandsis and lmdz_simu_airs into phylmdiso as it's needed for the compilation Remove now unused key from makelmdz_fcm
Property svn:keywords set to `Id`
File size: 70.0 KB

Line
1
2	! $Id: cva_driver.F90 5132 2024-07-26 10:23:19Z 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	#ifdef ISO
32	,xt1,xt1_wake,fxt1, xtprecip1 &
33	,xtVprecip1,xtVprecipi1 &
34	,xtclw1,fxtd1,xtevap1,xtwdtrainA1 &
35	#ifdef DIAGISO
36	, water1,xtwater1,qp1,xtp1 &
37	, fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
38	, fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1,fxt_evapprecip1 &
39	, f_detrainement1,q_detrainement1,xt_detrainement1 &
40	#endif
41	#endif
42	) ! epmax_cape
43	! **************************************************************
44	! *
45	! CV_DRIVER *
46	! *
47	! *
48	! written by : Sandrine Bony-Lena , 17/05/2003, 11.19.41 *
49	! modified by : *
50	! **************************************************************
51	! **************************************************************
52
53	USE lmdz_print_control, ONLY: prt_level, lunout
54	USE add_phys_tend_mod, ONLY: fl_cor_ebil
55	USE lmdz_abort_physic, ONLY: abort_physic
56	#ifdef ISO
57	USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,niso,itZonIso,nzone
58	USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,ridicule,bidouille_anti_divergence
59	#ifdef ISOVERIF
60	USE isotopes_verif_mod
61	!, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
62	!& iso_verif_egalite_choix,iso_verif_aberrant_choix,iso_verif_aberrant, &
63	!& iso_verif_egalite,iso_verif_noNaN,iso_verif_positif_nostop,iso_verif_noNaN_nostop
64	#endif
65	#ifdef ISOTRAC
66	USE isotrac_mod, ONLY: option_traceurs,izone_ddft,izone_revap, &
67	& izone_poubelle, index_zone,option_tmin,izone_cond
68	#ifdef ISOVERIF
69	USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
70	& iso_verif_trac_masse_vect
71	USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
72	#endif
73	#endif
74	#endif
75	IMPLICIT NONE
76
77	! .............................START PROLOGUE............................
78
79
80	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
81	! The "1" is removed for the corresponding compressed variables.
82	! PARAMETERS:
83	! Name Type Usage Description
84	! ---------- ---------- ------- ----------------------------
85
86	! len Integer Input first (i) dimension
87	! nd Integer Input vertical (k) dimension
88	! ndp1 Integer Input nd + 1
89	! ntra Integer Input number of tracors
90	! nloc Integer Input dimension of arrays for compressed fields
91	! fqcomp1 Real Output spec hum tend (only mixed draughts)
92	! k_upper Integer Input upmost level for vertical loops
93	! iflag_con Integer Input version of convect (3/4)
94	! iflag_mix Integer Input version of mixing (0/1/2)
95	! iflag_ice_thermo Integer Input accounting for ice thermodynamics (0/1)
96	! iflag_clos Integer Input version of closure (0/1)
97	! tau_cld_cv Real Input characteristic time of dissipation of mixing fluxes
98	! coefw_cld_cv Real Input coefficient for updraft velocity in convection
99	! ok_conserv_q Logical Input when true corrections for water conservation are swtiched on
100	! delt Real Input time step
101	! comp_threshold Real Input threshold on the fraction of convective points below which
102	! fields are compressed
103	! t1 Real Input temperature (sat draught envt)
104	! q1 Real Input specific hum (sat draught envt)
105	! qs1 Real Input sat specific hum (sat draught envt)
106	! t1_wake Real Input temperature (unsat draught envt)
107	! q1_wake Real Input specific hum(unsat draught envt)
108	! qs1_wake Real Input sat specific hum(unsat draughts envt)
109	! s1_wake Real Input fractionnal area covered by wakes
110	! u1 Real Input u-wind
111	! v1 Real Input v-wind
112	! tra1 Real Input tracors
113	! p1 Real Input full level pressure
114	! ph1 Real Input half level pressure
115	! ALE1 Real Input Available lifting Energy
116	! ALP1 Real Input Available lifting Power
117	! sig1feed1 Real Input sigma coord at lower bound of feeding layer
118	! sig2feed1 Real Input sigma coord at upper bound of feeding layer
119	! wght1 Real Input weight density determining the feeding mixture
120	! iflag1 Integer Output flag for Emanuel conditions
121	! ft1 Real Output temp tend
122	! fq1 Real Output spec hum tend
123	! fu1 Real Output u-wind tend
124	! fv1 Real Output v-wind tend
125	! ftra1 Real Output tracor tend
126	! precip1 Real Output precipitation
127	! kbas1 Integer Output cloud base level
128	! ktop1 Integer Output cloud top level
129	! cbmf1 Real Output cloud base mass flux
130	! sig1 Real In/Out section adiabatic updraft
131	! w01 Real In/Out vertical velocity within adiab updraft
132	! ptop21 Real In/Out top of entraining zone
133	! Ma1 Real Output mass flux adiabatic updraft
134	! mip1 Real Output mass flux shed by the adiabatic updraft
135	! Vprecip1 Real Output vertical profile of total precipitation
136	! Vprecipi1 Real Output vertical profile of ice precipitation
137	! upwd1 Real Output total upward mass flux (adiab+mixed)
138	! dnwd1 Real Output saturated downward mass flux (mixed)
139	! detrain1 Real Output detrainment terme klein
140	! dnwd01 Real Output unsaturated downward mass flux
141	! qcondc1 Real Output in-cld mixing ratio of condensed water
142	! wd1 Real Output downdraft velocity scale for sfc fluxes
143	! cape1 Real Output CAPE
144	! cin1 Real Output CIN
145	! tvp1 Real Output adiab lifted parcell virt temp
146	! ftd1 Real Output precip temp tend
147	! fqt1 Real Output precip spec hum tend
148	! Plim11 Real Output
149	! Plim21 Real Output
150	! asupmax1 Real Output
151	! supmax01 Real Output
152	! asupmaxmin1 Real Output
153
154	! ftd1 Real Output Array of temperature tendency due to precipitations (K/s) of dimension ND,
155	! defined at same grid levels as T, Q, QS and P.
156
157	! fqd1 Real Output Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
158	! of dimension ND, defined at same grid levels as T, Q, QS and P.
159
160	! wdtrainA1 Real Output precipitation ejected from adiabatic draught;
161	! should be used in tracer transport (cvltr)
162	! wdtrainS1 Real Output precipitation detrained from shedding of adiabatic draught;
163	! used in tracer transport (cvltr)
164	! wdtrainM1 Real Output precipitation detrained from mixed draughts;
165	! used in tracer transport (cvltr)
166	! da1 Real Output used in tracer transport (cvltr)
167	! phi1 Real Output used in tracer transport (cvltr)
168	! mp1 Real Output used in tracer transport (cvltr)
169	! qtc1 Real Output specific humidity in convection
170	! sigt1 Real Output surface fraction in adiabatic updrafts
171	! phi21 Real Output used in tracer transport (cvltr)
172
173	! d1a1 Real Output used in tracer transport (cvltr)
174	! dam1 Real Output used in tracer transport (cvltr)
175
176	! epmlmMm1 Real Output used in tracer transport (cvltr)
177	! eplaMm1 Real Output used in tracer transport (cvltr)
178
179	! evap1 Real Output
180	! ep1 Real Output
181	! sigij1 Real Output used in tracer transport (cvltr)
182	! clw1 Real Output condensed water content of the adiabatic updraught
183	! elij1 Real Output
184	! wghti1 Real Output final weight of the feeding layers,
185	! used in tracer transport (cvltr)
186
187
188	! S. Bony, Mar 2002:
189	! * Several modules corresponding to different physical processes
190	! * Several versions of convect may be used:
191	! - iflag_con=3: version lmd (previously named convect3)
192	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
193	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
194	! S. Bony, Oct 2002:
195	! * Vectorization of convect3 (ie version lmd)
196
197	! ..............................END PROLOGUE.............................
198
199
200
201	! Input
202	INTEGER, INTENT (IN) :: len
203	INTEGER, INTENT (IN) :: nd
204	INTEGER, INTENT (IN) :: ndp1
205	INTEGER, INTENT (IN) :: ntra
206	INTEGER, INTENT(IN) :: nloc ! (nloc=len) pour l'instant
207	INTEGER, INTENT (IN) :: k_upper
208	INTEGER, INTENT (IN) :: iflag_con
209	INTEGER, INTENT (IN) :: iflag_mix
210	INTEGER, INTENT (IN) :: iflag_ice_thermo
211	INTEGER, INTENT (IN) :: iflag_clos
212	LOGICAL, INTENT (IN) :: ok_conserv_q
213	REAL, INTENT (IN) :: tau_cld_cv
214	REAL, DIMENSION (len, nd), INTENT (OUT) :: fqcomp1
215	REAL, INTENT (IN) :: coefw_cld_cv
216	REAL, INTENT (IN) :: delt
217	REAL, INTENT (IN) :: comp_threshold
218	REAL, DIMENSION (len, nd), INTENT (IN) :: t1
219	REAL, DIMENSION (len, nd), INTENT (IN) :: q1
220	REAL, DIMENSION (len, nd), INTENT (IN) :: qs1
221	REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake
222	REAL, DIMENSION (len, nd), INTENT (IN) :: q1_wake
223	REAL, DIMENSION (len, nd), INTENT (IN) :: qs1_wake
224	REAL, DIMENSION (len), INTENT (IN) :: s1_wake
225	REAL, DIMENSION (len, nd), INTENT (IN) :: u1
226	REAL, DIMENSION (len, nd), INTENT (IN) :: v1
227	REAL, DIMENSION (len, nd, ntra), INTENT (IN) :: tra1
228	REAL, DIMENSION (len, nd), INTENT (IN) :: p1
229	REAL, DIMENSION (len, ndp1), INTENT (IN) :: ph1
230	REAL, DIMENSION (len), INTENT (IN) :: Ale1
231	REAL, DIMENSION (len), INTENT (IN) :: Alp1
232	REAL, DIMENSION (len, nd), INTENT (IN) :: omega1
233	REAL, INTENT (IN) :: sig1feed1 ! pressure at lower bound of feeding layer
234	REAL, INTENT (IN) :: sig2feed1 ! pressure at upper bound of feeding layer
235	REAL, DIMENSION (nd), INTENT (IN) :: wght1 ! weight density determining the feeding mixture
236	INTEGER, DIMENSION (len), INTENT (IN) :: lalim_conv1
237
238	! Input/Output
239	REAL, DIMENSION (len, nd), INTENT (INOUT) :: sig1
240	REAL, DIMENSION (len, nd), INTENT (INOUT) :: w01
241
242	! Output
243	INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1
244	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1
245	REAL, DIMENSION (len, nd), INTENT (OUT) :: fq1
246	REAL, DIMENSION (len, nd), INTENT (OUT) :: fu1
247	REAL, DIMENSION (len, nd), INTENT (OUT) :: fv1
248	REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1
249	REAL, DIMENSION (len), INTENT (OUT) :: precip1
250	INTEGER, DIMENSION (len), INTENT (OUT) :: kbas1
251	INTEGER, DIMENSION (len), INTENT (OUT) :: ktop1
252	REAL, DIMENSION (len), INTENT (OUT) :: cbmf1
253	REAL, DIMENSION (len), INTENT (OUT) :: plcl1
254	REAL, DIMENSION (len, nd), INTENT (OUT) :: detrain1 ! detrainement term of mixed draughts in environment
255	REAL, DIMENSION (len), INTENT (OUT) :: plfc1
256	REAL, DIMENSION (len), INTENT (OUT) :: wbeff1
257	REAL, DIMENSION (len), INTENT (OUT) :: ptop21
258	REAL, DIMENSION (len), INTENT (OUT) :: sigd1
259	REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1 ! adiab. asc. mass flux (staggered grid)
260	REAL, DIMENSION (len, nd), INTENT (OUT) :: mip1 ! mass flux shed from adiab. ascent (extensive)
261	! real Vprecip1(len,nd)
262	REAL, DIMENSION (len, ndp1), INTENT (OUT) :: vprecip1 ! tot precipitation flux (staggered grid)
263	REAL, DIMENSION (len, ndp1), INTENT (OUT) :: vprecipi1 ! ice precipitation flux (staggered grid)
264	REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1 ! upwd sat. mass flux (staggered grid)
265	REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd1 ! dnwd sat. mass flux (staggered grid)
266	REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd01 ! unsat. mass flux (staggered grid)
267	REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1 ! max cloud condensate (intensive) ! cld
268	REAL, DIMENSION (len), INTENT (OUT) :: wd1 ! gust
269	REAL, DIMENSION (len), INTENT (OUT) :: cape1
270	REAL, DIMENSION (len), INTENT (OUT) :: cin1
271	REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1 ! Virt. temp. in the adiab. ascent
272
273	!AC!
274	!! real da1(len,nd),phi1(len,nd,nd)
275	!! real da(len,nd),phi(len,nd,nd)
276	!AC!
277	REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1 ! Temp. tendency due to the sole unsat. drafts
278	REAL, DIMENSION (len, nd), INTENT (OUT) :: fqd1 ! Moist. tendency due to the sole unsat. drafts
279	REAL, DIMENSION (len), INTENT (OUT) :: Plim11
280	REAL, DIMENSION (len), INTENT (OUT) :: Plim21
281	REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1 ! Highest mixing fraction of mixed updraughts
282	REAL, DIMENSION (len), INTENT (OUT) :: supmax01
283	REAL, DIMENSION (len), INTENT (OUT) :: asupmaxmin1
284	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1 ! in cloud water content (intensive) ! cld
285	REAL, DIMENSION (len, nd), INTENT (OUT) :: sigt1 ! fract. cloud area (intensive) ! cld
286
287	! RomP >>>
288	REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainS1, wdtrainM1 ! precipitation sources (extensive)
289	REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 ! unsat. mass flux (staggered grid)
290	REAL, DIMENSION (len, nd), INTENT (OUT) :: da1 ! detrained mass flux of adiab. asc. air (extensive)
291	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
292	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 ! (extensive)
293	REAL, DIMENSION (len, nd), INTENT (OUT) :: eplaMm1 ! (extensive)
294	REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1 ! evaporation rate in precip. downdraft. (intensive)
295	REAL, DIMENSION (len, nd), INTENT (OUT) :: ep1
296	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
297	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1! cond. water per unit mass of mixed draughts (intensive)
298	REAL, DIMENSION (len, nd), INTENT (OUT) :: qta1 ! total water per unit mass of the adiab. asc. (intensive)
299	REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 ! cond. water per unit mass of the adiab. asc. (intensive)
300	!JYG,RL
301	REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti1 ! final weight of the feeding layers (extensive)
302	!JYG,RL
303	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 ! (extensive)
304	REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1 ! (extensive)
305	REAL, DIMENSION (len, nd), INTENT (OUT) :: dam1 ! (extensive)
306	! RomP <<<
307	REAL, DIMENSION (len ), INTENT (OUT) :: epmax_diag1
308	#ifdef ISO
309	REAL, DIMENSION(ntraciso,len,nd), INTENT (IN) :: xt1
310	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt1
311	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xt1_wake
312	REAL, DIMENSION(ntraciso,len), INTENT (OUT) :: xtprecip1
313	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxtd1
314	REAL, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecip1
315	REAL, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecipi1
316	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtwdtrainA1
317	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtevap1
318	REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT) :: xtclw1
319	REAL, DIMENSION (ntraciso,len, nd, nd) :: xtelij1 ! pas besoin de le sortir?
320	#ifdef DIAGISO
321	REAL, DIMENSION(len,nd), INTENT (OUT) :: water1
322	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtwater1
323	REAL, DIMENSION(len,nd), INTENT (OUT) :: qp1
324	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtp1
325	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_detrainement1
326	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_ddft1
327	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_fluxmasse1
328	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_evapprecip1
329	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_detrainement1
330	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_ddft1
331	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_fluxmasse1
332	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_evapprecip1
333	REAL, DIMENSION(len,nd), INTENT (OUT) :: f_detrainement1
334	REAL, DIMENSION(len,nd), INTENT (OUT) :: q_detrainement1
335	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xt_detrainement1
336	! real mentbas1(len,nd)
337	! real qentbas1(len,nd), xtentbas1(niso,len,nd)
338	#endif
339	#endif
340
341
342	! -------------------------------------------------------------------
343	! Prolog by Kerry Emanuel.
344	! -------------------------------------------------------------------
345	! --- ARGUMENTS
346	! -------------------------------------------------------------------
347	! --- On input:
348
349	! t: Array of absolute temperature (K) of dimension ND, with first
350	! index corresponding to lowest model level. Note that this array
351	! will be altered by the SUBROUTINE if dry convective adjustment
352	! occurs and if IPBL is not equal to 0.
353
354	! q: Array of specific humidity (gm/gm) of dimension ND, with first
355	! index corresponding to lowest model level. Must be defined
356	! at same grid levels as T. Note that this array will be altered
357	! if dry convective adjustment occurs and if IPBL is not equal to 0.
358
359	! qs: Array of saturation specific humidity of dimension ND, with first
360	! index corresponding to lowest model level. Must be defined
361	! at same grid levels as T. Note that this array will be altered
362	! if dry convective adjustment occurs and if IPBL is not equal to 0.
363
364	! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
365	! of dimension ND, with first index corresponding to lowest model level.
366
367	! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
368	! of dimension ND, with first index corresponding to lowest model level.
369	! Must be defined at same grid levels as T.
370
371	! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
372	! of dimension ND, with first index corresponding to lowest model level.
373	! Must be defined at same grid levels as T.
374
375	! s_wake: Array of fractionnal area occupied by the wakes.
376
377	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
378	! index corresponding with the lowest model level. Defined at
379	! same levels as T. Note that this array will be altered if
380	! dry convective adjustment occurs and if IPBL is not equal to 0.
381
382	! v: Same as u but for meridional velocity.
383
384	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
385	! where NTRA is the number of different tracers. If no
386	! convective tracer transport is needed, define a dummy
387	! input array of dimension (ND,1). Tracers are defined at
388	! same vertical levels as T. Note that this array will be altered
389	! if dry convective adjustment occurs and if IPBL is not equal to 0.
390
391	! p: Array of pressure (mb) of dimension ND, with first
392	! index corresponding to lowest model level. Must be defined
393	! at same grid levels as T.
394
395	! ph: Array of pressure (mb) of dimension ND+1, with first index
396	! corresponding to lowest level. These pressures are defined at
397	! levels intermediate between those of P, T, Q and QS. The first
398	! value of PH should be greater than (i.e. at a lower level than)
399	! the first value of the array P.
400
401	! ALE: Available lifting Energy
402
403	! ALP: Available lifting Power
404
405	! nl: The maximum number of levels to which convection can penetrate, plus 1.
406	! NL MUST be less than or equal to ND-1.
407
408	! delt: The model time step (sec) between calls to CONVECT
409
410	! ----------------------------------------------------------------------------
411	! --- On Output:
412
413	! iflag: An output integer whose value denotes the following:
414	! VALUE INTERPRETATION
415	! ----- --------------
416	! 0 Moist convection occurs.
417	! 1 Moist convection occurs, but a CFL condition
418	! on the subsidence warming is violated. This
419	! does not cause the scheme to terminate.
420	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
421	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
422	! 4 No moist convection; atmosphere is not
423	! unstable
424	! 6 No moist convection because ihmin le minorig.
425	! 7 No moist convection because unreasonable
426	! parcel level temperature or specific humidity.
427	! 8 No moist convection: lifted condensation
428	! level is above the 200 mb level.
429	! 9 No moist convection: cloud base is higher
430	! then the level NL-1.
431	! 10 No moist convection: cloud top is too warm.
432	! 14 No moist convection; atmosphere is very
433	! stable (=> no computation)
434
435	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
436	! grid levels as T, Q, QS and P.
437
438	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
439	! defined at same grid levels as T, Q, QS and P.
440
441	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
442	! defined at same grid levels as T.
443
444	! fv: Same as FU, but for forcing of meridional velocity.
445
446	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
447	! second, defined at same levels as T. Dimensioned (ND,NTRA).
448
449	! precip: Scalar convective precipitation rate (mm/day).
450
451	! wd: A convective downdraft velocity scale. For use in surface
452	! flux parameterizations. See convect.ps file for details.
453
454	! tprime: A convective downdraft temperature perturbation scale (K).
455	! For use in surface flux parameterizations. See convect.ps
456	! file for details.
457
458	! qprime: A convective downdraft specific humidity
459	! perturbation scale (gm/gm).
460	! For use in surface flux parameterizations. See convect.ps
461	! file for details.
462
463	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
464	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
465	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
466	! by the calling program between calls to CONVECT.
467
468	! det: Array of detrainment mass flux of dimension ND.
469	! -------------------------------------------------------------------
470
471	! Local (non compressed) arrays
472
473
474	INTEGER i, k, il
475	INTEGER nword1, nword2, nword3, nword4
476	INTEGER icbmax
477	INTEGER nk1(len)
478	INTEGER icb1(len)
479	INTEGER icbs1(len)
480
481	LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
482	LOGICAL, SAVE :: debut = .TRUE.
483	!$OMP THREADPRIVATE(debut)
484
485	REAL coef_convective(len) ! = 1 for convective points, = 0 otherwise
486	REAL tnk1(len)
487	REAL thnk1(len)
488	REAL qnk1(len)
489	REAL gznk1(len)
490	REAL qsnk1(len)
491	REAL unk1(len)
492	REAL vnk1(len)
493	REAL cpnk1(len)
494	REAL hnk1(len)
495	REAL pbase1(len)
496	REAL buoybase1(len)
497
498	REAL lf1(len, nd), lf1_wake(len, nd)
499	REAL lv1(len, nd), lv1_wake(len, nd)
500	REAL cpn1(len, nd), cpn1_wake(len, nd)
501	REAL tv1(len, nd), tv1_wake(len, nd)
502	REAL gz1(len, nd), gz1_wake(len, nd)
503	REAL hm1(len, nd)
504	REAL h1(len, nd), h1_wake(len, nd)
505	REAL tp1(len, nd)
506	REAL th1(len, nd), th1_wake(len, nd)
507
508	REAL bid(len, nd) ! dummy array
509
510	#ifdef ISO
511	INTEGER ixt
512	REAL xtnk1(ntraciso,len)
513	#endif
514
515
516	INTEGER ncum
517
518	REAL p1feed1(len) ! pressure at lower bound of feeding layer
519	REAL p2feed1(len) ! pressure at upper bound of feeding layer
520	!JYG,RL
521	!! real wghti1(len,nd) ! weights of the feeding layers
522	!JYG,RL
523
524	! (local) compressed fields:
525
526
527	INTEGER idcum(nloc)
528	!jyg<
529	LOGICAL compress ! True if compression occurs
530	!>jyg
531	INTEGER iflag(nloc), nk(nloc), icb(nloc)
532	INTEGER nent(nloc, nd)
533	INTEGER icbs(nloc)
534	INTEGER inb(nloc), inbis(nloc)
535
536	REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
537	REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
538	REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
539	REAL s_wake(nloc)
540	REAL u(nloc, nd), v(nloc, nd)
541	REAL gz(nloc, nd), h(nloc, nd)
542	REAL h_wake(nloc, nd)
543	REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
544	REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
545	REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
546	REAL tv_wake(nloc, nd)
547	REAL clw(nloc, nd)
548	REAL, DIMENSION(nloc, nd) :: qta, qpreca !!jygprl
549	REAL dph(nloc, nd)
550	REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
551	REAL th_wake(nloc, nd)
552	REAL tvp(nloc, nd)
553	REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
554	REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
555	REAL buoy(nloc, nd)
556	REAL cape(nloc)
557	REAL cin(nloc)
558	REAL m(nloc, nd)
559	REAL mm(nloc, nd)
560	REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
561	REAL qent(nloc, nd, nd)
562	REAL hent(nloc, nd, nd)
563	REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
564	REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
565	REAL elij(nloc, nd, nd)
566	REAL supmax(nloc, nd)
567	REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
568	REAL omega(nloc,nd)
569	REAL sigd(nloc)
570	! real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
571	! real wt(nloc,nd), water(nloc,nd), evap(nloc,nd), ice(nloc,nd)
572	! real b(nloc,nd), sigd(nloc)
573	! save mp,qp,up,vp,wt,water,evap,b
574	REAL, DIMENSION(len,nd) :: mp, qp, up, vp
575	REAL, DIMENSION(len,nd) :: wt, water, evap
576	REAL, DIMENSION(len,nd) :: ice, fondue, b
577	REAL, DIMENSION(len,nd) :: frac_a, frac_s, faci !!jygprl
578	REAL ft(nloc, nd), fq(nloc, nd), fqcomp(nloc, nd)
579	REAL ftd(nloc, nd), fqd(nloc, nd)
580	REAL fu(nloc, nd), fv(nloc, nd)
581	REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
582	REAL ma(nloc, nd), mip(nloc, nd)
583	!! REAL tls(nloc, nd), tps(nloc, nd) ! unused . jyg
584	REAL qprime(nloc), tprime(nloc)
585	REAL precip(nloc)
586	! real Vprecip(nloc,nd)
587	REAL vprecip(nloc, nd+1)
588	REAL vprecipi(nloc, nd+1)
589	REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
590	REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
591	REAL qcondc(nloc, nd) ! cld
592	REAL wd(nloc) ! gust
593	REAL Plim1(nloc), plim2(nloc)
594	REAL asupmax(nloc, nd)
595	REAL supmax0(nloc)
596	REAL asupmaxmin(nloc)
597
598	REAL tnk(nloc), qnk(nloc), gznk(nloc)
599	REAL wghti(nloc, nd)
600	REAL hnk(nloc), unk(nloc), vnk(nloc)
601
602	REAL qtc(nloc, nd) ! cld
603	REAL sigt(nloc, nd) ! cld
604	REAL detrain(nloc, nd) ! cld
605
606	! RomP >>>
607	REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd) !!jygprl
608	REAL da(len, nd), phi(len, nd, nd)
609	REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
610	REAL phi2(len, nd, nd)
611	REAL d1a(len, nd), dam(len, nd)
612	! RomP <<<
613	REAL epmax_diag(nloc) ! epmax_cape
614
615	CHARACTER (LEN=20) :: modname = 'cva_driver'
616	CHARACTER (LEN=80) :: abort_message
617
618	REAL, PARAMETER :: Cin_noconv = -100000.
619	REAL, PARAMETER :: Cape_noconv = -1.
620
621	INTEGER,SAVE :: igout=1
622	!$OMP THREADPRIVATE(igout)
623
624	#ifdef ISO
625	REAL xt(ntraciso,nloc,nd)
626	REAL, DIMENSION(ntraciso,nloc, nd) :: xtta
627	REAL xt_wake(ntraciso,nloc,nd)
628	REAL xtclw(ntraciso,nloc,nd)
629	REAL xtp(ntraciso,nloc,nd)
630	REAL xtent(ntraciso,nloc,nd,nd)
631	REAL xtelij(ntraciso,nloc,nd,nd)
632	REAL xtwater(ntraciso,nloc,nd)
633	REAL xtice(ntraciso,nloc,nd)
634	REAL xtevap(ntraciso,nloc,nd)
635	REAL fxt(ntraciso,nloc,nd)
636	REAL fxtd(ntraciso,nloc,nd)
637	REAL xtprecip(ntraciso,nloc)
638	REAL xtnk(ntraciso,nloc)
639	REAL xtVprecip(ntraciso,nloc,nd+1)
640	REAL xtVprecipi(ntraciso,nloc,nd+1)
641	REAL xtwdtrainA(niso,nloc,nd)
642	#ifdef DIAGISO
643	REAL fxt_detrainement(niso,nloc,nd)
644	REAL fxt_fluxmasse(niso,nloc,nd)
645	REAL fxt_evapprecip(niso,nloc,nd)
646	REAL fxt_ddft(niso,nloc,nd)
647	REAL fq_detrainement(nloc,nd)
648	REAL fq_fluxmasse(nloc,nd)
649	REAL fq_evapprecip(nloc,nd)
650	REAL fq_ddft(nloc,nd)
651	REAL f_detrainement(nloc,nd)
652	REAL q_detrainement(nloc,nd)
653	REAL xt_detrainement(niso,nloc,nd)
654	#endif
655	#ifdef ISOTRAC
656	INTEGER iiso,ixt_ddft,ixt_poubelle,ixt_revap
657	INTEGER izone
658	#endif
659	#ifdef ISOVERIF
660	INTEGER j
661	#endif
662	#endif
663
664
665	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd)
666	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
667
668	! -------------------------------------------------------------------
669	! --- SET CONSTANTS AND PARAMETERS
670	! -------------------------------------------------------------------
671
672	! -- set simulation flags:
673	! (common cvflag)
674
675	CALL cv_flag(iflag_ice_thermo)
676
677	! -- set thermodynamical constants:
678	! (common cvthermo)
679
680	CALL cv_thermo(iflag_con)
681
682	! -- set convect parameters
683
684	! includes microphysical parameters and parameters that
685	! control the rate of approach to quasi-equilibrium)
686	! (common cvparam)
687
688	IF (iflag_con==3) THEN
689	CALL cv3_param(nd, k_upper, delt)
690
691	END IF
692
693	IF (iflag_con==4) THEN
694	CALL cv_param(nd)
695	#ifdef ISO
696	CALL abort_physic('cva_driver 555', 'isos pas prevus ici', 1)
697	#endif
698	END IF
699
700	! ---------------------------------------------------------------------
701	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
702	! ---------------------------------------------------------------------
703	nword1 = len
704	nword2 = len*nd
705	nword3 = lenndntra
706	nword4 = lenndnd
707
708	iflag1(:) = 0
709	ktop1(:) = 0
710	kbas1(:) = 0
711	ft1(:, :) = 0.0
712	fq1(:, :) = 0.0
713	fqcomp1(:, :) = 0.0
714	fu1(:, :) = 0.0
715	fv1(:, :) = 0.0
716	ftra1(:, :, :) = 0.
717	precip1(:) = 0.
718	cbmf1(:) = 0.
719	plcl1(:) = 0.
720	plfc1(:) = 0.
721	wbeff1(:) = 0.
722	ptop21(:) = 0.
723	sigd1(:) = 0.
724	ma1(:, :) = 0.
725	mip1(:, :) = 0.
726	vprecip1(:, :) = 0.
727	vprecipi1(:, :) = 0.
728	upwd1(:, :) = 0.
729	dnwd1(:, :) = 0.
730	dnwd01(:, :) = 0.
731	qcondc1(:, :) = 0.
732	wd1(:) = 0.
733	cape1(:) = 0.
734	cin1(:) = 0.
735	tvp1(:, :) = 0.
736	ftd1(:, :) = 0.
737	fqd1(:, :) = 0.
738	Plim11(:) = 0.
739	Plim21(:) = 0.
740	asupmax1(:, :) = 0.
741	supmax01(:) = 0.
742	asupmaxmin1(:) = 0.
743	#ifdef ISO
744	xtprecip1(:, :) = 0.
745	fxt1(:,:, :) = 0.0
746	xtvprecip1(:,:, :) = 0.
747	xtvprecipi1(:,:, :) = 0.
748	fxtd1(:,:, :) = 0.
749	#endif
750
751	tvp(:, :) = 0. !ym missing init, need to have a look by developpers
752	tv(:, :) = 0. !ym missing init, need to have a look by developpers
753
754	DO il = 1, len
755	!! cin1(il) = -100000.
756	!! cape1(il) = -1.
757	cin1(il) = Cin_noconv
758	cape1(il) = Cape_noconv
759	END DO
760
761	!! IF (iflag_con==3) THEN
762	!! DO il = 1, len
763	!! sig1(il, nd) = sig1(il, nd) + 1.
764	!! sig1(il, nd) = amin1(sig1(il,nd), 12.1)
765	!! END DO
766	!! END IF
767
768	IF (iflag_con==3) THEN
769	CALL cv3_incrcount(len,nd,delt,sig1)
770	END IF ! (iflag_con==3)
771
772	! RomP >>>
773	sigt1(:, :) = 0.
774	detrain1(:, :) = 0.
775	qtc1(:, :) = 0.
776	wdtrainA1(:, :) = 0.
777	wdtrainS1(:, :) = 0.
778	wdtrainM1(:, :) = 0.
779	da1(:, :) = 0.
780	phi1(:, :, :) = 0.
781	epmlmMm1(:, :, :) = 0.
782	eplaMm1(:, :) = 0.
783	mp1(:, :) = 0.
784	evap1(:, :) = 0.
785	ep1(:, :) = 0.
786	sigij1(:, :, :) = 0.
787	elij1(:, :, :) = 0.
788	qta1(:,:) = 0.
789	clw1(:,:) = 0.
790	wghti1(:,:) = 0.
791	phi21(:, :, :) = 0.
792	d1a1(:, :) = 0.
793	dam1(:, :) = 0.
794	m(:,:)=0. ! C Risi
795	#ifdef ISO
796	xtwdtrainA1(:,:, :) = 0.
797	xtevap1(:,:, :) = 0.
798	xtelij1(:,:, :, :) = 0.
799	xtclw1(:,:,:) = 0.
800	q(:,:)=0.0 ! securite pour check plus bas
801	xt(:,:,:)=0.0 ! securite pour check plus bas
802	q_wake(:,:)=0.0 ! securite pour check plus bas
803	xt_wake(:,:,:)=0.0 ! securite pour check plus bas
804	clw(:,:)=0.0 ! securite pour check plus bas
805	xtclw(:,:,:)=0.0 ! securite pour check plus bas
806	#endif
807	! RomP <<<
808	! ---------------------------------------------------------------------
809	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
810	! ---------------------------------------------------------------------
811
812	DO il = 1, nloc
813	coef_clos(il) = 1.
814	END DO
815
816	! --------------------------------------------------------------------
817	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
818	! --------------------------------------------------------------------
819
820	IF (iflag_con==3) THEN
821
822	IF (debut) THEN
823	PRINT *, 'Emanuel version 3 nouvelle'
824	END IF
825	! PRINT*,'t1, q1 ',t1,q1
826	IF (prt_level >= 9) &
827	PRINT *, 'cva_driver -> cv3_prelim'
828	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
829	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
830
831
832	IF (prt_level >= 9) &
833	PRINT *, 'cva_driver -> cv3_prelim'
834	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
835	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
836	h1_wake, bid, th1_wake)
837
838	END IF
839
840	IF (iflag_con==4) THEN
841	PRINT *, 'Emanuel version 4 '
842	IF (prt_level >= 9) &
843	PRINT *, 'cva_driver -> cv_prelim'
844	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
845	lv1, cpn1, tv1, gz1, h1, hm1)
846	END IF
847
848	! --------------------------------------------------------------------
849	! --- CONVECTIVE FEED
850	! --------------------------------------------------------------------
851
852	! compute feeding layer potential temperature and mixing ratio :
853
854	! get bounds of feeding layer
855
856	! test niveaux couche alimentation KE
857	IF (sig1feed1==sig2feed1) THEN
858	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
859	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
860	abort_message = ''
861	CALL abort_physic(modname, abort_message, 1)
862	END IF
863
864	DO i = 1, len
865	p1feed1(i) = sig1feed1*ph1(i, 1)
866	p2feed1(i) = sig2feed1*ph1(i, 1)
867	!test maf
868	! p1feed1(i)=ph1(i,1)
869	! p2feed1(i)=ph1(i,2)
870	! p2feed1(i)=ph1(i,3)
871	!testCR: on prend la couche alim des thermiques
872	! p2feed1(i)=ph1(i,lalim_conv1(i)+1)
873	! PRINT*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
874	END DO
875
876	IF (iflag_con==3) THEN
877	END IF
878	DO i = 1, len
879	! PRINT*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
880	END DO
881	IF (iflag_con==3) THEN
882
883	! PRINT*, 'IFLAG1 avant cv3_feed'
884	! PRINT*,'len,nd',len,nd
885	! WRITE(*,'(64i1)') iflag1(2:len-1)
886
887	IF (prt_level >= 9) &
888	PRINT *, 'cva_driver -> cv3_feed'
889	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
890	t1, q1, u1, v1, p1, ph1, h1, gz1, &
891	p1feed1, p2feed1, wght1, &
892	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
893	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1 &
894	#ifdef ISO
895	,xt1,xtnk1 &
896	#endif
897	)
898	END IF
899
900	! PRINT*, 'IFLAG1 apres cv3_feed'
901	! PRINT*,'len,nd',len,nd
902	! WRITE(*,'(64i1)') iflag1(2:len-1)
903
904	IF (iflag_con==4) THEN
905	IF (prt_level >= 9) &
906	PRINT *, 'cva_driver -> cv_feed'
907	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
908	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
909	END IF
910
911	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
912
913	! --------------------------------------------------------------------
914	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
915	! (up through ICB for convect4, up through ICB+1 for convect3)
916	! Calculates the lifted parcel virtual temperature at nk, the
917	! actual temperature, and the adiabatic liquid water content.
918	! --------------------------------------------------------------------
919
920	IF (iflag_con==3) THEN
921
922	IF (prt_level >= 9) &
923	PRINT *, 'cva_driver -> cv3_undilute1'
924
925	#ifdef ISO
926	#ifdef ISOVERIF
927	WRITE(,) 'cva_driver 593: avant cv3_undilute1'
928	IF (iso_HDO.gt.0) THEN
929	do k=1,nd
930	do i=1,len
931	IF (q1(i,k).gt.ridicule) THEN
932	CALL iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
933	'cva_driver 502')
934	endif ! if (q1(i,k).gt.ridicule) THEN
935	enddo !do i=1,len
936	enddo !do k=1,nd
937	endif !if (iso_HDO.gt.0) THEN
938	IF (iso_eau.gt.0) THEN
939	do i=1,len
940	do k=1,nd
941	CALL iso_verif_egalite(xt1(iso_eau,i,k),q1(i,k), &
942	'cva_driver 764')
943	CALL iso_verif_egalite(xt1_wake(iso_eau,i,k),q1_wake(i,k), &
944	'cva_driver 766')
945	enddo !do k=1,nd
946	CALL iso_verif_egalite(xtnk1(iso_eau,i),qnk1(i), &
947	'cva_driver 777')
948	do ixt=1,ntraciso
949	CALL iso_verif_noNaN(xtnk1(ixt,i),'cva_driver 784')
950	enddo ! do ixt=1,ntraciso
951	enddo !do i=1,len
952	endif !if (iso_eau.gt.0) THEN
953	#ifdef ISOTRAC
954	do k=1,nd
955	do i=1,len
956	CALL iso_verif_traceur(xt1(1,i,k),'cva_driver 601')
957	enddo !do i=1,len
958	enddo !do k=1,nd
959	#endif
960	#endif
961	#endif
962
963	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
964	gznk1, tp1, tvp1, clw1, icbs1 &
965	#ifdef ISO
966	,xtnk1,xtclw1 &
967	#endif
968	)
969
970	#ifdef ISO
971	#ifdef ISOVERIF
972	WRITE(,) 'cva_driver 621: apres cv3_undilute1'
973	do k=1,nd
974	do i = 1, len
975	IF (iso_eau.gt.0) THEN
976	CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
977	'cva_driver 798',errmax,errmaxrel)
978	CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
979	'cva_driver 800',errmax,errmaxrel)
980	endif !if (iso_eau.gt.0) THEN
981	do ixt=1,ntraciso
982	CALL iso_verif_noNaN(xt1(ixt,i,k),'cva_driver 815')
983	enddo ! do ixt=1,ntraciso
984	#ifdef ISOTRAC
985	CALL iso_verif_traceur(xt1(1,i,k),'cva_driver 623')
986	#endif
987	enddo !do i = 1, len
988	enddo !do k=1,nd
989	do i = 1, len
990	do ixt=1,ntraciso
991	CALL iso_verif_noNaN(xtnk1(ixt,i),'cva_driver 824')
992	enddo ! do ixt=1,ntraciso
993	enddo !do i = 1, len
994	#endif
995	!WRITE(,) 'SORTIE DE CV3_UNDILUTE1'
996	#endif
997
998	END IF
999
1000
1001	IF (iflag_con==4) THEN
1002	IF (prt_level >= 9) &
1003	PRINT *, 'cva_driver -> cv_undilute1'
1004	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
1005	tp1, tvp1, clw1)
1006	END IF
1007
1008	! -------------------------------------------------------------------
1009	! --- TRIGGERING
1010	! -------------------------------------------------------------------
1011
1012	! print *,' avant triggering, iflag_con ',iflag_con
1013
1014	IF (iflag_con==3) THEN
1015
1016	IF (prt_level >= 9) &
1017	PRINT *, 'cva_driver -> cv3_trigger'
1018	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
1019	pbase1, buoybase1, iflag1, sig1, w01)
1020
1021
1022	! PRINT*, 'IFLAG1 apres cv3_triger'
1023	! PRINT*,'len,nd',len,nd
1024	! WRITE(*,'(64i1)') iflag1(2:len-1)
1025
1026	! CALL dump2d(iim,jjm-1,sig1(2)
1027	END IF
1028
1029	IF (iflag_con==4) THEN
1030	IF (prt_level >= 9) &
1031	PRINT *, 'cva_driver -> cv_trigger'
1032	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
1033	END IF
1034
1035
1036	! =====================================================================
1037	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
1038	! =====================================================================
1039
1040	! Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
1041	! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
1042	! elsewhere).
1043	ncum = 0
1044	coef_convective(:) = 0.
1045	DO i = 1, len
1046	IF (iflag1(i)==0) THEN
1047	coef_convective(i) = 1.
1048	ncum = ncum + 1
1049	idcum(ncum) = i
1050	END IF
1051	END DO
1052
1053	! PRINT*,'len, ncum = ',len,ncum
1054
1055	IF (ncum>0) THEN
1056
1057	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1058	! --- COMPRESS THE FIELDS
1059	! (-> vectorization over convective gridpoints)
1060	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1061
1062	IF (iflag_con==3) THEN
1063	! PRINT*,'ncum tv1 ',ncum,tv1
1064	! PRINT*,'tvp1 ',tvp1
1065	!jyg<
1066	! If the fraction of convective points is larger than comp_threshold, then compression
1067	! is assumed useless.
1068
1069	compress = ncum < len*comp_threshold
1070
1071	IF (.NOT. compress) THEN
1072	DO i = 1,len
1073	idcum(i) = i
1074	ENDDO
1075	ENDIF
1076
1077	#ifdef ISO
1078	#ifdef ISOVERIF
1079	do k=1,nd
1080	do i = 1, nloc
1081	IF (iso_eau.gt.0) THEN
1082	CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
1083	'cva_driver 541a',errmax,errmaxrel)
1084	CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
1085	'cva_driver 541b',errmax,errmaxrel)
1086	endif ! if (iso_eau.gt.0) THEN
1087	#ifdef ISOTRAC
1088	CALL iso_verif_traceur(xt1(1,i,k),'cva_driver 689')
1089	#endif
1090	enddo
1091	enddo
1092	#endif
1093	#endif
1094
1095	!>jyg
1096	IF (prt_level >= 9) &
1097	PRINT *, 'cva_driver -> cv3a_compress'
1098	CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
1099	iflag1, nk1, icb1, icbs1, &
1100	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
1101	wghti1, pbase1, buoybase1, &
1102	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
1103	u1, v1, gz1, th1, th1_wake, &
1104	tra1, &
1105	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
1106	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
1107	sig1, w01, ptop21, &
1108	Ale1, Alp1, omega1, &
1109	iflag, nk, icb, icbs, &
1110	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
1111	wghti, pbase, buoybase, &
1112	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
1113	u, v, gz, th, th_wake, &
1114	tra, &
1115	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
1116	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
1117	sig, w0, ptop2, &
1118	Ale, Alp, omega &
1119	#ifdef ISO
1120	,xtnk1,xt1,xt1_wake,xtclw1 &
1121	,xtnk,xt,xt_wake,xtclw &
1122	#endif
1123	)
1124
1125	! PRINT*,'tv ',tv
1126	! PRINT*,'tvp ',tvp
1127
1128	#ifdef ISO
1129	#ifdef ISOVERIF
1130	WRITE(,) 'cva_driver 720: apres cv3_compress'
1131	! WRITE(,) 'len, nloc, ncum,nd=',len, nloc, ncum,nd
1132	do k=1,nd
1133	do i = 1, ncum
1134	IF (iso_eau.gt.0) THEN
1135	CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
1136	'cva_driver 598',errmax,errmaxrel)
1137	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1138	'cva_driver 600',errmax,errmaxrel)
1139	CALL iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
1140	'cva_driver 602',errmax,errmaxrel)
1141	endif ! if (iso_eau.gt.0) THEN
1142	IF (iso_HDO.gt.0) THEN
1143	CALL iso_verif_aberrant_choix( &
1144	xt(iso_HDO,i,k),q(i,k), &
1145	ridicule,deltalim,'cva_driver 735, apres compress')
1146	endif !if (iso_HDO.gt.0) THEN
1147	#ifdef ISOTRAC
1148	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 726')
1149	#endif
1150	enddo
1151	enddo
1152	do i = 1, ncum
1153	do k=1,nd
1154	CALL iso_verif_positif(q(i,k),'cva_driver 966a')
1155	enddo !do k=1,nd
1156	CALL iso_verif_positif(qnk(i),'cva_driver 966b')
1157	enddo !do i = 1, ncum
1158	! WRITE(,) 'cva_driver 1142: apres cv3_compress OK'
1159	#endif
1160	#endif
1161
1162	END IF
1163
1164	IF (iflag_con==4) THEN
1165	IF (prt_level >= 9) &
1166	PRINT *, 'cva_driver -> cv_compress'
1167	CALL cv_compress(len, nloc, ncum, nd, &
1168	iflag1, nk1, icb1, &
1169	cbmf1, plcl1, tnk1, qnk1, gznk1, &
1170	t1, q1, qs1, u1, v1, gz1, &
1171	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
1172	iflag, nk, icb, &
1173	cbmf, plcl, tnk, qnk, gznk, &
1174	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
1175	dph)
1176	END IF
1177
1178	! -------------------------------------------------------------------
1179	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
1180	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
1181	! --- &
1182	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
1183	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
1184	! --- &
1185	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
1186	! -------------------------------------------------------------------
1187
1188	IF (iflag_con==3) THEN
1189	IF (prt_level >= 9) &
1190	PRINT *, 'cva_driver -> cv3_undilute2'
1191	CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, & !na->nd
1192	tnk, qnk, gznk, hnk, t, q, qs, gz, &
1193	p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
1194	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
1195	frac_a, frac_s, qpreca, qta & !!jygprl
1196	#ifdef ISO
1197	,xtnk,xt,xtclw,xtta &
1198	#endif
1199	)
1200	#ifdef ISO
1201	#ifdef ISOVERIF
1202	do k=1,nd
1203	do i = 1, ncum
1204	IF (iso_eau.gt.0) THEN
1205	CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
1206	'cva_driver 650',errmax,errmaxrel)
1207	CALL iso_verif_egalite_choix(xtta(iso_eau,i,k),qta(i,k), &
1208	'cva_driver 651',errmax,errmaxrel)
1209	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1210	'cva_driver 652',errmax,errmaxrel)
1211	endif ! if (iso_eau.gt.0) THEN
1212	IF (iso_HDO.gt.0) THEN
1213	CALL iso_verif_aberrant_choix( &
1214	xt(iso_HDO,i,k),q(i,k), &
1215	ridicule,deltalim,'cva_driver 794, apres undilute2')
1216	endif !if (iso_HDO.gt.0) THEN
1217	#ifdef ISOTRAC
1218	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 780')
1219	CALL iso_verif_traceur(xtclw(1,i,k),'cva_driver 781')
1220	#endif
1221	enddo
1222	enddo !do k=1,nd
1223	#ifdef VERIFNEGATIF
1224	do i = 1, ncum
1225	do k=1,nd
1226	CALL iso_verif_positif(q(i,k),'cva_driver 1052')
1227	enddo !do k=1,nd
1228	CALL iso_verif_positif(qnk(i),'cva_driver 1054')
1229	enddo !do i = 1, ncum
1230	#endif
1231	#endif
1232	!WRITE(,) 'SORTIE CV3_UNDILUTE2'
1233	#endif
1234
1235	END IF
1236
1237	IF (iflag_con==4) THEN
1238	IF (prt_level >= 9) &
1239	PRINT *, 'cva_driver -> cv_undilute2'
1240	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
1241	tnk, qnk, gznk, t, q, qs, gz, &
1242	p, dph, h, tv, lv, &
1243	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac_s)
1244	END IF
1245
1246	! epmax_cape
1247	! on recalcule ep et hp
1248	IF (prt_level >= 9) &
1249	PRINT *, 'cva_driver -> cv3_epmax_cape'
1250	CALL cv3_epmax_fn_cape(nloc,ncum,nd &
1251	, ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac_s &
1252	, pbase, p, ph, tv, buoy, sig, w0,iflag &
1253	, epmax_diag)
1254
1255	! -------------------------------------------------------------------
1256	! --- MIXING(1) (if iflag_mix .ge. 1)
1257	! -------------------------------------------------------------------
1258	IF (iflag_con==3) THEN
1259	! IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
1260	! WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
1261	! '. Might as well stop here.'
1262	! STOP
1263	! END IF
1264	IF (iflag_mix>=1) THEN
1265	CALL zilch(supmax, nloc*nd)
1266	IF (prt_level >= 9) &
1267	PRINT *, 'cva_driver -> cv3p_mixing'
1268	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
1269	!! ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
1270	ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, & !!jygprl
1271	unk, vnk, hp, tv, tvp, ep, clw, sig, &
1272	ment, qent, hent, uent, vent, nent, &
1273	sigij, elij, supmax, ments, qents, traent &
1274	#ifdef ISO
1275	,xt,xtta,xtclw,xtent,xtelij &
1276	#endif
1277	)
1278	! PRINT*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
1279
1280	ELSE
1281	CALL zilch(supmax, nloc*nd)
1282	END IF
1283	END IF
1284	! -------------------------------------------------------------------
1285	! --- CLOSURE
1286	! -------------------------------------------------------------------
1287
1288
1289	IF (iflag_con==3) THEN
1290	IF (iflag_clos==0) THEN
1291	IF (prt_level >= 9) &
1292	PRINT *, 'cva_driver -> cv3_closure'
1293	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
1294	pbase, p, ph, tv, buoy, &
1295	sig, w0, cape, m, iflag)
1296	END IF ! iflag_clos==0
1297
1298	ok_inhib = iflag_mix == 2
1299
1300	IF (iflag_clos==1) THEN
1301	PRINT *, ' pas d appel cv3p_closure'
1302	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
1303	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
1304	! c : ,supmax
1305	! c o ,sig,w0,ptop2,cape,cin,m)
1306	END IF ! iflag_clos==1
1307
1308	IF (iflag_clos==2) THEN
1309	IF (prt_level >= 9) &
1310	PRINT *, 'cva_driver -> cv3p1_closure'
1311	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
1312	pbase, plcl, p, ph, tv, tvp, buoy, &
1313	supmax, ok_inhib, Ale, Alp, omega, &
1314	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1315	Plim1, plim2, asupmax, supmax0, &
1316	asupmaxmin, cbmf, plfc, wbeff)
1317	IF (prt_level >= 10) &
1318	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1319	END IF ! iflag_clos==2
1320
1321	IF (iflag_clos==3) THEN
1322	IF (prt_level >= 9) &
1323	PRINT *, 'cva_driver -> cv3p2_closure'
1324	CALL cv3p2_closure(nloc, ncum, nd, icb, inb, & ! na->nd
1325	pbase, plcl, p, ph, tv, tvp, buoy, &
1326	supmax, ok_inhib, Ale, Alp, omega, &
1327	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1328	Plim1, plim2, asupmax, supmax0, &
1329	asupmaxmin, cbmf, plfc, wbeff)
1330	IF (prt_level >= 10) &
1331	PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1332	END IF ! iflag_clos==3
1333	END IF ! iflag_con==3
1334
1335	IF (iflag_con==4) THEN
1336	IF (prt_level >= 9) &
1337	PRINT *, 'cva_driver -> cv_closure'
1338	CALL cv_closure(nloc, ncum, nd, nk, icb, &
1339	tv, tvp, p, ph, dph, plcl, cpn, &
1340	iflag, cbmf)
1341	END IF
1342
1343	! print *,'cv_closure-> cape ',cape(1)
1344
1345	! -------------------------------------------------------------------
1346	! --- MIXING(2)
1347	! -------------------------------------------------------------------
1348
1349	IF (iflag_con==3) THEN
1350	IF (iflag_mix==0) THEN
1351	IF (prt_level >= 9) &
1352	PRINT *, 'cva_driver -> cv3_mixing'
1353	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
1354	ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, &
1355	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
1356	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent &
1357	#ifdef ISO
1358	,xt,xtnk,xtclw &
1359	,xtent,xtelij &
1360	#endif
1361	)
1362	CALL zilch(hent, nlocndnd)
1363
1364	#ifdef ISO
1365	#ifdef ISOVERIF
1366	WRITE(,) 'cva_driver 837: apres cv3_mixing'
1367	! WRITE(,) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
1368	do k=1,nd
1369	do j = 1, nd
1370	do i = 1, ncum
1371	IF (iso_eau.gt.0) THEN
1372	CALL iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
1373	elij(i,j,k),'cva_driver 881',errmax,errmaxrel)
1374	CALL iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
1375	qent(i,j,k),'cva_driver 882',errmax,errmaxrel)
1376	endif ! if (iso_eau.gt.0) THEN
1377	#ifdef ISOTRAC
1378	CALL iso_verif_traceur_justmass(xtent(1,i,j,k), &
1379	'cva_driver 846')
1380	CALL iso_verif_traceur_justmass(xtelij(1,i,j,k), &
1381	'cva_driver 847')
1382	! on ne vérfier pas le deltaD ici car peut dépasser le seuil
1383	! raisonable pour températures très froides.
1384	#endif
1385	enddo !do i = 1, ncum
1386	enddo !do j = 1, nd
1387	enddo !do k=1,nd
1388	do k=1,nd
1389	do i = 1, ncum
1390	IF (iso_eau.gt.0) THEN
1391	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1392	'cva_driver 709',errmax,errmaxrel)
1393	endif ! if (iso_eau.gt.0) THEN
1394	#ifdef ISOTRAC
1395	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 856')
1396	IF (option_tmin.EQ.1) THEN
1397	IF (iso_verif_positif_nostop(xtclw(itZonIso( &
1398	izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
1399	,'cva_driver 909').EQ.1) THEN
1400	WRITE(,) 'i,k=',i,k
1401	WRITE(,) 'xtclw=',xtclw(:,i,k)
1402	stop
1403	endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
1404	endif !if ((option_traceurs.EQ.17).OR.
1405	#endif
1406	enddo
1407	enddo !do k=1,nd
1408	#endif
1409	#endif
1410
1411	ELSE
1412	!!jyg: Essais absurde pour voir
1413	!! mm(:,1) = 0.
1414	!! DO i = 2,nd
1415	!! mm(:,i) = m(:,i)*(1.-qta(:,i-1))
1416	!! ENDDO
1417	mm(:,:) = m(:,:)
1418	CALL cv3_mixscale(nloc, ncum, nd, ment, mm)
1419	IF (debut) THEN
1420	PRINT *, ' cv3_mixscale-> '
1421	END IF !(debut) THEN
1422	END IF
1423	END IF
1424
1425	IF (iflag_con==4) THEN
1426	IF (prt_level >= 9) &
1427	PRINT *, 'cva_driver -> cv_mixing'
1428	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
1429	ph, t, q, qs, u, v, h, lv, qnk, &
1430	hp, tv, tvp, ep, clw, cbmf, &
1431	m, ment, qent, uent, vent, nent, sigij, elij)
1432	END IF
1433
1434	IF (debut) THEN
1435	PRINT *, ' cv_mixing ->'
1436	END IF !(debut) THEN
1437	! do i = 1,nd
1438	! PRINT*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
1439	! enddo
1440
1441	! -------------------------------------------------------------------
1442	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1443	! -------------------------------------------------------------------
1444	IF (iflag_con==3) THEN
1445	IF (debut) THEN
1446	PRINT *, ' cva_driver -> cv3_unsat '
1447	END IF !(debut) THEN
1448	#ifdef ISO
1449	#ifdef ISOVERIF
1450	do k=1,nd
1451	do i = 1, ncum
1452	IF (iso_eau.gt.0) THEN
1453	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1454	'cva_driver 753a',errmax,errmaxrel)
1455	CALL iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
1456	'cva_driver 753b',errmax,errmaxrel)
1457	endif ! if (iso_eau.gt.0) THEN
1458	#ifdef ISOTRAC
1459	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 885')
1460	#endif
1461	enddo
1462	enddo !do k=1,nd
1463	#endif
1464	#endif
1465
1466	IF (prt_level >= 9) &
1467	PRINT *, 'cva_driver -> cv3_unsat'
1468	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
1469	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
1470	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
1471	ep, sigp, clw, frac_s, qpreca, frac_a, qta, & !!jygprl
1472	m, ment, elij, delt, plcl, coef_clos, &
1473	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
1474	faci, b, sigd, &
1475	!! wdtrainA, wdtrainM) ! RomP
1476	wdtrainA, wdtrainS, wdtrainM & !!jygprl
1477	#ifdef ISO
1478	,xt_wake,xtclw,xtelij &
1479	,xtp,xtwater,xtevap,xtice,xtwdtrainA &
1480	#endif
1481	)
1482
1483	IF (prt_level >= 10) THEN
1484	Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
1485	DO k = 1,nd
1486	write (6, '(i4,5(1x,e13.6))'), &
1487	k, mp(igout,k), water(igout,k), ice(igout,k), &
1488	evap(igout,k), fondue(igout,k)
1489	ENDDO
1490	Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM ' !!jygprl
1491	DO k = 1,nd
1492	write (6, '(i4,3(1x,e13.6))'), &
1493	k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k) !!jygprl
1494	ENDDO
1495	ENDIF
1496
1497	END IF !(iflag_con==3)
1498
1499	IF (iflag_con==4) THEN
1500	IF (prt_level >= 9) &
1501	PRINT *, 'cva_driver -> cv_unsat'
1502	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1503	h, lv, ep, sigp, clw, m, ment, elij, &
1504	iflag, mp, qp, up, vp, wt, water, evap)
1505	END IF
1506
1507	IF (debut) THEN
1508	PRINT *, 'cv_unsat-> '
1509	END IF !(debut) THEN
1510
1511	#ifdef ISO
1512	#ifdef ISOTRAC
1513	IF (option_traceurs.EQ.6) THEN
1514	! on colorie les ddfts en rouge, le reste est en blanc.
1515	do k=1,nd
1516	do i = 1, ncum
1517	do iiso=1,niso
1518	ixt_ddft=itZonIso(izone_ddft,iiso)
1519	ixt_poubelle=itZonIso(izone_poubelle,iiso)
1520	xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
1521	+xtp(ixt_poubelle,i,k)
1522	xtp(ixt_poubelle,i,k)=0.0
1523	enddo !do iiso=1,niso
1524	#ifdef ISOVERIF
1525	CALL iso_verif_traceur(xtp(1,i,k),'cva_driver 990')
1526	#endif
1527	enddo !do i = 1, ncum
1528	enddo !do k=1,nd
1529	ELSE IF (option_traceurs.EQ.19) THEN
1530	! on colorie les ddfts, mais on sauve la revap
1531	do k=1,nd
1532	do i = 1, ncum
1533	do izone=1,nzone
1534	IF (izone.EQ.izone_ddft) THEN
1535	do iiso=1,niso
1536	ixt_ddft=itZonIso(izone,iiso)
1537	ixt_revap=itZonIso(izone_revap,iiso)
1538	xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
1539	enddo !do iiso=1,niso
1540	elseif (izone.EQ.izone_ddft) THEN
1541	! rien à faire
1542	else !if (izone.EQ.izone_ddft) THEN
1543	do iiso=1,niso
1544	ixt=itZonIso(izone,iiso)
1545	xtp(ixt,i,k)=0.0
1546	enddo !do iiso=1,niso
1547	endif !if (izone.EQ.izone_ddft) THEN
1548	enddo !do izone=1,nzone
1549	#ifdef ISOVERIF
1550	CALL iso_verif_traceur(xtp(1,i,k),'cva_driver 1059')
1551	#endif
1552	enddo !do i = 1, ncum
1553	enddo !do k=1,nd
1554	endif !if (option_traceurs.EQ.6) THEN
1555	#endif
1556	#endif
1557
1558	! print *,'cv_unsat-> mp ',mp
1559	! print *,'cv_unsat-> water ',water
1560	! -------------------------------------------------------------------
1561	! --- YIELD
1562	! (tendencies, precipitation, variables of interface with other
1563	! processes, etc)
1564	! -------------------------------------------------------------------
1565
1566	IF (iflag_con==3) THEN
1567
1568	IF (prt_level >= 9) &
1569	PRINT *, 'cva_driver -> cv3_yield'
1570
1571	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
1572	icb, inb, delt, &
1573	t, q, t_wake, q_wake, s_wake, u, v, tra, &
1574	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1575	ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, &
1576	wt, water, ice, evap, fondue, faci, b, sigd, &
1577	ment, qent, hent, iflag_mix, uent, vent, &
1578	nent, elij, traent, sig, &
1579	tv, tvp, wghti, &
1580	iflag, precip, Vprecip, Vprecipi, ft, fq, fqcomp, fu, fv, ftra, & ! jyg
1581	cbmf, upwd, dnwd, dnwd0, ma, mip, &
1582	!! tls, tps, & ! useless . jyg
1583	qcondc, wd, &
1584	!! ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1585	ftd, fqd, qta, qtc, sigt,detrain,tau_cld_cv, coefw_cld_cv & !!jygprl
1586	#ifdef ISO
1587	,xt,xt_wake,xtclw,xtp,xtwater,xtice,xtevap &
1588	,xtent,xtelij,xtprecip,fxt,fxtd,xtVprecip,xtVprecipi &
1589	#ifdef DIAGISO
1590	,fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
1591	,fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
1592	,f_detrainement,q_detrainement,xt_detrainement &
1593	#endif
1594	#endif
1595	)
1596
1597	! Test conseravtion de l'eau
1598
1599	#ifdef ISOVERIF
1600	DO k = 1, nd
1601	DO i = 1, ncum
1602	IF (iso_HDO.gt.0) THEN
1603	IF (q(i,k)+delt*fq(i,k).gt.ridicule) THEN
1604	CALL iso_verif_aberrant( &
1605	(xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
1606	/(q(i,k)+delt*fq(i,k)),'cva_driver 855a')
1607	IF (iso_O18.gt.0) THEN
1608	CALL iso_verif_O18_aberrant( &
1609	(xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
1610	/(q(i,k)+delt*fq(i,k)), &
1611	(xt(iso_O18,i,k)+delt*fxt(iso_O18,i,k)) &
1612	/(q(i,k)+delt*fq(i,k)),'cva_driver 855b')
1613	endif
1614	endif
1615	endif
1616	IF (iso_eau.gt.0) THEN
1617	CALL iso_verif_egalite_choix(fxt(iso_eau,i,k), &
1618	fq(i,k),'cva_driver 1305',errmax,errmaxrel)
1619	endif
1620	#ifdef ISOTRAC
1621	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 1008')
1622	#endif
1623	enddo
1624	enddo
1625	#endif
1626	IF (debut) THEN
1627	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
1628	END IF !(debut) THEN
1629
1630	IF (prt_level >= 10) THEN
1631	Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
1632	ft(igout,1), ftd(igout,1)
1633	Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
1634	fq(igout,1), fqd(igout,1)
1635	ENDIF
1636
1637	END IF
1638
1639	IF (iflag_con==4) THEN
1640	IF (prt_level >= 9) &
1641	PRINT *, 'cva_driver -> cv_yield'
1642	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1643	t, q, u, v, &
1644	gz, p, ph, h, hp, lv, cpn, &
1645	ep, clw, frac_s, m, mp, qp, up, vp, &
1646	wt, water, evap, &
1647	ment, qent, uent, vent, nent, elij, &
1648	tv, tvp, &
1649	iflag, wd, qprime, tprime, &
1650	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1651	END IF
1652
1653	!AC!
1654	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1655	!--- passive tracers
1656	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1657
1658	IF (iflag_con==3) THEN
1659	!RomP >>>
1660	IF (prt_level >= 9) &
1661	PRINT *, 'cva_driver -> cv3_tracer'
1662	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1663	ment, sigij, da, phi, phi2, d1a, dam, &
1664	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1665	icb, inb)
1666	!RomP <<<
1667	END IF
1668
1669	!AC!
1670
1671	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1672	! --- UNCOMPRESS THE FIELDS
1673	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1674
1675
1676	IF (iflag_con==3) THEN
1677	IF (prt_level >= 9) &
1678	PRINT *, 'cva_driver -> cv3a_uncompress'
1679	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1680	iflag, icb, inb, &
1681	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1682	ft, fq, fqcomp, fu, fv, ftra, &
1683	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1684	qcondc, wd, cape, cin, &
1685	tvp, &
1686	ftd, fqd, &
1687	Plim1, plim2, asupmax, supmax0, &
1688	asupmaxmin, &
1689	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
1690	qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
1691	wdtrainA, wdtrainS, wdtrainM, & ! RomP
1692	qtc, sigt, detrain, epmax_diag, & ! epmax_cape
1693	iflag1, kbas1, ktop1, &
1694	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1695	ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
1696	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1697	qcondc1, wd1, cape1, cin1, &
1698	tvp1, &
1699	ftd1, fqd1, &
1700	Plim11, plim21, asupmax1, supmax01, &
1701	asupmaxmin1, &
1702	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
1703	qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1704	wdtrainA1, wdtrainS1, wdtrainM1, & ! RomP
1705	qtc1, sigt1,detrain1,epmax_diag1 & ! epmax_cape
1706	#ifdef ISO
1707	,xtprecip,fxt,fxtd, xtVprecip,xtVprecipi, xtclw,xtevap,xtwdtraina &
1708	,xtprecip1,fxt1,fxtd1, xtVprecip1, xtVprecipi1, xtclw1,xtevap1,xtwdtraina1 &
1709	#ifdef DIAGISO
1710	, water,xtwater,qp,xtp &
1711	, fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
1712	, fxt_detrainement,fxt_ddft,fxt_fluxmasse, fxt_evapprecip &
1713	, f_detrainement,q_detrainement,xt_detrainement &
1714	, water1,xtwater1,qp1,xtp1 &
1715	, fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
1716	, fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1, fxt_evapprecip1 &
1717	, f_detrainement1,q_detrainement1,xt_detrainement1 &
1718	#endif
1719	#endif
1720	)
1721
1722
1723	#ifdef ISOVERIF
1724	DO k = 1, nd
1725	DO i = 1, len
1726	IF (iso_HDO.gt.0) THEN
1727	IF (q1(i,k).gt.ridicule) THEN
1728	CALL iso_verif_aberrant( &
1729	(xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
1730	/(q1(i,k)+delt*fq1(i,k)),'cva_driver 2554')
1731	endif
1732	endif !if (iso_HDO.gt.0) THEN
1733	IF (iso_eau.gt.0) THEN
1734	CALL iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
1735	fq1(i,k),'cva_driver 1383',errmax,errmaxrel)
1736	endif
1737	do ixt=1,ntraciso
1738	IF (iso_verif_noNaN_nostop(fxtd1(ixt,i,k), &
1739	'cva_driver 1447').EQ.1) THEN
1740	WRITE(,) 'i,k=', i,k
1741	stop
1742	endif !if (iso_verif_noNaN_nostop(fxtd1(ixt,i,k),
1743	enddo
1744	enddo
1745	enddo
1746	#endif
1747
1748	IF (prt_level >= 10) THEN
1749	Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
1750	ft1(igout,1), ftd1(igout,1)
1751	Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
1752	fq1(igout,1), fqd1(igout,1)
1753	ENDIF
1754
1755	END IF
1756
1757	IF (iflag_con==4) THEN
1758	IF (prt_level >= 9) &
1759	PRINT *, 'cva_driver -> cv_uncompress'
1760	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1761	iflag, &
1762	precip, cbmf, &
1763	ft, fq, fu, fv, &
1764	ma, qcondc, &
1765	iflag1, &
1766	precip1,cbmf1, &
1767	ft1, fq1, fu1, fv1, &
1768	ma1, qcondc1)
1769	END IF
1770
1771	END IF ! ncum>0
1772
1773
1774	DO i = 1,len
1775	IF (iflag1(i) == 14) THEN
1776	Cin1(i) = Cin_noconv
1777	Cape1(i) = Cape_noconv
1778	ENDIF
1779	ENDDO
1780
1781	! In order take into account the possibility of changing the compression,
1782	! reset m, sig and w0 to zero for non-convective points.
1783	DO k = 1,nd-1
1784	sig1(:, k) = sig1(:, k)*coef_convective(:)
1785	w01(:, k) = w01(:, k)*coef_convective(:)
1786	ENDDO
1787
1788	IF (debut) THEN
1789	PRINT *, ' cv_uncompress -> '
1790	debut = .FALSE.
1791	END IF !(debut) THEN
1792
1793
1794
1795	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format