Context Navigation

concvl.F90 @ 5423

Last change on this file since 5423 was 3496, checked in by jyg, 6 years ago

Implementation of the ejection of liquid precipitation from the adiabatic ascents.
New flags:
+cvflag_prec_eject: logical

n -> old code, y -> new code

+ejectliq: real; possible values 0. & 1.

-> no liquid precipitation is ejected
-> all liquid precipitation is ejected

+ejectice: real; any value between 0. and 1.

fraction of solid precipitation ejected at each level

Note that the adiabatic ascent mass flux decrease due to precipitation ejection is not taken into account.

Attempts to do it led to water conservation violation.

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

Line
1	SUBROUTINE concvl(iflag_clos, &
2	dtime, paprs, pplay, k_upper_cv, &
3	t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
4	Ale, Alp, sig1, w01, &
5	d_t, d_q, d_u, d_v, d_tra, &
6	rain, snow, kbas, ktop, sigd, &
7	cbmf, plcl, plfc, wbeff, convoccur, &
8	upwd, dnwd, dnwdbis, &
9	Ma, mip, Vprecip, &
10	cape, cin, tvp, Tconv, iflag, &
11	pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
12	qcondc, wd, pmflxr, pmflxs, &
13	!RomP >>>
14	!! . da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
15	da, phi, mp, phii, d1a, dam, sij, qta, clw, elij, &! RomP
16	dd_t, dd_q, lalim_conv, wght_th, & ! RomP
17	evap, ep, epmlmMm, eplaMm, & ! RomP
18	wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, &
19	tau_cld_cv, coefw_cld_cv, & ! RomP+RL, AJ
20	!RomP <<<
21	epmax_diag) ! epmax_cape
22	! **************************************************************
23	! *
24	! CONCVL *
25	! *
26	! *
27	! written by : Sandrine Bony-Lena, 17/05/2003, 11.16.04 *
28	! modified by : *
29	! **************************************************************
30
31
32	USE dimphy
33	USE infotrac_phy, ONLY: nbtr
34	USE phys_local_var_mod, ONLY: omega
35	USE print_control_mod, ONLY: prt_level, lunout
36	IMPLICIT NONE
37	! ======================================================================
38	! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
39	! Objet: schema de convection de Emanuel (1991) interface
40	! ======================================================================
41	! Arguments:
42	! dtime--input-R-pas d'integration (s)
43	! s-------input-R-la vAleur "s" pour chaque couche
44	! sigs----input-R-la vAleur "sigma" de chaque couche
45	! sig-----input-R-la vAleur de "sigma" pour chaque niveau
46	! psolpa--input-R-la pression au sol (en Pa)
47	! pskapa--input-R-exponentiel kappa de psolpa
48	! h-------input-R-enthAlpie potentielle (CpT/P*kappa)
49	! q-------input-R-vapeur d'eau (en kg/kg)
50
51	! work*: input et output: deux variables de travail,
52	! on peut les mettre a 0 au debut
53	! ALE--------input-R-energie disponible pour soulevement
54	! ALP--------input-R-puissance disponible pour soulevement
55
56	! d_h--------output-R-increment de l'enthAlpie potentielle (h)
57	! d_q--------output-R-increment de la vapeur d'eau
58	! rain-------output-R-la pluie (mm/s)
59	! snow-------output-R-la neige (mm/s)
60	! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
61	! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
62	! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
63	! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
64	! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
65	! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s)
66	! Tconv------output-R-environment temperature seen by convective scheme (K)
67	! Cape-------output-R-CAPE (J/kg)
68	! Cin -------output-R-CIN (J/kg)
69	! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
70	! adiabatiquement a partir du niveau 1 (K)
71	! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
72	! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
73	! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
74	! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
75	! lalim_conv-
76	! wght_th----
77	! evap-------output-R
78	! ep---------output-R
79	! epmlmMm----output-R
80	! eplaMm-----output-R
81	! wdtrainA---output-R
82	! wdtrainS---output-R
83	! wdtrainM---output-R
84	! wght-------output-R
85	! ======================================================================
86
87
88	include "clesphys.h"
89
90	INTEGER, INTENT(IN) :: iflag_clos
91	REAL, INTENT(IN) :: dtime
92	REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay
93	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
94	INTEGER, INTENT(IN) :: k_upper_cv
95	REAL, DIMENSION(klon,klev), INTENT(IN) :: t, q, u, v
96	REAL, DIMENSION(klon,klev), INTENT(IN) :: t_wake, q_wake
97	REAL, DIMENSION(klon), INTENT(IN) :: s_wake
98	REAL, DIMENSION(klon,klev, nbtr),INTENT(IN) :: tra
99	INTEGER, INTENT(IN) :: ntra
100	REAL, DIMENSION(klon), INTENT(IN) :: Ale, Alp
101	!CR:test: on passe lentr et alim_star des thermiques
102	INTEGER, DIMENSION(klon), INTENT(IN) :: lalim_conv
103	REAL, DIMENSION(klon,klev), INTENT(IN) :: wght_th
104
105	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: sig1, w01
106
107	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t, d_q, d_u, d_v
108	REAL, DIMENSION(klon,klev, nbtr),INTENT(OUT) :: d_tra
109	REAL, DIMENSION(klon), INTENT(OUT) :: rain, snow
110
111	INTEGER, DIMENSION(klon), INTENT(OUT) :: kbas, ktop
112	REAL, DIMENSION(klon), INTENT(OUT) :: sigd
113	REAL, DIMENSION(klon), INTENT(OUT) :: cbmf, plcl, plfc, wbeff
114	REAL, DIMENSION(klon), INTENT(OUT) :: convoccur
115	REAL, DIMENSION(klon,klev), INTENT(OUT) :: upwd, dnwd, dnwdbis
116
117	!! REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev) !jyg
118	REAL, DIMENSION(klon,klev), INTENT(OUT) :: Ma, mip
119	REAL, DIMENSION(klon,klev+1), INTENT(OUT) :: Vprecip !jyg
120	REAL, DIMENSION(klon), INTENT(OUT) :: cape, cin
121	REAL, DIMENSION(klon,klev), INTENT(OUT) :: tvp
122	REAL, DIMENSION(klon,klev), INTENT(OUT) :: Tconv
123	INTEGER, DIMENSION(klon), INTENT(OUT) :: iflag
124	REAL, DIMENSION(klon), INTENT(OUT) :: pbase, bbase
125	REAL, DIMENSION(klon,klev), INTENT(OUT) :: dtvpdt1, dtvpdq1
126	REAL, DIMENSION(klon), INTENT(OUT) :: dplcldt, dplcldr
127	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qcondc
128	REAL, DIMENSION(klon), INTENT(OUT) :: wd
129	REAL, DIMENSION(klon,klev+1), INTENT(OUT) :: pmflxr, pmflxs
130
131	REAL, DIMENSION(klon,klev), INTENT(OUT) :: da, mp
132	REAL, DIMENSION(klon,klev,klev),INTENT(OUT) :: phi
133	! RomP >>>
134	REAL, DIMENSION(klon,klev,klev),INTENT(OUT) :: phii
135	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d1a, dam
136	REAL, DIMENSION(klon,klev,klev),INTENT(OUT) :: sij, elij
137	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qta
138	REAL, DIMENSION(klon,klev), INTENT(OUT) :: clw
139	REAL, DIMENSION(klon,klev), INTENT(OUT) :: dd_t, dd_q
140	REAL, DIMENSION(klon,klev), INTENT(OUT) :: evap, ep
141	REAL, DIMENSION(klon,klev), INTENT(OUT) :: eplaMm
142	REAL, DIMENSION(klon,klev,klev), INTENT(OUT) :: epmlmMm
143	REAL, DIMENSION(klon,klev), INTENT(OUT) :: wdtrainA, wdtrainS, wdtrainM
144	! RomP <<<
145	REAL, DIMENSION(klon,klev), INTENT(OUT) :: wght !RL
146	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qtc
147	REAL, DIMENSION(klon,klev), INTENT(OUT) :: sigt
148	REAL, INTENT(OUT) :: tau_cld_cv, coefw_cld_cv
149	REAL, DIMENSION(klon), INTENT(OUT) :: epmax_diag ! epmax_cape
150
151	!
152	! Local
153	! ----
154	REAL, DIMENSION(klon,klev) :: em_p
155	REAL, DIMENSION(klon,klev+1) :: em_ph
156	REAL :: em_sig1feed ! sigma at lower bound of feeding layer
157	REAL :: em_sig2feed ! sigma at upper bound of feeding layer
158	REAL, DIMENSION(klev) :: em_wght ! weight density determining the feeding mixture
159	REAL, DIMENSION(klon,klev+1) :: Vprecipi !jyg
160	!on enleve le save
161	! SAVE em_sig1feed,em_sig2feed,em_wght
162
163	REAL, DIMENSION(klon) :: rflag
164	REAL, DIMENSION(klon) :: plim1, plim2
165	REAL, DIMENSION(klon) :: ptop2
166	REAL, DIMENSION(klon,klev) :: asupmax
167	REAL, DIMENSION(klon) :: supmax0, asupmaxmin
168	REAL :: zx_t, zdelta, zx_qs, zcor
169	!
170	! INTEGER iflag_mix
171	! SAVE iflag_mix
172	INTEGER :: noff, minorig
173	INTEGER :: i,j, k, itra
174	REAL, DIMENSION(klon,klev) :: qs, qs_wake
175	!LF SAVE cbmf
176	!IM/JYG REAL, SAVE, ALLOCATABLE :: cbmf(:)
177	!!!$OMP THREADPRIVATE(cbmf)!
178	REAL, DIMENSION(klon) :: cbmflast
179
180
181	! Variables supplementaires liees au bilan d'energie
182	! Real paire(klon)
183	!LF Real ql(klon,klev)
184	! Save paire
185	!LF Save ql
186	!LF Real t1(klon,klev),q1(klon,klev)
187	!LF Save t1,q1
188	! Data paire /1./
189	REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
190	!$OMP THREADPRIVATE(ql, q1, t1)
191
192	! Variables liees au bilan d'energie et d'enthAlpi
193	REAL ztsol(klon)
194	REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
195	h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
196	SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
197	h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
198	!$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
199	!$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
200	REAL d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
201	REAL d_h_vcol_phy
202	REAL fs_bound, fq_bound
203	SAVE d_h_vcol_phy
204	!$OMP THREADPRIVATE(d_h_vcol_phy)
205	REAL zero_v(klon)
206	CHARACTER *15 ztit
207	INTEGER ip_ebil ! PRINT level for energy conserv. diag.
208	SAVE ip_ebil
209	DATA ip_ebil/2/
210	!$OMP THREADPRIVATE(ip_ebil)
211	INTEGER if_ebil ! level for energy conserv. dignostics
212	SAVE if_ebil
213	DATA if_ebil/2/
214	!$OMP THREADPRIVATE(if_ebil)
215	!+jld ec_conser
216	REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
217	REAL zrcpd
218	!-jld ec_conser
219	!LF
220	INTEGER nloc
221	LOGICAL, SAVE :: first = .TRUE.
222	!$OMP THREADPRIVATE(first)
223	INTEGER, SAVE :: itap, igout
224	!$OMP THREADPRIVATE(itap, igout)
225
226
227	include "YOMCST.h"
228	include "YOMCST2.h"
229	include "YOETHF.h"
230	include "FCTTRE.h"
231	!jyg<
232	include "conema3.h"
233	!>jyg
234
235	IF (first) THEN
236	! Allocate some variables LF 04/2008
237
238	!IM/JYG allocate(cbmf(klon))
239	ALLOCATE (ql(klon,klev))
240	ALLOCATE (t1(klon,klev))
241	ALLOCATE (q1(klon,klev))
242	!
243	convoccur(:) = 0.
244	!
245	itap = 0
246	igout = klon/2 + 1/klon
247	END IF
248	! Incrementer le compteur de la physique
249	itap = itap + 1
250
251	! Copy T into Tconv
252	DO k = 1, klev
253	DO i = 1, klon
254	Tconv(i, k) = t(i, k)
255	END DO
256	END DO
257
258	IF (if_ebil>=1) THEN
259	DO i = 1, klon
260	ztsol(i) = t(i, 1)
261	zero_v(i) = 0.
262	DO k = 1, klev
263	ql(i, k) = 0.
264	END DO
265	END DO
266	END IF
267
268	! ym
269	snow(:) = 0
270
271	IF (first) THEN
272	first = .FALSE.
273
274	! ===========================================================================
275	! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
276	! ===========================================================================
277
278	IF (iflag_con==3) THEN
279	! CALL cv3_inicp()
280	CALL cv3_inip()
281	END IF
282
283	! ===========================================================================
284	! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
285	! ===========================================================================
286
287	! c$$$ open (56,file='supcrit.data')
288	! c$$$ read (56,*) Supcrit1, Supcrit2
289	! c$$$ close (56)
290
291	IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
292
293	! ===========================================================================
294	! Initialisation pour les bilans d'eau et d'energie
295	! ===========================================================================
296	IF (if_ebil>=1) d_h_vcol_phy = 0.
297
298	DO i = 1, klon
299	cbmf(i) = 0.
300	!! plcl(i) = 0.
301	sigd(i) = 0.
302	END DO
303	END IF !(first)
304
305	! Initialisation a chaque pas de temps
306	plfc(:) = 0.
307	wbeff(:) = 100.
308	plcl(:) = 0.
309
310	DO k = 1, klev + 1
311	DO i = 1, klon
312	em_ph(i, k) = paprs(i, k)/100.0
313	pmflxr(i, k) = 0.
314	pmflxs(i, k) = 0.
315	END DO
316	END DO
317
318	DO k = 1, klev
319	DO i = 1, klon
320	em_p(i, k) = pplay(i, k)/100.0
321	END DO
322	END DO
323
324
325	! Feeding layer
326
327	em_sig1feed = 1.
328	!jyg<
329	! em_sig2feed = 0.97
330	em_sig2feed = cvl_sig2feed
331	!>jyg
332	! em_sig2feed = 0.8
333	! Relative Weight densities
334	DO k = 1, klev
335	em_wght(k) = 1.
336	END DO
337	!CRtest: couche alim des tehrmiques ponderee par a*
338	! DO i = 1, klon
339	! do k=1,lalim_conv(i)
340	! em_wght(k)=wght_th(i,k)
341	! print*,'em_wght=',em_wght(k),wght_th(i,k)
342	! end do
343	! END DO
344
345	IF (iflag_con==4) THEN
346	DO k = 1, klev
347	DO i = 1, klon
348	zx_t = t(i, k)
349	zdelta = max(0., sign(1.,rtt-zx_t))
350	zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
351	zcor = 1./(1.-retv*zx_qs)
352	qs(i, k) = zx_qs*zcor
353	END DO
354	DO i = 1, klon
355	zx_t = t_wake(i, k)
356	zdelta = max(0., sign(1.,rtt-zx_t))
357	zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
358	zcor = 1./(1.-retv*zx_qs)
359	qs_wake(i, k) = zx_qs*zcor
360	END DO
361	END DO
362	ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
363	DO k = 1, klev
364	DO i = 1, klon
365	zx_t = t(i, k)
366	zdelta = max(0., sign(1.,rtt-zx_t))
367	zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
368	zx_qs = min(0.5, zx_qs)
369	zcor = 1./(1.-retv*zx_qs)
370	zx_qs = zx_qs*zcor
371	qs(i, k) = zx_qs
372	END DO
373	DO i = 1, klon
374	zx_t = t_wake(i, k)
375	zdelta = max(0., sign(1.,rtt-zx_t))
376	zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
377	zx_qs = min(0.5, zx_qs)
378	zcor = 1./(1.-retv*zx_qs)
379	zx_qs = zx_qs*zcor
380	qs_wake(i, k) = zx_qs
381	END DO
382	END DO
383	END IF ! iflag_con
384
385	! ------------------------------------------------------------------
386
387	! Main driver for convection:
388	! iflag_con=3 -> nvlle version de KE (JYG)
389	! iflag_con = 30 -> equivAlent to convect3
390	! iflag_con = 4 -> equivAlent to convect1/2
391
392
393	IF (iflag_con==30) THEN
394
395	! print *, '-> cv_driver' !jyg
396	CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
397	t, q, qs, u, v, tra, &
398	em_p, em_ph, iflag, &
399	d_t, d_q, d_u, d_v, d_tra, rain, &
400	Vprecip, cbmf, sig1, w01, & !jyg
401	kbas, ktop, &
402	dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
403	da, phi, mp, phii, d1a, dam, sij, clw, elij, & !RomP
404	evap, ep, epmlmMm, eplaMm, & !RomP
405	wdtrainA, wdtrainM, & !RomP
406	epmax_diag) ! epmax_cape
407	! print *, 'cv_driver ->' !jyg
408
409	DO i = 1, klon
410	cbmf(i) = Ma(i, kbas(i))
411	END DO
412
413	!RL
414	wght(:, :) = 0.
415	DO i = 1, klon
416	wght(i, 1) = 1.
417	END DO
418	!RL
419
420	ELSE
421
422	!LF necessary for gathered fields
423	nloc = klon
424	CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
425	iflag_con, iflag_mix, iflag_ice_thermo, &
426	iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
427	t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
428	em_p, em_ph, &
429	Ale, Alp, omega, &
430	em_sig1feed, em_sig2feed, em_wght, &
431	iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, &
432	cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
433	Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
434	cape, cin, tvp, &
435	dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
436	asupmaxmin, lalim_conv, &
437	!AC!+!RomP+jyg
438	!! da,phi,mp,phii,d1a,dam,sij,clw,elij, & ! RomP
439	!! evap,ep,epmlmMm,eplaMm, ! RomP
440	da, phi, mp, phii, d1a, dam, sij, wght, & ! RomP+RL
441	qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP+RL
442	wdtrainA, wdtrainS, wdtrainM, qtc, sigt, &
443	tau_cld_cv, coefw_cld_cv, & ! RomP,AJ
444	!AC!+!RomP+jyg
445	epmax_diag) ! epmax_cape
446	END IF
447	! ------------------------------------------------------------------
448	IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff, d_t, d_q ', &
449	cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1,1), d_q(1,1)
450
451	DO i = 1, klon
452	rain(i) = rain(i)/86400.
453	rflag(i) = iflag(i)
454	END DO
455
456	DO k = 1, klev
457	DO i = 1, klon
458	d_t(i, k) = dtime*d_t(i, k)
459	d_q(i, k) = dtime*d_q(i, k)
460	d_u(i, k) = dtime*d_u(i, k)
461	d_v(i, k) = dtime*d_v(i, k)
462	END DO
463	END DO
464
465	IF (iflag_con==3) THEN
466	DO i = 1,klon
467	IF (wbeff(i) > 100. .OR. wbeff(i) == 0 .OR. iflag(i) > 3) THEN
468	wbeff(i) = 0.
469	convoccur(i) = 0.
470	ELSE
471	convoccur(i) = 1.
472	ENDIF
473	ENDDO
474	ENDIF
475
476	IF (iflag_con==30) THEN
477	DO itra = 1, ntra
478	DO k = 1, klev
479	DO i = 1, klon
480	!RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
481	d_tra(i, k, itra) = 0.
482	END DO
483	END DO
484	END DO
485	END IF
486
487	!!AC!
488	IF (iflag_con==3) THEN
489	DO itra = 1, ntra
490	DO k = 1, klev
491	DO i = 1, klon
492	!RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
493	d_tra(i, k, itra) = 0.
494	END DO
495	END DO
496	END DO
497	END IF
498	!!AC!
499
500	DO k = 1, klev
501	DO i = 1, klon
502	t1(i, k) = t(i, k) + d_t(i, k)
503	q1(i, k) = q(i, k) + d_q(i, k)
504	END DO
505	END DO
506	! !jyg
507	IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN
508	! --Separation neige/pluie (pour diagnostics) !jyg
509	DO k = 1, klev !jyg
510	DO i = 1, klon !jyg
511	IF (t1(i,k)<rtt) THEN !jyg
512	pmflxs(i, k) = Vprecip(i, k) !jyg
513	ELSE !jyg
514	pmflxr(i, k) = Vprecip(i, k) !jyg
515	END IF !jyg
516	END DO !jyg
517	END DO !jyg
518	ELSE
519	DO k = 1, klev !jyg
520	DO i = 1, klon !jyg
521	pmflxs(i, k) = Vprecipi(i, k) !jyg
522	pmflxr(i, k) = Vprecip(i, k)-Vprecipi(i, k) !jyg
523	END DO !jyg
524	END DO !jyg
525	ENDIF
526
527	! c IF (if_ebil.ge.2) THEN
528	! c ztit='after convect'
529	! c CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
530	! c e , t1,q1,ql,qs,u,v,paprs,pplay
531	! c s , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
532	! c call diagphy(paire,ztit,ip_ebil
533	! c e , zero_v, zero_v, zero_v, zero_v, zero_v
534	! c e , zero_v, rain, zero_v, ztsol
535	! c e , d_h_vcol, d_qt, d_ec
536	! c s , fs_bound, fq_bound )
537	! c END IF
538
539
540	! les traceurs ne sont pas mis dans cette version de convect4:
541	IF (iflag_con==4) THEN
542	DO itra = 1, ntra
543	DO k = 1, klev
544	DO i = 1, klon
545	d_tra(i, k, itra) = 0.
546	END DO
547	END DO
548	END DO
549	END IF
550	! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
551
552	DO k = 1, klev
553	DO i = 1, klon
554	dtvpdt1(i, k) = 0.
555	dtvpdq1(i, k) = 0.
556	END DO
557	END DO
558	DO i = 1, klon
559	dplcldt(i) = 0.
560	dplcldr(i) = 0.
561	END DO
562
563	IF (prt_level>=20) THEN
564	DO k = 1, klev
565	! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
566	! k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
567	! d_q_con(igout,k),dql0(igout,k)
568	! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
569	! itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
570	! t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
571	! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
572	! itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
573	! ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
574	! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
575	! itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
576	! tvp(igout,k),Tconv(igout,k)
577	! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
578	! itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
579	! dplcldr(igout),qcondc(igout,k)
580	! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
581	! itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
582	! pmflxs(igout,k+1)
583	! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
584	! itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
585	! fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
586	END DO
587	END IF !(prt_level.EQ.20) THEN
588
589	RETURN
590	END SUBROUTINE concvl
591

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

Download in other formats:

Original Format