Context Navigation

calltherm.F90 @ 927

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

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

Download in other formats:

Original Format