Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

cv_driver.F90 @ 4003

Last change on this file since 4003 was 3331, checked in by acozic, 6 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 44.8 KB

Line
1
2	! $Header$
3
4	SUBROUTINE cv_driver(len, nd, ndp1, ntra, iflag_con, t1, q1, qs1, u1, v1, &
5	tra1, p1, ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, vprecip1, &
6	cbmf1, sig1, w01, icb1, inb1, delt, ma1, upwd1, dnwd1, dnwd01, qcondc1, &
7	wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, clw1, elij1, & !
8	! RomP
9	evap1, ep1, epmlmmm1, eplamm1, & ! RomP
10	wdtraina1, wdtrainm1, & ! RomP
11	epmax_diag1 & ! epmax_cape
12	#ifdef ISO
13	& ,xt1,fxt1,xtprecip1,xtvprecip1 &
14	#ifdef DIAGISO
15	& , water1,xtwater1,qp1,xtp1,xtevap1 &
16	& , xtclw1 ! juste diagnostique
17	& , wdtrain1,xtwdtrain1,tp1 &
18	& , taux_cond_conv1 &
19	& , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
20	& , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1 &
21	& , fxt_evapprecip1,Mi1,Amp_diag1,tg_save1 &
22	& , f_detrainement1,q_detrainement1,xt_detrainement1 &
23	#endif
24	#endif
25	& )
26
27	USE dimphy
28	#ifdef ISO
29	USE infotrac_phy, ONLY: ntraciso,use_iso,niso,index_trac,ntraceurs_zone
30	USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
31	#ifdef ISOVERIF
32	use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
33	iso_verif_egalite_choix,iso_verif_aberrant_choix, &
34	iso_verif_aberrant, iso_verif_positif,iso_verif_positif_nostop
35	#endif
36	#ifdef ISOTRAC
37	use isotrac_mod, only: option_traceurs,izone_ddft,izone_revap, &
38	& izone_poubelle, index_zone,option_tmin,izone_cond
39	#ifdef ISOVERIF
40	USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
41	& iso_verif_trac_masse_vect
42	use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
43	#endif
44	#endif
45	#endif
46	IMPLICIT NONE
47
48	! .............................START PROLOGUE............................
49
50
51	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
52	! "1" appended.
53	! The "1" is removed for the corresponding compressed (local) variables.
54
55	! PARAMETERS:
56	! Name Type Usage Description
57	! ---------- ---------- ------- ----------------------------
58
59	! len Integer Input first (i) dimension
60	! nd Integer Input vertical (k) dimension
61	! ndp1 Integer Input nd + 1
62	! ntra Integer Input number of tracors
63	! iflag_con Integer Input version of convect (3/4)
64	! t1 Real Input temperature
65	! q1 Real Input specific hum
66	! qs1 Real Input sat specific hum
67	! u1 Real Input u-wind
68	! v1 Real Input v-wind
69	! tra1 Real Input tracors
70	! p1 Real Input full level pressure
71	! ph1 Real Input half level pressure
72	! iflag1 Integer Output flag for Emanuel conditions
73	! ft1 Real Output temp tend
74	! fq1 Real Output spec hum tend
75	! fu1 Real Output u-wind tend
76	! fv1 Real Output v-wind tend
77	! ftra1 Real Output tracor tend
78	! precip1 Real Output precipitation
79	! VPrecip1 Real Output vertical profile of
80	! precipitations
81	! cbmf1 Real Output cloud base mass flux
82	! sig1 Real In/Out section adiabatic updraft
83	! w01 Real In/Out vertical velocity within adiab
84	! updraft
85	! delt Real Input time step
86	! Ma1 Real Output mass flux adiabatic updraft
87	! upwd1 Real Output total upward mass flux
88	! (adiab+mixed)
89	! dnwd1 Real Output saturated downward mass flux
90	! (mixed)
91	! dnwd01 Real Output unsaturated downward mass flux
92	! qcondc1 Real Output in-cld mixing ratio of
93	! condensed water
94	! wd1 Real Output downdraft velocity scale for
95	! sfc fluxes
96	! cape1 Real Output CAPE
97
98	! wdtrainA1 Real Output precipitation detrained from
99	! adiabatic draught;
100	! used in tracer transport (cvltr)
101	! wdtrainM1 Real Output precipitation detrained from mixed
102	! draughts;
103	! used in tracer transport (cvltr)
104	! da1 Real Output used in tracer transport (cvltr)
105	! phi1 Real Output used in tracer transport (cvltr)
106	! mp1 Real Output used in tracer transport (cvltr)
107
108	! phi21 Real Output used in tracer transport (cvltr)
109
110	! d1a1 Real Output used in tracer transport (cvltr)
111	! dam1 Real Output used in tracer transport (cvltr)
112
113	! evap1 Real Output
114	! ep1 Real Output
115	! sij1 Real Output
116	! elij1 Real Output
117
118	! S. Bony, Mar 2002:
119	! * Several modules corresponding to different physical processes
120	! * Several versions of convect may be used:
121	! - iflag_con=3: version lmd (previously named convect3)
122	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
123	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
124	! S. Bony, Oct 2002:
125	! * Vectorization of convect3 (ie version lmd)
126
127	! ..............................END PROLOGUE.............................
128
129
130	! Input
131	INTEGER len
132	INTEGER nd
133	INTEGER ndp1
134	INTEGER noff
135	INTEGER iflag_con
136	INTEGER ntra
137	REAL delt
138	REAL t1(len, nd)
139	REAL q1(len, nd)
140	REAL qs1(len, nd)
141	REAL u1(len, nd)
142	REAL v1(len, nd)
143	REAL tra1(len, nd, ntra)
144	REAL p1(len, nd)
145	REAL ph1(len, ndp1)
146
147	! Output
148	INTEGER iflag1(len)
149	REAL ft1(len, nd)
150	REAL fq1(len, nd)
151	REAL fu1(len, nd)
152	REAL fv1(len, nd)
153	REAL ftra1(len, nd, ntra)
154	REAL precip1(len)
155	REAL cbmf1(len)
156	REAL sig1(klon, klev)
157	REAL w01(klon, klev)
158	REAL vprecip1(len, nd+1)
159	REAL evap1(len, nd) !RomP
160	REAL ep1(len, nd) !RomP
161	REAL ma1(len, nd)
162	REAL upwd1(len, nd)
163	REAL dnwd1(len, nd)
164	REAL dnwd01(len, nd)
165
166	REAL qcondc1(len, nd) ! cld
167	REAL wd1(len) ! gust
168	REAL cape1(len)
169
170	! RomP >>>
171	REAL wdtraina1(len, nd), wdtrainm1(len, nd)
172	REAL sij1(len, nd, nd), elij1(len, nd, nd)
173	REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
174
175	REAL phi21(len, nd, nd)
176	REAL d1a1(len, nd), dam1(len, nd)
177	REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
178	! RomP <<<
179	REAL epmax_diag1 (len) ! epmax_cape
180
181
182	#ifdef ISO
183	!integer niso
184	real xt1(ntraciso,len,nd)
185	real fxt1(ntraciso,len,nd)
186	real xtprecip1(ntraciso,len)
187	real xtvprecip1(ntraciso,len,nd+1)
188	#ifdef DIAGISO
189	real water1(len,nd)
190	real xtwater1(niso,len,nd)
191	real qp1(len,nd),xtp1(ntraciso,len,nd)
192	real xtevap1(niso,len,nd)
193	real wdtrain1(len,nd)
194	real xtwdtrain1(niso,len,nd)
195	real taux_cond_conv1(len,nd)
196	real epmax_diag1(len)
197	real fq_detrainement1(len,nd)
198	real f_detrainement1(len,nd)
199	real q_detrainement1(len,nd)
200	real fq_ddft1(len,nd)
201	real fq_fluxmasse1(len,nd)
202	real Amp_diag1(len,nd)
203	! real tg_save1(len,nd)
204	real fq_evapprecip1(len,nd)
205	real fxt_detrainement1(niso,len,nd)
206	real xt_detrainement1(niso,len,nd)
207	real fxt_ddft1(niso,len,nd)
208	real fxt_fluxmasse1(niso,len,nd)
209	real fxt_evapprecip1(niso,len,nd)
210	real Mi1(len,nd)
211	! real mentbas1(len,nd)
212	! real qentbas1(len,nd), xtentbas1(niso,len,nd)
213	#endif
214	#ifdef ISOVERIF
215	real deltaD
216	#endif
217	#endif
218
219	! -------------------------------------------------------------------
220	! Original Prologue by Kerry Emanuel.
221	! -------------------------------------------------------------------
222	! --- ARGUMENTS
223	! -------------------------------------------------------------------
224	! --- On input:
225
226	! t: Array of absolute temperature (K) of dimension ND, with first
227	! index corresponding to lowest model level. Note that this array
228	! will be altered by the subroutine if dry convective adjustment
229	! occurs and if IPBL is not equal to 0.
230
231	! q: Array of specific humidity (gm/gm) of dimension ND, with first
232	! index corresponding to lowest model level. Must be defined
233	! at same grid levels as T. Note that this array will be altered
234	! if dry convective adjustment occurs and if IPBL is not equal to 0.
235
236	! qs: Array of saturation specific humidity of dimension ND, with first
237	! index corresponding to lowest model level. Must be defined
238	! at same grid levels as T. Note that this array will be altered
239	! if dry convective adjustment occurs and if IPBL is not equal to 0.
240
241	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
242	! index corresponding with the lowest model level. Defined at
243	! same levels as T. Note that this array will be altered if
244	! dry convective adjustment occurs and if IPBL is not equal to 0.
245
246	! v: Same as u but for meridional velocity.
247
248	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
249	! where NTRA is the number of different tracers. If no
250	! convective tracer transport is needed, define a dummy
251	! input array of dimension (ND,1). Tracers are defined at
252	! same vertical levels as T. Note that this array will be altered
253	! if dry convective adjustment occurs and if IPBL is not equal to 0.
254
255	! p: Array of pressure (mb) of dimension ND, with first
256	! index corresponding to lowest model level. Must be defined
257	! at same grid levels as T.
258
259	! ph: Array of pressure (mb) of dimension ND+1, with first index
260	! corresponding to lowest level. These pressures are defined at
261	! levels intermediate between those of P, T, Q and QS. The first
262	! value of PH should be greater than (i.e. at a lower level than)
263	! the first value of the array P.
264
265	! nl: The maximum number of levels to which convection can penetrate, plus
266	! 1.
267	! NL MUST be less than or equal to ND-1.
268
269	! delt: The model time step (sec) between calls to CONVECT
270
271	! ----------------------------------------------------------------------------
272	! --- On Output:
273
274	! iflag: An output integer whose value denotes the following:
275	! VALUE INTERPRETATION
276	! ----- --------------
277	! 0 Moist convection occurs.
278	! 1 Moist convection occurs, but a CFL condition
279	! on the subsidence warming is violated. This
280	! does not cause the scheme to terminate.
281	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
282	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
283	! 4 No moist convection; atmosphere is not
284	! unstable
285	! 6 No moist convection because ihmin le minorig.
286	! 7 No moist convection because unreasonable
287	! parcel level temperature or specific humidity.
288	! 8 No moist convection: lifted condensation
289	! level is above the 200 mb level.
290	! 9 No moist convection: cloud base is higher
291	! then the level NL-1.
292
293	! ft: Array of temperature tendency (K/s) of dimension ND, defined at
294	! same
295	! grid levels as T, Q, QS and P.
296
297	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
298	! defined at same grid levels as T, Q, QS and P.
299
300	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
301	! defined at same grid levels as T.
302
303	! fv: Same as FU, but for forcing of meridional velocity.
304
305	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
306	! second, defined at same levels as T. Dimensioned (ND,NTRA).
307
308	! precip: Scalar convective precipitation rate (mm/day).
309
310	! VPrecip: Vertical profile of convective precipitation (kg/m2/s).
311
312	! wd: A convective downdraft velocity scale. For use in surface
313	! flux parameterizations. See convect.ps file for details.
314
315	! tprime: A convective downdraft temperature perturbation scale (K).
316	! For use in surface flux parameterizations. See convect.ps
317	! file for details.
318
319	! qprime: A convective downdraft specific humidity
320	! perturbation scale (gm/gm).
321	! For use in surface flux parameterizations. See convect.ps
322	! file for details.
323
324	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
325	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
326	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
327	! by the calling program between calls to CONVECT.
328
329	! det: Array of detrainment mass flux of dimension ND.
330
331	! -------------------------------------------------------------------
332
333	! Local arrays
334
335
336	INTEGER i, k, n, il, j
337	INTEGER icbmax
338	INTEGER nk1(klon)
339	INTEGER icb1(klon)
340	INTEGER inb1(klon)
341	INTEGER icbs1(klon)
342
343	REAL plcl1(klon)
344	REAL tnk1(klon)
345	REAL qnk1(klon)
346	REAL gznk1(klon)
347	REAL pnk1(klon)
348	REAL qsnk1(klon)
349	REAL pbase1(klon)
350	REAL buoybase1(klon)
351
352	REAL lv1(klon, klev)
353	REAL cpn1(klon, klev)
354	REAL tv1(klon, klev)
355	REAL gz1(klon, klev)
356	REAL hm1(klon, klev)
357	REAL h1(klon, klev)
358	REAL tp1(klon, klev)
359	REAL tvp1(klon, klev)
360	REAL clw1(klon, klev)
361	REAL th1(klon, klev)
362
363	#ifdef ISO
364	integer ixt
365	real xtclw1(ntraciso,klon,klev)
366	real tg_save1(klon,klev)
367	REAL xtnk1(ntraciso,klon)
368	#endif
369
370	INTEGER ncum
371
372	! (local) compressed fields:
373
374	! ym integer nloc
375	! ym parameter (nloc=klon) ! pour l'instant
376	#define nloc klon
377	INTEGER idcum(nloc)
378	INTEGER iflag(nloc), nk(nloc), icb(nloc)
379	INTEGER nent(nloc, klev)
380	INTEGER icbs(nloc)
381	INTEGER inb(nloc), inbis(nloc)
382
383	REAL cbmf(nloc), plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)
384	REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
385	REAL u(nloc, klev), v(nloc, klev)
386	REAL gz(nloc, klev), h(nloc, klev), lv(nloc, klev), cpn(nloc, klev)
387	REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
388	REAL clw(nloc, klev)
389	REAL dph(nloc, klev)
390	REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
391	REAL tvp(nloc, klev)
392	REAL sig(nloc, klev), w0(nloc, klev)
393	REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
394	REAL frac(nloc), buoy(nloc, klev)
395	REAL cape(nloc)
396	REAL m(nloc, klev), ment(nloc, klev, klev), qent(nloc, klev, klev)
397	REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
398	REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
399	REAL sij(nloc, klev, klev), elij(nloc, klev, klev)
400	REAL qp(nloc, klev), up(nloc, klev), vp(nloc, klev)
401	REAL wt(nloc, klev), water(nloc, klev), evap(nloc, klev)
402	REAL b(nloc, klev), ft(nloc, klev), fq(nloc, klev)
403	REAL fu(nloc, klev), fv(nloc, klev)
404	REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
405	REAL ma(nloc, klev), mike(nloc, klev), tls(nloc, klev)
406	REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
407	REAL precip(nloc)
408	REAL vprecip(nloc, klev+1)
409	REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
410	REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
411	REAL qcondc(nloc, klev) ! cld
412	REAL wd(nloc) ! gust
413
414	! RomP >>>
415	REAL da(nloc, klev), phi(nloc, klev, klev), mp(nloc, klev)
416	REAL epmlmmm(nloc, klev, klev), eplamm(nloc, klev)
417	REAL phi2(nloc, klev, klev)
418	REAL d1a(nloc, klev), dam(nloc, klev)
419	REAL wdtraina(nloc, klev), wdtrainm(nloc, klev)
420	REAL sigd(nloc)
421	! RomP <<<
422	REAL epmax_diag(nloc) ! epmax_cape
423	#ifdef ISO
424	real xt(ntraciso,nloc,klev)
425	real xtnk(ntraciso,nloc)
426	real xtclw(ntraciso,nloc,klev)
427	real xtp(ntraciso,nloc,klev)
428	real xtent(ntraciso,nloc,klev,klev)
429	real xtelij(ntraciso,nloc,klev,klev)
430	! real xtep(ntraciso,nloc,klev) ! le 7 mai: on supprime xtep
431	real xtwater(ntraciso,nloc,klev)
432	real xtevap(ntraciso,nloc,klev)
433	real fxt(ntraciso,nloc,klev)
434	real xtprecip(ntraciso,nloc)
435	real tg_save(nloc,klev) ! températures de condensation
436	real xtvprecip(ntraciso,nloc,klev+1)
437	#ifdef DIAGISO
438	real wdtrain(nloc,klev)
439	real xtwdtrain(niso,nloc,klev)
440	real taux_cond_conv(nloc,klev)
441	real epmax_diag(nloc)
442	real fxt_detrainement(niso,nloc,klev)
443	real fxt_fluxmasse(niso,nloc,klev)
444	real fxt_evapprecip(niso,nloc,klev)
445	real fxt_ddft(niso,nloc,klev)
446	real fq_detrainement(nloc,klev)
447	real f_detrainement(nloc,klev)
448	real q_detrainement(nloc,klev)
449	real xt_detrainement(niso,nloc,klev)
450	real fq_fluxmasse(nloc,klev)
451	real Amp_diag(nloc,klev)
452	real fq_evapprecip(nloc,klev)
453	real fq_ddft(nloc,klev)
454	! real Mi(nloc,klev) déjà sorti dans cv3_yield: m
455	! real mentbas(nloc,klev): déjà sortie: ment
456	! real qentbas(nloc,klev): déjà sortie: qent
457	#endif
458	#ifdef ISOTRAC
459	integer iiso,ixt_ddft,ixt_poubelle,ixt_revap
460	integer izone
461	!#ifdef ISOVERIF
462	! integer iso_verif_positif_nostop
463	!#endif
464	#endif
465	#endif
466
467
468	#ifdef ISO
469	! verif
470	#ifdef ISOVERIF
471	write(,) 'cv_driver 391: ENTREE dans cv_driver'
472	! write(,) 'nloc=',nloc
473	if (use_iso(iso_eau)) then
474	do k = 1, klev
475	do i = 1, nloc
476	call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
477	& 'cv_driver 343',errmax,errmaxrel)
478	enddo
479	enddo
480	endif !if (use_iso(iso_eau)) then
481	if (use_iso(iso_HDO)) then
482	do k = 1, klev
483	do i = 1, nloc
484	if (q1(i,k).gt.ridicule) then
485	call iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
486	& 'cv_driver 362')
487	endif !if (q1(i,k).gt.ridicule) then
488	enddo
489	enddo
490	endif !if (use_iso(iso_eau)) then
491	#ifdef ISOTRAC
492	do k = 1, klev
493	do i = 1, klon
494	call iso_verif_traceur(xt1(1,i,k),'cv_driver 413')
495	enddo
496	enddo
497	#endif
498	#endif
499	! end verif
500	#endif
501
502
503	nent(:, :) = 0
504	! -------------------------------------------------------------------
505	! --- SET CONSTANTS AND PARAMETERS
506	! -------------------------------------------------------------------
507	! print *, '-> cv_driver' !jyg
508	! -- set simulation flags:
509	! (common cvflag)
510
511	CALL cv_flag(0)
512
513	! -- set thermodynamical constants:
514	! (common cvthermo)
515
516	CALL cv_thermo(iflag_con)
517
518	! -- set convect parameters
519
520	! includes microphysical parameters and parameters that
521	! control the rate of approach to quasi-equilibrium)
522	! (common cvparam)
523
524
525	IF (iflag_con==30) THEN
526	CALL cv30_param(nd, delt)
527	END IF
528
529	IF (iflag_con==4) THEN
530	CALL cv_param(nd)
531	#ifdef ISO
532	write(,) 'cv_driver 454: isos pas prévus ici'
533	stop
534	#endif
535	END IF
536
537	! ---------------------------------------------------------------------
538	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
539	! ---------------------------------------------------------------------
540
541	ft1(:, :) = 0.0
542	fq1(:, :) = 0.0
543	fu1(:, :) = 0.0
544	fv1(:, :) = 0.0
545	tvp1(:, :) = 0.0
546	tp1(:, :) = 0.0
547	clw1(:, :) = 0.0
548	! ym
549	clw(:, :) = 0.0
550	gz1(:, :) = 0.
551	vprecip1(:, :) = 0.
552	ma1(:, :) = 0.0
553	upwd1(:, :) = 0.0
554	dnwd1(:, :) = 0.0
555	dnwd01(:, :) = 0.0
556	qcondc1(:, :) = 0.0
557
558	ftra1(:, :, :) = 0.0
559
560	elij1(:, :, :) = 0.0
561	sij1(:, :, :) = 0.0
562
563	precip1(:) = 0.0
564	iflag1(:) = 0
565	wd1(:) = 0.0
566	cape1(:) = 0.0
567	epmax_diag1(:) = 0.0 ! epmax_cape
568
569
570	#ifdef ISOVERIF
571	#ifdef ISOTRAC
572	do k=1,klev
573	do i=1,klon
574	call iso_verif_traceur(xt1(1,i,k),'cv_driver 510')
575	enddo
576	enddo
577	#endif
578	#endif
579
580	#ifdef ISO
581	fxt1(:,:,:)=0.0
582	xtclw1(:,:,:)=0.0
583	xtclw(:,:,:)=0.0
584	xtvprecip1(:,:,:) = 0.
585	tg_save1(:,:) = 0.
586	#ifdef DIAGISO
587	do k=1,nd
588	do i=1,len
589	do ixt=1,niso
590	xtwater1(ixt,i,k)=0.0
591	xtwdtrain1(ixt,i,k)=0.0
592	fxt_detrainement1(ixt,i,k)=0.0
593	xt_detrainement1(ixt,i,k)=0.0
594	fxt_ddft1(ixt,i,k)=0.0
595	fxt_fluxmasse1(ixt,i,k)=0.0
596	fxt_evapprecip1(ixt,i,k)=0.0
597	xtp1(ixt,i,k)=0.0
598	xtevap1(ixt,i,k)=0.0
599	! xtentbas(ixt,i,k)=0.0
600	enddo
601	#ifdef ISOTRAC
602	do ixt=1+niso,ntraciso
603	xtp1(ixt,i,k)=0.0
604	enddo !do ixt=1+niso,ntraciso
605	#endif
606	evap1(i,k)=0.0
607	wdtrain1(i,k)=0.0
608	taux_cond_conv1(i,k)=0.0
609	water1(i,k)=0.0
610	Mp1(i,k)=0.0
611	qp1(i,k)=0.0
612	fq_detrainement1(i,k)=0.0
613	fq_ddft1(i,k)=0.0
614	fq_fluxmasse1(i,k)=0.0
615	Amp_diag1(i,k)=0.0
616	tg_save1(i,k)=t1(i,k)
617	fq_evapprecip1(i,k)=0.0
618	Mi1(i,k)=0.0
619	! qentbas1(i,k)=0.0
620	! mentbas1(i,k)=0.0
621	enddo !do i=1,len
622	enddo !do k=1,nd
623	#endif
624	#endif
625
626	IF (iflag_con==30) THEN
627	DO il = 1, len
628	sig1(il, nd) = sig1(il, nd) + 1.
629	sig1(il, nd) = amin1(sig1(il,nd), 12.1)
630	END DO
631	END IF
632
633	! RomP >>>
634	wdtraina1(:, :) = 0.
635	wdtrainm1(:, :) = 0.
636	da1(:, :) = 0.
637	phi1(:, :, :) = 0.
638	epmlmmm1(:, :, :) = 0.
639	eplamm1(:, :) = 0.
640	mp1(:, :) = 0.
641	evap1(:, :) = 0.
642	ep1(:, :) = 0.
643	sij1(:, :, :) = 0.
644	elij1(:, :, :) = 0.
645	phi21(:, :, :) = 0.
646	d1a1(:, :) = 0.
647	dam1(:, :) = 0.
648	! RomP <<<
649
650	! --------------------------------------------------------------------
651	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
652	! --------------------------------------------------------------------
653
654	IF (iflag_con==30) THEN
655
656	! print*,'Emanuel version 30 '
657	CALL cv30_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
658	, lv1, cpn1, tv1, gz1, h1, hm1, th1)
659	END IF
660
661	IF (iflag_con==4) THEN
662	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
663	hm1)
664	END IF
665
666	! --------------------------------------------------------------------
667	! --- CONVECTIVE FEED
668	! --------------------------------------------------------------------
669
670	IF (iflag_con==30) THEN
671	CALL cv30_feed(len, nd, t1, q1, qs1, p1, ph1, hm1, gz1 & !
672	! nd->na
673	, nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1 &
674	#ifdef ISO
675	,xt1,xtnk1 &
676	#endif
677	)
678	END IF
679
680	IF (iflag_con==4) THEN
681	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
682	iflag1, tnk1, qnk1, gznk1, plcl1)
683	END IF
684
685	! --------------------------------------------------------------------
686	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
687	! (up through ICB for convect4, up through ICB+1 for convect3)
688	! Calculates the lifted parcel virtual temperature at nk, the
689	! actual temperature, and the adiabatic liquid water content.
690	! --------------------------------------------------------------------
691
692	IF (iflag_con==30) THEN
693
694	#ifdef ISOVERIF
695	write(,) 'cv_driver 593: avant cv3_undilute1'
696	do k=1,klev
697	do i=1,klon
698	if (use_iso(iso_HDO)) then
699	if (q1(i,k).gt.ridicule) then
700	call iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
701	& 'cv_driver 502')
702	endif ! if (q1(i,k).gt.ridicule) then
703	endif !if (use_iso(iso_HDO)) then
704	#ifdef ISOTRAC
705	call iso_verif_traceur(xt1(1,i,k),'cv_driver 601')
706	#endif
707	enddo
708	enddo
709	#endif
710
711
712	CALL cv30_undilute1(len, nd, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1 & ! nd->na
713	, tp1, tvp1, clw1, icbs1 &
714	#ifdef ISO
715	& ,xt1,xtclw1,tg_save1 &
716	#endif
717	& )
718
719
720	#ifdef ISO
721	!c--debug
722	#ifdef ISOVERIF
723	write(,) 'cv_driver 621: après cv3_undilute1'
724	do k = 1, klev
725	do i = 1, klon
726	if (use_iso(iso_eau)) then
727	call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
728	& 'undil1',errmax,errmaxrel)
729	call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
730	& 'undil1',errmax,errmaxrel)
731	endif !if (use_iso(iso_eau)) then
732	#ifdef ISOTRAC
733	call iso_verif_traceur(xt1(1,i,k),'cv_driver 623')
734	#endif
735	enddo
736	enddo
737	#endif
738	!write(,) 'SORTIE DE CV3_UNDILUTE1'
739	#endif
740
741	END IF
742
743	IF (iflag_con==4) THEN
744	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
745	tvp1, clw1)
746	END IF
747
748	! -------------------------------------------------------------------
749	! --- TRIGGERING
750	! -------------------------------------------------------------------
751
752	IF (iflag_con==30) THEN
753	CALL cv30_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1 & !
754	! nd->na
755	, pbase1, buoybase1, iflag1, sig1, w01)
756	END IF
757
758	IF (iflag_con==4) THEN
759	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
760	END IF
761
762	! =====================================================================
763	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
764	! =====================================================================
765
766	ncum = 0
767	DO i = 1, len
768	IF (iflag1(i)==0) THEN
769	ncum = ncum + 1
770	idcum(ncum) = i
771	END IF
772	END DO
773
774	! print*,'cv_driver : klon, ncum = ',len,ncum
775
776	IF (ncum>0) THEN
777
778	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
779	! --- COMPRESS THE FIELDS
780	! (-> vectorization over convective gridpoints)
781	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
782
783	IF (iflag_con==30) THEN
784	#ifdef ISO
785	#ifdef ISOVERIF
786	write(,) 'cv_driver 771: tg_save1(1,1)=',tg_save1(1,1)
787	write(,) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
788	!write(,) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1)
789	write(,) 'iso_eau,use_iso=',iso_eau,use_iso
790	do k = 1, klev
791	do i = 1, nloc
792	if (use_iso(iso_eau)) then
793	call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
794	& 'cv_driver 541a',errmax,errmaxrel)
795	call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
796	& 'cv_driver 541b',errmax,errmaxrel)
797	endif ! if (use_iso(iso_eau)) then
798	#ifdef ISOTRAC
799	call iso_verif_traceur(xt1(1,i,k),'cv_driver 689')
800	#endif
801	enddo
802	enddo
803	#endif
804	#endif
805
806	CALL cv30_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
807	plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, &
808	gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, &
809	w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, &
810	q, qs, u, v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, &
811	w0 &
812	#ifdef ISO
813	& ,xtnk1,xt1,xtclw1,tg_save1 &
814	& ,xtnk,xt,xtclw,tg_save &
815	#endif
816	& )
817
818	#ifdef ISO
819	#ifdef ISOVERIF
820	write(,) 'cv_driver 720: après cv3_compress'
821	write(,) 'tg_save(1,1)=',tg_save(1,1)
822	do k = 1, klev
823	do i = 1, ncum
824	if (use_iso(iso_eau)) then
825	call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
826	& 'cv_driver 598',errmax,errmaxrel)
827	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
828	& 'cv_driver 600',errmax,errmaxrel)
829	endif ! if (use_iso(iso_eau)) then
830	if (use_iso(iso_HDO)) then
831	call iso_verif_aberrant_choix( &
832	& xt(iso_HDO,i,k),q(i,k), &
833	& ridicule,deltalim,'cv_driver 735, apres compress')
834	endif !if (use_iso(iso_HDO)) then
835	#ifdef ISOTRAC
836	call iso_verif_traceur(xt(1,i,k),'cv_driver 726')
837	#endif
838	call iso_verif_positif(tg_save(i,k)-Tmin_verif, &
839	& 'cv_driver 806')
840	enddo
841	enddo
842	if (use_iso(iso_eau)) then
843	do i = 1, ncum
844	call iso_verif_egalite_choix(xtnk(iso_eau,i),qnk(i), &
845	& 'cv_driver 834',errmax,errmaxrel)
846	enddo
847	endif !if (use_iso(iso_eau)) then
848	#endif
849	#endif
850
851	END IF
852
853	IF (iflag_con==4) THEN
854	CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
855	tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
856	tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
857	q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
858	END IF
859
860	! -------------------------------------------------------------------
861	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
862	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
863	! --- &
864	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
865	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
866	! --- &
867	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
868	! -------------------------------------------------------------------
869
870	IF (iflag_con==30) THEN
871	CALL cv30_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
872	, tnk, qnk, gznk, t, q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, &
873	inb, tp, tvp, clw, hp, ep, sigp, buoy &
874	#ifdef ISO
875	& ,xtnk,xt,xtclw,tg_save &
876	#endif
877	& )
878
879	#ifdef ISO
880	#ifdef ISOVERIF
881	write(,) 'cv_driver 863: apres call cv30_undilute2'
882	write(,) 'tg_save(1,1)=',tg_save(1,1)
883	do k = 1, klev
884	do i = 1, ncum
885	if (use_iso(iso_eau)) then
886	call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
887	& 'cv_driver 650',errmax,errmaxrel)
888	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
889	& 'cv_driver 652',errmax,errmaxrel)
890	endif ! if (use_iso(iso_eau)) then
891	if (use_iso(iso_HDO)) then
892	call iso_verif_aberrant_choix( &
893	& xt(iso_HDO,i,k),q(i,k), &
894	& ridicule,deltalim,'cv_driver 794, apres undilute2')
895	endif !if (use_iso(iso_HDO)) then
896	call iso_verif_positif(tg_save(i,k)-Tmin_verif, &
897	& 'cv_driver 859')
898	#ifdef ISOTRAC
899	call iso_verif_traceur(xt(1,i,k),'cv_driver 780')
900	call iso_verif_traceur(xtclw(1,i,k),'cv_driver 781')
901	#endif
902	enddo
903	enddo
904	#endif
905	!write(,) 'SORTIE CV3_UNDILUTE2'
906	#endif
907	END IF
908
909	IF (iflag_con==4) THEN
910	CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
911	gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
912	END IF
913
914	! -------------------------------------------------------------------
915	! --- CLOSURE
916	! -------------------------------------------------------------------
917
918	IF (iflag_con==30) THEN
919	CALL cv30_closure(nloc, ncum, nd, icb, inb & ! na->nd
920	, pbase, p, ph, tv, buoy, sig, w0, cape, m)
921
922	! epmax_cape
923	call cv30_epmax_fn_cape(nloc,ncum,nd &
924	,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
925	,epmax_diag)
926	! on écrase ep et recalcule hp
927	END IF
928
929	IF (iflag_con==4) THEN
930	CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
931	cpn, iflag, cbmf)
932	END IF
933
934
935	! -------------------------------------------------------------------
936	! --- MIXING
937	! -------------------------------------------------------------------
938
939	IF (iflag_con==30) THEN
940	CALL cv30_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
941	! na->nd
942	, ph, t, q, qs, u, v, tra, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, &
943	ment, qent, uent, vent, sij, elij, ments, qents, traent &
944	#ifdef ISO
945	& ,xt,xtnk,xtclw &
946	& ,xtent,xtelij,tg_save &
947	#endif
948	& )
949
950
951	#ifdef ISO
952	#ifdef ISOVERIF
953	write(,) 'cv_driver 837: après cv3_mixing'
954	do k = 1, klev
955	do j = 1, klev
956	do i = 1, ncum
957	if (use_iso(iso_eau)) then
958	call iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
959	& elij(i,j,k),'cv_driver 881',errmax,errmaxrel)
960	call iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
961	& qent(i,j,k),'cv_driver 882',errmax,errmaxrel)
962	endif ! if (use_iso(iso_eau)) then
963	#ifdef ISOTRAC
964	call iso_verif_traceur_justmass(xtent(1,i,j,k), &
965	& 'cv_driver 846')
966	call iso_verif_traceur_justmass(xtelij(1,i,j,k), &
967	& 'cv_driver 847')
968	! on ne vérfier pas le deltaD ici car peut dépasser le seuil
969	! raisonable pour températures très froides.
970	#endif
971	enddo
972	enddo
973	enddo !do k = 1, klev
974	do k = 1, klev
975	do i = 1, ncum
976	if (use_iso(iso_eau)) then
977	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
978	& 'cv_driver 709',errmax,errmaxrel)
979	endif ! if (use_iso(iso_eau)) then
980	#ifdef ISOTRAC
981	call iso_verif_traceur(xt(1,i,k),'cv_driver 856')
982	if (option_tmin.eq.1) then
983	if (iso_verif_positif_nostop(xtclw(index_trac( &
984	& izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
985	& ,'cv_driver 909').eq.1) then
986	write(,) 'i,k=',i,k
987	write(,) 'xtclw=',xtclw(:,i,k)
988	stop
989	endif !if (iso_verif_positif_nostop(xtclw(index_trac(
990	endif !if ((option_traceurs.eq.17).or.
991	#endif
992	#ifdef DIAGISO
993	call iso_verif_positif(tg_save(i,k)-50.0,'cv_driver 926')
994	#endif
995	enddo
996	enddo !do k = 1, klev
997
998	#endif
999	#endif
1000
1001	END IF
1002
1003	IF (iflag_con==4) THEN
1004	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
1005	h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
1006	nent, sij, elij)
1007	END IF
1008
1009	! -------------------------------------------------------------------
1010	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1011	! -------------------------------------------------------------------
1012
1013	IF (iflag_con==30) THEN
1014
1015	#ifdef ISO
1016	#ifdef ISOVERIF
1017	do k = 1, klev
1018	do i = 1, ncum
1019	if (use_iso(iso_eau)) then
1020	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1021	& 'cv_driver 753',errmax,errmaxrel)
1022	endif ! if (use_iso(iso_eau)) then
1023	#ifdef ISOTRAC
1024	call iso_verif_traceur(xt(1,i,k),'cv_driver 885')
1025	#endif
1026	enddo
1027	enddo !do k = 1, klev
1028	#endif
1029	#endif
1030
1031	! RomP >>>
1032	CALL cv30_unsat(nloc, ncum, nd, nd, ntra, icb, inb & ! na->nd
1033	, t, q, qs, gz, u, v, tra, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, &
1034	ment, elij, delt, plcl, mp, qp, up, vp, trap, wt, water, evap, b, &
1035	wdtraina, wdtrainm &
1036	#ifdef ISO
1037	& ,xt,xtclw,xtelij &
1038	& ,xtp,xtwater,xtevap &
1039	#ifdef DIAGISO
1040	& ,wdtrain,xtwdtrain,taux_cond_conv &
1041	#endif
1042	#endif
1043	& )
1044	! RomP <<<
1045
1046	#ifdef ISO
1047	! write(,) 'klev=',klev
1048	#ifdef ISOVERIF
1049	write(,) 'cv_driver 930: après cv3_unsat'
1050	do k = 1, klev
1051	do i = 1, ncum
1052	if (use_iso(iso_eau)) then
1053	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
1054	& 'cv_driver 778',errmax,errmaxrel)
1055	call iso_verif_egalite_choix(xtp(iso_eau,i,k), &
1056	& qp(i,k),'cv_driver 780',errmax,errmaxrel)
1057	call iso_verif_egalite_choix( &
1058	& xtwater(iso_eau,i,k),water(i,k), &
1059	& 'cv_driver 782',errmax,errmaxrel)
1060	call iso_verif_egalite_choix(xtevap(iso_eau,i,k), &
1061	& evap(i,k),'cv_driver 784',errmax,errmaxrel)
1062	endif ! if (use_iso(iso_eau)) then
1063	#ifdef ISOTRAC
1064	call iso_verif_traceur(xt(1,i,k),'cv_driver 939')
1065	call iso_verif_traceur(xtp(1,i,k),'cv_driver 940')
1066	call iso_verif_traceur(xtwater(1,i,k),'cv_driver 941')
1067	call iso_verif_traceur_justmass(xtevap(1,i,k), &
1068	& 'cv_driver 942')
1069	if (bidouille_anti_divergence) then
1070	call iso_verif_traceur_pbidouille( &
1071	& xtp(1,i,k),'cv_driver 956')
1072	call iso_verif_traceur_pbidouille( &
1073	& xtwater(1,i,k),'cv_driver 958')
1074	endif
1075	#endif
1076	enddo !do i = 1, ncum
1077	enddo !do k = 1, klev
1078	#endif
1079	#endif
1080
1081	END IF
1082
1083	IF (iflag_con==4) THEN
1084	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
1085	ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
1086	END IF
1087
1088	#ifdef ISO
1089	#ifdef ISOTRAC
1090	if (option_traceurs.eq.6) then
1091	! on colorie les ddfts en rouge, le reste est en blanc.
1092	do k = 1, klev
1093	do i = 1, ncum
1094	do iiso=1,niso
1095	ixt_ddft=index_trac(izone_ddft,iiso)
1096	ixt_poubelle=index_trac(izone_poubelle,iiso)
1097	xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
1098	& +xtp(ixt_poubelle,i,k)
1099	xtp(ixt_poubelle,i,k)=0.0
1100	enddo !do iiso=1,niso
1101	#ifdef ISOVERIF
1102	call iso_verif_traceur(xtp(1,i,k),'cv_driver 990')
1103	#endif
1104	enddo !do i = 1, ncum
1105	enddo !do k = 1, klev
1106	else if (option_traceurs.eq.19) then
1107	! on colorie les ddfts, mais on sauve la revap
1108	do k = 1, klev
1109	do i = 1, ncum
1110	do izone=1,ntraceurs_zone
1111	if (izone.eq.izone_ddft) then
1112	do iiso=1,niso
1113	ixt_ddft=index_trac(izone,iiso)
1114	ixt_revap=index_trac(izone_revap,iiso)
1115	xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
1116	enddo !do iiso=1,niso
1117	elseif (izone.eq.izone_ddft) then
1118	! rien à faire
1119	else !if (izone.eq.izone_ddft) then
1120	do iiso=1,niso
1121	ixt=index_trac(izone,iiso)
1122	xtp(ixt,i,k)=0.0
1123	enddo !do iiso=1,niso
1124	endif !if (izone.eq.izone_ddft) then
1125	enddo !do izone=1,ntraceurs_zone
1126	#ifdef ISOVERIF
1127	call iso_verif_traceur(xtp(1,i,k),'cv_driver 1059')
1128	#endif
1129	enddo !do i = 1, ncum
1130	enddo !do k = 1, klev
1131	endif !if (option_traceurs.eq.6) then
1132	#endif
1133	#endif
1134	! -------------------------------------------------------------------
1135	! --- YIELD
1136	! (tendencies, precipitation, variables of interface with other
1137	! processes, etc)
1138	! -------------------------------------------------------------------
1139
1140	IF (iflag_con==30) THEN
1141	CALL cv30_yield(nloc, ncum, nd, nd, ntra & ! na->nd
1142	, icb, inb, delt, t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th, ep, &
1143	clw, m, tp, mp, qp, up, vp, trap, wt, water, evap, b, ment, qent, &
1144	uent, vent, nent, elij, traent, sig, tv, tvp, iflag, precip, vprecip, &
1145	ft, fq, fu, fv, ftra, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, &
1146	wd &
1147	#ifdef ISO
1148	& ,xt,xtclw,xtp,xtwater,xtevap &
1149	& ,xtent,xtelij,xtprecip,fxt,xtVPrecip &
1150	#ifdef DIAGISO
1151	& ,fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
1152	& ,fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
1153	& ,Amp_diag &
1154	& ,f_detrainement,q_detrainement,xt_detrainement &
1155	#endif
1156	#endif
1157	& )
1158
1159	#ifdef ISOVERIF
1160	DO k = 1, nd
1161	DO i = 1, ncum
1162	if (use_iso(iso_eau)) then
1163	call iso_verif_egalite_choix(fxt(iso_eau,i,k), &
1164	& fq(i,k),'cv_driver 1086',errmax,errmaxrel)
1165	endif !if (use_iso(iso_HDO)) then
1166	if (use_iso(iso_HDO)) then
1167	if (q(i,k).gt.ridicule) then
1168	call iso_verif_aberrant( &
1169	& (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
1170	& /(q(i,k)+delt*fq(i,k)),'cv_driver 855')
1171	endif
1172	endif
1173	#ifdef ISOTRAC
1174	call iso_verif_traceur(xt(1,i,k),'cv_driver 1008')
1175	#endif
1176	#ifdef DIAGISO
1177	call iso_verif_positif(tg_save(i,k)-50.0,'cv_driver 1024')
1178	#endif
1179	enddo
1180	enddo
1181	#endif
1182
1183	END IF
1184
1185	IF (iflag_con==4) THEN
1186	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
1187	ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
1188	evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
1189	tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1190	END IF
1191
1192	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1193	! --- passive tracers
1194	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1195
1196	IF (iflag_con==30) THEN
1197	! RomP >>>
1198	CALL cv30_tracer(nloc, len, ncum, nd, nd, ment, sij, da, phi, phi2, &
1199	d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
1200	! RomP <<<
1201	END IF
1202
1203	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1204	! --- UNCOMPRESS THE FIELDS
1205	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1206	! set iflag1 =42 for non convective points
1207	DO i = 1, len
1208	iflag1(i) = 42
1209	END DO
1210
1211	IF (iflag_con==30) THEN
1212	CALL cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
1213	vprecip, evap, ep, sig, w0 & !RomP
1214	, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
1215	da, phi, mp, phi2, d1a, dam, sij & !RomP
1216	, elij, clw, epmlmmm, eplamm & !RomP
1217	, wdtraina, wdtrainm,epmax_diag & !RomP
1218	, iflag1, precip1, vprecip1, evap1, ep1, sig1, w01 & !RomP
1219	, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, dnwd01, &
1220	qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1 & !RomP
1221	, elij1, clw1, epmlmmm1, eplamm1 & !RomP
1222	, wdtraina1, wdtrainm1,epmax_diag1 & !RomP
1223	#ifdef ISO
1224	& ,xtprecip,fxt,xtVPrecip &
1225	& ,xtprecip1,fxt1,xtVPrecip1 &
1226	#ifdef DIAGISO
1227	& , water,xtwater,qp,xtp,xtevap &
1228	& , xtclw &
1229	& , wdtrain,xtwdtrain,taux_cond_conv &
1230	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
1231	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse &
1232	& , fxt_evapprecip,m,Amp_diag,tg_save,epmax_diag &
1233	& , f_detrainement,q_detrainement,xt_detrainement &
1234	! : , ment,qent,xtent
1235	& , water1,xtwater1,qp1,xtp1,xtevap1 &
1236	& , xtclw1 &
1237	& , wdtrain1,xtwdtrain1,taux_cond_conv1 &
1238	& , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
1239	& , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1 &
1240	& , fxt_evapprecip1,Mi1,Amp_diag1,tg_save1,epmax_diag1 &
1241	& , f_detrainement1,q_detrainement1,xt_detrainement1 &
1242	#endif
1243	#endif
1244	& )
1245
1246	#ifdef ISO
1247	#ifdef ISOVERIF
1248	DO k = 1, nd
1249	DO i = 1, len
1250	if (use_iso(iso_eau)) then
1251	call iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
1252	& fq1(i,k),'cv_driver 1170',errmax,errmaxrel)
1253	endif !if (use_iso(iso_HDO)) then
1254	if (use_iso(iso_HDO)) then
1255	if (q1(i,k).gt.ridicule) then
1256	call iso_verif_aberrant( &
1257	& (xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
1258	& /(q1(i,k)+delt*fq1(i,k)),'cv_driver 2554')
1259	endif
1260	endif
1261	#ifdef DIAGISO
1262	call iso_verif_positif(tg_save1(i,k)-50.0,'cv_driver 1221')
1263	#endif
1264	enddo !DO i = 1, len
1265	enddo !DO k = 1, nd
1266	#ifdef ISOTRAC
1267	call iso_verif_trac_masse_vect(fxt1,len,nd, &
1268	& 'cv_driver 1200',errmax,errmaxrel)
1269	#endif
1270	#endif
1271	#endif
1272
1273	END IF
1274
1275	IF (iflag_con==4) THEN
1276	CALL cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
1277	fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
1278	ma1, qcondc1)
1279	END IF
1280
1281	END IF ! ncum>0
1282
1283	! print *, 'fin cv_driver ->' !jyg
1284	RETURN
1285	END SUBROUTINE cv_driver
1286
1287	! ==================================================================
1288	SUBROUTINE cv_flag(iflag_ice_thermo)
1289	IMPLICIT NONE
1290
1291	! Argument : iflag_ice_thermo : ice thermodynamics is taken into account if
1292	! iflag_ice_thermo >=1
1293	INTEGER iflag_ice_thermo
1294
1295	include "cvflag.h"
1296
1297	! -- si .TRUE., on rend la gravite plus explicite et eventuellement
1298	! differente de 10.0 dans convect3:
1299	cvflag_grav = .TRUE.
1300	cvflag_ice = iflag_ice_thermo >= 1
1301
1302	RETURN
1303	END SUBROUTINE cv_flag
1304
1305	! ==================================================================
1306	SUBROUTINE cv_thermo(iflag_con)
1307	IMPLICIT NONE
1308
1309	! -------------------------------------------------------------
1310	! Set thermodynamical constants for convectL
1311	! -------------------------------------------------------------
1312
1313	include "YOMCST.h"
1314	include "cvthermo.h"
1315
1316	INTEGER iflag_con
1317
1318
1319	! original set from convect:
1320	IF (iflag_con==4) THEN
1321	cpd = 1005.7
1322	cpv = 1870.0
1323	cl = 4190.0
1324	rrv = 461.5
1325	rrd = 287.04
1326	lv0 = 2.501E6
1327	g = 9.8
1328	t0 = 273.15
1329	grav = g
1330	ELSE
1331
1332	! constants consistent with LMDZ:
1333	cpd = rcpd
1334	cpv = rcpv
1335	cl = rcw
1336	ci = rcs
1337	rrv = rv
1338	rrd = rd
1339	lv0 = rlvtt
1340	lf0 = rlstt - rlvtt
1341	g = rg ! not used in convect3
1342	! ori t0 = RTT
1343	t0 = 273.15 ! convect3 (RTT=273.16)
1344	! maf grav= 10. ! implicitely or explicitely used in convect3
1345	grav = g ! implicitely or explicitely used in convect3
1346	END IF
1347
1348	rowl = 1000.0 !(a quelle variable de YOMCST cela correspond-il?)
1349
1350	clmcpv = cl - cpv
1351	clmcpd = cl - cpd
1352	clmci = cl - ci
1353	cpdmcp = cpd - cpv
1354	cpvmcpd = cpv - cpd
1355	cpvmcl = cl - cpv ! for convect3
1356	eps = rrd/rrv
1357	epsi = 1.0/eps
1358	epsim1 = epsi - 1.0
1359	! ginv=1.0/g
1360	ginv = 1.0/grav
1361	hrd = 0.5*rrd
1362
1363	RETURN
1364	END SUBROUTINE cv_thermo

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

Download in other formats:

Original Format