Context Navigation

cva_driver.f90 @ 5935

Last change on this file since 5935 was 5843, checked in by jyg, 5 months ago
Getting rid of "ments" and "qents" arrays within cva_driver. Several comments to be cleared later.
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: 57.7 KB

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

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

Download in other formats:

Original Format