Context Navigation

calltherm.F90 @ 880

Last change on this file since 880 was 879, checked in by Laurent Fairhead, 16 years ago
Suite de la bascule vers une physique avec thermiques, nouvelle convection, poche froide ... LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 10.5 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,zqasc,clwcon0,lmax,ratqscth, &
9	& ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th)
10
11	implicit none
12	#include "dimensions.h"
13	#include "dimphy.h"
14	#include "thermcell.h"
15
16	! A inclure eventuellement dans les fichiers de configuration
17	data r_aspect_thermals,l_mix_thermals,tho_thermals/2.,30.,0./
18	data w2di_thermals/0/
19
20	REAL dtime
21	LOGICAL debut
22	REAL u_seri(klon,klev),v_seri(klon,klev)
23	REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev)
24	REAL weak_inversion(klon)
25	REAL paprs(klon,klev+1)
26	REAL pplay(klon,klev)
27	REAL pphi(klon,klev)
28	real zlev(klon,klev+1)
29	!test: on sort lentr et a* pour alimenter KE
30	REAL wght_th(klon,klev)
31	INTEGER lalim_conv(klon)
32
33	!FH Update Thermiques
34	REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
35	REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
36	real fm_therm(klon,klev+1),entr_therm(klon,klev)
37
38	!********************************************************
39	! declarations
40	real fmc_therm(klon,klev+1),zqasc(klon,klev)
41	real zqla(klon,klev)
42	real wmax_sec(klon)
43	real zmax_sec(klon)
44	real f_sec(klon)
45	real detrc_therm(klon,klev)
46	save fmc_therm, detrc_therm
47	real clwcon0(klon,klev)
48	real zqsat(klon,klev)
49	real zw_sec(klon,klev+1)
50	integer lmix_sec(klon)
51	integer lmax(klon)
52	real ratqscth(klon,klev)
53	real ratqsdiff(klon,klev)
54	real zqsatth(klon,klev)
55	!nouvelles variables pour la convection
56	real Ale_bl(klon)
57	real Alp_bl(klon)
58	real Ale(klon)
59	real Alp(klon)
60	!RC
61	!********************************************************
62
63
64	! variables locales
65	REAL d_t_the(klon,klev), d_q_the(klon,klev)
66	REAL d_u_the(klon,klev),d_v_the(klon,klev)
67	!
68	real zfm_therm(klon,klev+1),zentr_therm(klon,klev),zdt
69	save zentr_therm,zfm_therm
70
71	integer i,k
72
73	!********************************************************
74
75	! Modele du thermique
76	! ===================
77	! print*,'thermiques: WARNING on passe t au lieu de t_seri'
78
79
80	fm_therm(:,:)=0.
81	entr_therm(:,:)=0.
82	Ale_bl(:)=0.
83	Alp_bl(:)=0.
84	print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
85
86
87	! tests sur les valeurs negatives de l'eau
88	do k=1,klev
89	do i=1,klon
90	if (.not.q_seri(i,k).ge.0.) then
91	print*,'WARN eau<0 avant therm i=',i,' k=',k &
92	& ,' dq,q',d_q_the(i,k),q_seri(i,k)
93	q_seri(i,k)=1.e-15
94	endif
95	enddo
96	enddo
97
98
99	zdt=dtime/float(nsplit_thermals)
100	do isplit=1,nsplit_thermals
101
102	if (iflag_thermals.eq.1) then
103	CALL thermcell_2002(klon,klev,zdt &
104	& ,pplay,paprs,pphi &
105	& ,u_seri,v_seri,t_seri,q_seri &
106	& ,d_u_the,d_v_the,d_t_the,d_q_the &
107	& ,zfm_therm,zentr_therm &
108	& ,r_aspect_thermals,30.,w2di_thermals &
109	& ,tho_thermals,3)
110	else if (iflag_thermals.eq.2) then
111	CALL thermcell_sec(klon,klev,zdt &
112	& ,pplay,paprs,pphi,zlev &
113	& ,u_seri,v_seri,t_seri,q_seri &
114	& ,d_u_the,d_v_the,d_t_the,d_q_the &
115	& ,zfm_therm,zentr_therm &
116	& ,r_aspect_thermals,30.,w2di_thermals &
117	& ,tho_thermals,3)
118	else if (iflag_thermals.eq.3) then
119	CALL thermcell(klon,klev,zdt &
120	& ,pplay,paprs,pphi &
121	& ,u_seri,v_seri,t_seri,q_seri &
122	& ,d_u_the,d_v_the,d_t_the,d_q_the &
123	& ,zfm_therm,zentr_therm &
124	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
125	& ,tho_thermals,3)
126	else if (iflag_thermals.eq.10) then
127	CALL thermcell_eau(klon,klev,zdt &
128	& ,pplay,paprs,pphi &
129	& ,u_seri,v_seri,t_seri,q_seri &
130	& ,d_u_the,d_v_the,d_t_the,d_q_the &
131	& ,zfm_therm,zentr_therm &
132	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
133	& ,tho_thermals,3)
134	else if (iflag_thermals.eq.11) then
135	stop'cas non prevu dans calltherm'
136	! CALL thermcell_pluie(klon,klev,zdt &
137	! & ,pplay,paprs,pphi,zlev &
138	! & ,u_seri,v_seri,t_seri,q_seri &
139	! & ,d_u_the,d_v_the,d_t_the,d_q_the &
140	! & ,zfm_therm,zentr_therm,zqla &
141	! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
142	! & ,tho_thermals,3)
143	else if (iflag_thermals.eq.12) then
144	CALL calcul_sec(klon,klev,zdt &
145	& ,pplay,paprs,pphi,zlev &
146	& ,u_seri,v_seri,t_seri,q_seri &
147	& ,zmax_sec,wmax_sec,zw_sec,lmix_sec &
148	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
149	& ,tho_thermals)
150	! CALL calcul_sec_entr(klon,klev,zdt
151	! s ,pplay,paprs,pphi,zlev,debut
152	! s ,u_seri,v_seri,t_seri,q_seri
153	! s ,zmax_sec,wmax_sec,zw_sec,lmix_sec
154	! s ,r_aspect_thermals,l_mix_thermals,w2di_thermals
155	! s ,tho_thermals,3)
156	! CALL thermcell_pluie_detr(klon,klev,zdt &
157	! & ,pplay,paprs,pphi,zlev,debut &
158	! & ,u_seri,v_seri,t_seri,q_seri &
159	! & ,d_u_the,d_v_the,d_t_the,d_q_the &
160	! & ,zfm_therm,zentr_therm,zqla,lmax &
161	! & ,zmax_sec,wmax_sec,zw_sec,lmix_sec &
162	! & ,ratqscth,ratqsdiff,zqsatth &
163	! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
164	! & ,tho_thermals)
165	else if (iflag_thermals.ge.13) then
166	CALL thermcell_main(klon,klev,zdt &
167	& ,pplay,paprs,pphi,debut &
168	& ,u_seri,v_seri,t_seri,q_seri &
169	& ,d_u_the,d_v_the,d_t_the,d_q_the &
170	& ,zfm_therm,zentr_therm,zqla,lmax &
171	& ,ratqscth,ratqsdiff,zqsatth &
172	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
173	& ,tho_thermals,Ale,Alp,lalim_conv,wght_th)
174	endif
175
176
177	DO i=1,klon
178	DO k=1,klev
179	IF(iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5) THEN
180
181	! transformation de la derivee en tendance
182	d_t_the(i,k)=d_t_the(i,k)*dtime/float(nsplit_thermals)
183	d_u_the(i,k)=d_u_the(i,k)*dtime/float(nsplit_thermals)
184	d_v_the(i,k)=d_v_the(i,k)*dtime/float(nsplit_thermals)
185	d_q_the(i,k)=d_q_the(i,k)*dtime/float(nsplit_thermals)
186	fm_therm(i,k)=fm_therm(i,k) &
187	& +zfm_therm(i,k)/float(nsplit_thermals)
188	entr_therm(i,k)=entr_therm(i,k) &
189	& +zentr_therm(i,k)/float(nsplit_thermals)
190	fm_therm(:,klev+1)=0.
191
192
193
194	! accumulation de la tendance
195	d_t_ajs(i,k)=d_t_ajs(i,k)+d_t_the(i,k)
196	d_u_ajs(i,k)=d_u_ajs(i,k)+d_u_the(i,k)
197	d_v_ajs(i,k)=d_v_ajs(i,k)+d_v_the(i,k)
198	d_q_ajs(i,k)=d_q_ajs(i,k)+d_q_the(i,k)
199
200	! incrementation des variables meteo
201	t_seri(i,k) = t_seri(i,k) + d_t_the(i,k)
202	u_seri(i,k) = u_seri(i,k) + d_u_the(i,k)
203	v_seri(i,k) = v_seri(i,k) + d_v_the(i,k)
204	qmemoire(i,k)=q_seri(i,k)
205	q_seri(i,k) = q_seri(i,k) + d_q_the(i,k)
206	ENDIF
207	ENDDO
208	ENDDO
209
210	DO i=1,klon
211	fm_therm(i,klev+1)=0.
212	Ale_bl(i)=Ale_bl(i)+Ale(i)/float(nsplit_thermals)
213	! write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i)
214	Alp_bl(i)=Alp_bl(i)+Alp(i)/float(nsplit_thermals)
215	! write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
216	ENDDO
217
218	! tests sur les valeurs negatives de l'eau
219	DO k = 1, klev
220	DO i = 1, klon
221	if (.not.q_seri(i,k).ge.0.) then
222	print*,'WARN eau<0 apres therm i=',i,' k=',k &
223	& ,' dq,q',d_q_the(i,k),q_seri(i,k), &
224	& 'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k)
225	q_seri(i,k)=1.e-15
226	! stop
227	endif
228	ENDDO
229	ENDDO
230	! tests sur les valeurs de la temperature
231	DO k = 1, klev
232	DO i = 1, klon
233	if ((t_seri(i,k).lt.50.) .or. &
234	& (t_seri(i,k).gt.370.)) then
235	print*,'WARN temp apres therm i=',i,' k=',k &
236	& ,' t_seri',t_seri(i,k)
237	! CALL abort
238	endif
239	ENDDO
240	ENDDO
241
242	enddo ! isplit
243
244	!
245	!***************************************************************
246	! calcul du flux ascencant conservatif
247	! print*,'<<<<calcul flux ascendant conservatif'
248
249	fmc_therm=0.
250	do k=1,klev
251	do i=1,klon
252	if (entr_therm(i,k).gt.0.) then
253	fmc_therm(i,k+1)=fmc_therm(i,k)+entr_therm(i,k)
254	else
255	fmc_therm(i,k+1)=fmc_therm(i,k)
256	endif
257	detrc_therm(i,k)=(fmc_therm(i,k+1)-fm_therm(i,k+1)) &
258	& -(fmc_therm(i,k)-fm_therm(i,k))
259	enddo
260	enddo
261
262
263	!****************************************************************
264	! calcul de l'humidite dans l'ascendance
265	! print*,'<<<<calcul de lhumidite dans thermique'
266	!CR:on ne le calcule que pour le cas sec
267	if (iflag_thermals.le.11) then
268	do i=1,klon
269	zqasc(i,1)=q_seri(i,1)
270	do k=2,klev
271	if (fmc_therm(i,k+1).gt.1.e-6) then
272	zqasc(i,k)=(fmc_therm(i,k)*zqasc(i,k-1) &
273	& +entr_therm(i,k)*q_seri(i,k))/fmc_therm(i,k+1)
274	!CR:test on asseche le thermique
275	! zqasc(i,k)=zqasc(i,k)/2.
276	! else
277	! zqasc(i,k)=q_seri(i,k)
278	endif
279	enddo
280	enddo
281
282
283	! calcul de l'eau condensee dans l'ascendance
284	! print*,'<<<<calcul de leau condensee dans thermique'
285	do i=1,klon
286	do k=1,klev
287	clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
288	if (clwcon0(i,k).lt.0. .or. &
289	& (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
290	clwcon0(i,k)=0.
291	endif
292	enddo
293	enddo
294	else
295	do i=1,klon
296	do k=1,klev
297	clwcon0(i,k)=zqla(i,k)
298	if (clwcon0(i,k).lt.0. .or. &
299	& (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
300	clwcon0(i,k)=0.
301	endif
302	enddo
303	enddo
304	endif
305	!*******************************************************************
306
307
308	return
309
310	end

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

Download in other formats:

Original Format