Context Navigation

cv_driver.F90 @ 4004

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

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

Download in other formats:

Original Format