Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

cva_driver_mod.f90

Last change on this file was 6058, checked in by fhourdin, 6 weeks ago

Travail pour la replayisation de la convection

Reunion de tous les anciens common devenus modules, dans lmdz_cv_ini.
Déplacement de presque toutes les routines d'initialisation dans lmdz_cv_ini.
Encapsulage de certains sous-programmes dans des modules.
Suppression de programmes inutilisés (cv3_crit et cv3_incp)
Reste :

à sortir des routines d'initialisation "_pre" de cv_driver et

cva_driver

à passer le variables argunement en intent(in/out/inout).

La convergence numérique a été testée pour
iflag_con=3/30/4
en 3D parallèle.
La compilation de la version isotopique fonctionne.

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: 58.6 KB

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

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

Download in other formats:

Original Format