Context Navigation

calltherm.F90 @ 1139

Last change on this file since 1139 was 1139, checked in by idelkadi, 16 years ago
Correction bug (gravite=10) dans le schema de convection : cv3_routines Utilisation du meme seuil dans calltherm et wake pour la vapeur d eau
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 11.8 KB

Line
1	!
2	! $Header$
3	!
4	subroutine calltherm(dtime &
5	& ,pplay,paprs,pphi,weak_inversion &
6	& ,u_seri,v_seri,t_seri,q_seri,zqsat,debut &
7	& ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
8	& ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth, &
9	& ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
10	& zmax0,f0,zw2,fraca)
11
12	USE dimphy
13	implicit none
14	#include "dimensions.h"
15	!#include "dimphy.h"
16	#include "thermcell.h"
17	#include "iniprint.h"
18
19	! A inclure eventuellement dans les fichiers de configuration
20	data r_aspect_thermals,l_mix_thermals/2.,30./
21	data w2di_thermals/1/
22
23	!IM 140508
24	INTEGER itap
25	REAL dtime
26	LOGICAL debut
27	LOGICAL logexpr0, logexpr2(klon,klev), logexpr1(klon)
28	REAL fact(klon)
29	INTEGER nbptspb
30
31	REAL u_seri(klon,klev),v_seri(klon,klev)
32	REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev)
33	REAL weak_inversion(klon)
34	REAL paprs(klon,klev+1)
35	REAL pplay(klon,klev)
36	REAL pphi(klon,klev)
37	real zlev(klon,klev+1)
38	!test: on sort lentr et a* pour alimenter KE
39	REAL wght_th(klon,klev)
40	INTEGER lalim_conv(klon)
41	REAL zw2(klon,klev+1),fraca(klon,klev+1)
42
43	!FH Update Thermiques
44	REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
45	REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
46	real fm_therm(klon,klev+1)
47	real entr_therm(klon,klev),detr_therm(klon,klev)
48
49	!********************************************************
50	! declarations
51	real fmc_therm(klon,klev+1),zqasc(klon,klev)
52	real zqla(klon,klev)
53	real zqta(klon,klev)
54	real wmax_sec(klon)
55	real zmax_sec(klon)
56	real f_sec(klon)
57	real detrc_therm(klon,klev)
58	! FH WARNING : il semble que ces save ne servent a rien
59	! save fmc_therm, detrc_therm
60	real clwcon0(klon,klev)
61	real zqsat(klon,klev)
62	real zw_sec(klon,klev+1)
63	integer lmix_sec(klon)
64	integer lmax(klon)
65	real ratqscth(klon,klev)
66	real ratqsdiff(klon,klev)
67	real zqsatth(klon,klev)
68	!nouvelles variables pour la convection
69	real Ale_bl(klon)
70	real Alp_bl(klon)
71	real Ale(klon)
72	real Alp(klon)
73	!RC
74	!on garde le zmax du pas de temps precedent
75	real zmax0(klon), f0(klon)
76	!********************************************************
77
78
79	! variables locales
80	REAL d_t_the(klon,klev), d_q_the(klon,klev)
81	REAL d_u_the(klon,klev),d_v_the(klon,klev)
82	!
83	real zfm_therm(klon,klev+1),zdt
84	real zentr_therm(klon,klev),zdetr_therm(klon,klev)
85	! FH A VERIFIER : SAVE INUTILES
86	! save zentr_therm,zfm_therm
87
88	integer i,k
89	logical, save :: first=.true.
90	!$OMP THREADPRIVATE(first)
91	!********************************************************
92	if (first) then
93	itap=0
94	first=.false.
95	endif
96
97	! Incrementer le compteur de la physique
98	itap = itap + 1
99
100	! Modele du thermique
101	! ===================
102	! print*,'thermiques: WARNING on passe t au lieu de t_seri'
103
104
105	! On prend comme valeur initiale des thermiques la valeur du pas
106	! de temps precedent
107	zfm_therm(:,:)=fm_therm(:,:)
108	zdetr_therm(:,:)=detr_therm(:,:)
109	zentr_therm(:,:)=entr_therm(:,:)
110
111	! On reinitialise les flux de masse a zero pour le cumul en
112	! cas de splitting
113	fm_therm(:,:)=0.
114	entr_therm(:,:)=0.
115	detr_therm(:,:)=0.
116
117	Ale_bl(:)=0.
118	Alp_bl(:)=0.
119	if (prt_level.ge.10) then
120	print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
121	endif
122
123	! tests sur les valeurs negatives de l'eau
124	logexpr0=prt_level.ge.10
125	nbptspb=0
126	do k=1,klev
127	do i=1,klon
128	! Attention teste abderr 19-03-09
129	! logexpr2(i,k)=.not.q_seri(i,k).ge.0.
130	logexpr2(i,k)=.not.q_seri(i,k).ge.1.e-15
131	if (logexpr2(i,k)) then
132	q_seri(i,k)=1.e-15
133	nbptspb=nbptspb+1
134	endif
135	! if (logexpr0) &
136	! & print*,'WARN eau<0 avant therm i=',i,' k=',k &
137	! & ,' dq,q',d_q_the(i,k),q_seri(i,k)
138	enddo
139	enddo
140	if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb
141
142	zdt=dtime/float(nsplit_thermals)
143	do isplit=1,nsplit_thermals
144
145	if (iflag_thermals.eq.1) then
146	CALL thermcell_2002(klon,klev,zdt &
147	& ,pplay,paprs,pphi &
148	& ,u_seri,v_seri,t_seri,q_seri &
149	& ,d_u_the,d_v_the,d_t_the,d_q_the &
150	& ,zfm_therm,zentr_therm &
151	& ,r_aspect_thermals,30.,w2di_thermals &
152	& ,tau_thermals,3)
153	else if (iflag_thermals.eq.2) then
154	CALL thermcell_sec(klon,klev,zdt &
155	& ,pplay,paprs,pphi,zlev &
156	& ,u_seri,v_seri,t_seri,q_seri &
157	& ,d_u_the,d_v_the,d_t_the,d_q_the &
158	& ,zfm_therm,zentr_therm &
159	& ,r_aspect_thermals,30.,w2di_thermals &
160	& ,tau_thermals,3)
161	else if (iflag_thermals.eq.3) then
162	CALL thermcell(klon,klev,zdt &
163	& ,pplay,paprs,pphi &
164	& ,u_seri,v_seri,t_seri,q_seri &
165	& ,d_u_the,d_v_the,d_t_the,d_q_the &
166	& ,zfm_therm,zentr_therm &
167	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
168	& ,tau_thermals,3)
169	else if (iflag_thermals.eq.10) then
170	CALL thermcell_eau(klon,klev,zdt &
171	& ,pplay,paprs,pphi &
172	& ,u_seri,v_seri,t_seri,q_seri &
173	& ,d_u_the,d_v_the,d_t_the,d_q_the &
174	& ,zfm_therm,zentr_therm &
175	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
176	& ,tau_thermals,3)
177	else if (iflag_thermals.eq.11) then
178	stop'cas non prevu dans calltherm'
179	! CALL thermcell_pluie(klon,klev,zdt &
180	! & ,pplay,paprs,pphi,zlev &
181	! & ,u_seri,v_seri,t_seri,q_seri &
182	! & ,d_u_the,d_v_the,d_t_the,d_q_the &
183	! & ,zfm_therm,zentr_therm,zqla &
184	! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
185	! & ,tau_thermals,3)
186	else if (iflag_thermals.eq.12) then
187	CALL calcul_sec(klon,klev,zdt &
188	& ,pplay,paprs,pphi,zlev &
189	& ,u_seri,v_seri,t_seri,q_seri &
190	& ,zmax_sec,wmax_sec,zw_sec,lmix_sec &
191	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
192	& ,tau_thermals)
193	else if (iflag_thermals.ge.13) then
194	CALL thermcell_main(itap,klon,klev,zdt &
195	& ,pplay,paprs,pphi,debut &
196	& ,u_seri,v_seri,t_seri,q_seri &
197	& ,d_u_the,d_v_the,d_t_the,d_q_the &
198	& ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax &
199	& ,ratqscth,ratqsdiff,zqsatth &
200	& ,r_aspect_thermals,l_mix_thermals &
201	& ,tau_thermals,Ale,Alp,lalim_conv,wght_th &
202	& ,zmax0,f0,zw2,fraca)
203	endif
204
205
206	fact(:)=0.
207	DO i=1,klon
208	logexpr1(i)=iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5
209	IF(logexpr1(i)) fact(i)=1./float(nsplit_thermals)
210	ENDDO
211
212	DO k=1,klev
213	! transformation de la derivee en tendance
214	d_t_the(:,k)=d_t_the(:,k)dtimefact(:)
215	d_u_the(:,k)=d_u_the(:,k)dtimefact(:)
216	d_v_the(:,k)=d_v_the(:,k)dtimefact(:)
217	d_q_the(:,k)=d_q_the(:,k)dtimefact(:)
218	fm_therm(:,k)=fm_therm(:,k) &
219	& +zfm_therm(:,k)*fact(:)
220	entr_therm(:,k)=entr_therm(:,k) &
221	& +zentr_therm(:,k)*fact(:)
222	detr_therm(:,k)=detr_therm(:,k) &
223	& +zdetr_therm(:,k)*fact(:)
224	ENDDO
225	fm_therm(:,klev+1)=0.
226
227
228
229	! accumulation de la tendance
230	d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:)
231	d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:)
232	d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
233	d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)
234
235	! incrementation des variables meteo
236	t_seri(:,:) = t_seri(:,:) + d_t_the(:,:)
237	u_seri(:,:) = u_seri(:,:) + d_u_the(:,:)
238	v_seri(:,:) = v_seri(:,:) + d_v_the(:,:)
239	qmemoire(:,:)=q_seri(:,:)
240	q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
241
242	DO i=1,klon
243	if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)
244	fm_therm(i,klev+1)=0.
245	Ale_bl(i)=Ale_bl(i)+Ale(i)/float(nsplit_thermals)
246	! write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i)
247	Alp_bl(i)=Alp_bl(i)+Alp(i)/float(nsplit_thermals)
248	! write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
249	ENDDO
250
251	!IM 060508 marche pas comme cela !!! enddo ! isplit
252
253	! tests sur les valeurs negatives de l'eau
254	nbptspb=0
255	DO k = 1, klev
256	DO i = 1, klon
257	logexpr2(i,k)=.not.q_seri(i,k).ge.0.
258	if (logexpr2(i,k)) then
259	q_seri(i,k)=1.e-15
260	nbptspb=nbptspb+1
261	! if (prt_level.ge.10) then
262	! print*,'WARN eau<0 apres therm i=',i,' k=',k &
263	! & ,' dq,q',d_q_the(i,k),q_seri(i,k), &
264	! & 'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k)
265	endif
266	! stop
267	ENDDO
268	ENDDO
269	IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb
270	! tests sur les valeurs de la temperature
271	nbptspb=0
272	DO k = 1, klev
273	DO i = 1, klon
274	logexpr2(i,k)=t_seri(i,k).lt.50..or.t_seri(i,k).gt.370.
275	if (logexpr2(i,k)) nbptspb=nbptspb+1
276	! if ((t_seri(i,k).lt.50.) .or. &
277	! & (t_seri(i,k).gt.370.)) then
278	! print*,'WARN temp apres therm i=',i,' k=',k &
279	! & ,' t_seri',t_seri(i,k)
280	! CALL abort
281	! endif
282	ENDDO
283	ENDDO
284	IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb
285	enddo ! isplit
286
287	!
288	!***************************************************************
289	! calcul du flux ascencant conservatif
290	! print*,'<<<<calcul flux ascendant conservatif'
291
292	fmc_therm=0.
293	do k=1,klev
294	do i=1,klon
295	if (entr_therm(i,k).gt.0.) then
296	fmc_therm(i,k+1)=fmc_therm(i,k)+entr_therm(i,k)
297	else
298	fmc_therm(i,k+1)=fmc_therm(i,k)
299	endif
300	detrc_therm(i,k)=(fmc_therm(i,k+1)-fm_therm(i,k+1)) &
301	& -(fmc_therm(i,k)-fm_therm(i,k))
302	enddo
303	enddo
304
305
306	!****************************************************************
307	! calcul de l'humidite dans l'ascendance
308	! print*,'<<<<calcul de lhumidite dans thermique'
309	!CR:on ne le calcule que pour le cas sec
310	if (iflag_thermals.le.11) then
311	do i=1,klon
312	zqasc(i,1)=q_seri(i,1)
313	do k=2,klev
314	if (fmc_therm(i,k+1).gt.1.e-6) then
315	zqasc(i,k)=(fmc_therm(i,k)*zqasc(i,k-1) &
316	& +entr_therm(i,k)*q_seri(i,k))/fmc_therm(i,k+1)
317	!CR:test on asseche le thermique
318	! zqasc(i,k)=zqasc(i,k)/2.
319	! else
320	! zqasc(i,k)=q_seri(i,k)
321	endif
322	enddo
323	enddo
324
325
326	! calcul de l'eau condensee dans l'ascendance
327	! print*,'<<<<calcul de leau condensee dans thermique'
328	do i=1,klon
329	do k=1,klev
330	clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
331	if (clwcon0(i,k).lt.0. .or. &
332	& (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
333	clwcon0(i,k)=0.
334	endif
335	enddo
336	enddo
337	else
338	do i=1,klon
339	do k=1,klev
340	clwcon0(i,k)=zqla(i,k)
341	if (clwcon0(i,k).lt.0. .or. &
342	& (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
343	clwcon0(i,k)=0.
344	endif
345	enddo
346	enddo
347	endif
348	!*******************************************************************
349
350
351	return
352
353	end

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

Download in other formats:

Original Format