Context Navigation

phystokenc.F @ 199

Last change on this file since 199 was 199, checked in by lmdz, 23 years ago
Introduction Kerry Emmanuel ratqs interactif mise a jour offline FH LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 10.3 KB

Line
1	c
2	c $Header
3	c
4	SUBROUTINE phystokenc (
5	I nlon,nlev,pdtphys,rlon,rlat,
6	I pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
7	I pcoefh,yu1,yv1,ftsol,pctsrf,
8	I frac_impa,frac_nucl,
9	I pphis,paire,dtime,itap)
10	USE ioipsl
11
12	IMPLICIT none
13
14	c======================================================================
15	c Auteur(s) FH
16	c Objet: Moniteur general des tendances traceurs
17	c
18
19	c======================================================================
20	#include "dimensions.h"
21	#include "dimphy.h"
22	#include "tracstoke.h"
23	#include "indicesol.h"
24	#include "control.h"
25	c======================================================================
26
27	c Arguments:
28	c
29	c EN ENTREE:
30	c ==========
31	c
32	c divers:
33	c -------
34	c
35	integer nlon ! nombre de points horizontaux
36	integer nlev ! nombre de couches verticales
37	real pdtphys ! pas d'integration pour la physique (seconde)
38	c
39	integer physid, itap,ndex(1)
40
41	c convection:
42	c -----------
43	c
44	REAL pmfu(klon,klev) ! flux de masse dans le panache montant
45	REAL pmfd(klon,klev) ! flux de masse dans le panache descendant
46	REAL pen_u(klon,klev) ! flux entraine dans le panache montant
47	REAL pde_u(klon,klev) ! flux detraine dans le panache montant
48	REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
49	REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
50	REAL pt(klon,klev)
51	c
52	REAL rlon(klon), rlat(klon), dtime
53	REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1)
54
55	c Couche limite:
56	c --------------
57	c
58	REAL pcoefh(klon,klev) ! coeff melange CL
59	REAL yv1(klon)
60	REAL yu1(klon),pphis(klon),paire(klon)
61	c
62	c Lessivage:
63	c ----------
64	c
65	REAL frac_impa(klon,klev)
66	REAL frac_nucl(klon,klev)
67	c
68	c Arguments necessaires pour les sources et puits de traceur
69	C
70	real ftsol(klon,nbsrf) ! Temperature du sol (surf)(Kelvin)
71	real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
72	c======================================================================
73	c
74	INTEGER i, k
75	c
76	REAL mfu(klon,klev) ! flux de masse dans le panache montant
77	REAL mfd(klon,klev) ! flux de masse dans le panache descendant
78	REAL en_u(klon,klev) ! flux entraine dans le panache montant
79	REAL de_u(klon,klev) ! flux detraine dans le panache montant
80	REAL en_d(klon,klev) ! flux entraine dans le panache descendant
81	REAL de_d(klon,klev) ! flux detraine dans le panache descendant
82	REAL coefh(klon,klev) ! flux detraine dans le panache descendant
83	REAL t(klon,klev)
84
85	REAL pyu1(klon),pyv1(klon)
86	REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf)
87	real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon)
88	real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon)
89
90	REAL dtcum
91
92	integer iadvtr,irec
93	real zmin,zmax
94
95	save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
96	save iadvtr,irec
97	save pyu1,pyv1,pftsol,ppsrf
98
99	data iadvtr,irec/0,1/
100	c
101	c Couche limite:
102	c======================================================================
103
104	print*,'iadvtr= ',iadvtr
105	print*,'istphy= ',istphy
106	print*,'istdyn= ',istdyn
107
108	IF (iadvtr.eq.0) THEN
109
110	CALL initphysto('phystoke',
111	. rlon,rlat,dtime, dtimeistphy,dtimeistphy,nqmx,physid)
112
113	write(,) 'apres initphysto ds phystokenc'
114
115	ndex(1) = 0
116	i=itap
117	CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
118	CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
119	c
120	i=itap
121	CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
122	CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
123
124	ENDIF
125	c
126	iadvtr=iadvtr+1
127	c
128	c
129	c reinitialisation des champs cumules
130	if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then
131	print*,'reinitialisation des champs cumules
132	s a iadvtr=',iadvtr
133	do k=1,klev
134	do i=1,klon
135	mfu(i,k)=0.
136	mfd(i,k)=0.
137	en_u(i,k)=0.
138	de_u(i,k)=0.
139	en_d(i,k)=0.
140	de_d(i,k)=0.
141	coefh(i,k)=0.
142	t(i,k)=0.
143	enddo
144	enddo
145	do i=1,klon
146	pyv1(i)=0.
147	pyu1(i)=0.
148	end do
149	do k=1,nbsrf
150	do i=1,klon
151	pftsol(i,k)=0.
152	ppsrf(i,k)=0.
153	enddo
154	enddo
155
156	dtcum=0.
157	endif
158
159	do k=1,klev
160	do i=1,klon
161	mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
162	mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
163	en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
164	de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
165	en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
166	de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
167	coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
168	t(i,k)=t(i,k)+pt(i,k)*pdtphys
169	enddo
170	enddo
171	do i=1,klon
172	pyv1(i)=pyv1(i)+yv1(i)*pdtphys
173	pyu1(i)=pyu1(i)+yu1(i)*pdtphys
174	end do
175	do k=1,nbsrf
176	do i=1,klon
177	pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
178	ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
179	enddo
180	enddo
181
182	dtcum=dtcum+pdtphys
183	c
184	IF(mod(iadvtr,istphy).eq.0) THEN
185	c
186	c normalisation par le temps cumule
187	do k=1,klev
188	do i=1,klon
189	mfu(i,k)=mfu(i,k)/dtcum
190	mfd(i,k)=mfd(i,k)/dtcum
191	en_u(i,k)=en_u(i,k)/dtcum
192	de_u(i,k)=de_u(i,k)/dtcum
193	en_d(i,k)=en_d(i,k)/dtcum
194	de_d(i,k)=de_d(i,k)/dtcum
195	coefh(i,k)=coefh(i,k)/dtcum
196	t(i,k)=t(i,k)/dtcum
197	enddo
198	enddo
199	do i=1,klon
200	pyv1(i)=pyv1(i)/dtcum
201	pyu1(i)=pyu1(i)/dtcum
202	end do
203	c modif abderr 23 11 00 do k=1,nbsrf
204	do i=1,klon
205	do k=1,nbsrf
206	pftsol(i,k)=pftsol(i,k)/dtcum
207	ppsrf(i,k)=ppsrf(i,k)/dtcum
208	enddo
209	pftsol1(i) = pftsol(i,1)
210	pftsol2(i) = pftsol(i,2)
211	pftsol3(i) = pftsol(i,3)
212	pftsol4(i) = pftsol(i,4)
213
214	c ppsrf(i,k)=ppsrf(i,k)/dtcum
215	ppsrf1(i) = ppsrf(i,1)
216	ppsrf2(i) = ppsrf(i,2)
217	ppsrf3(i) = ppsrf(i,3)
218	ppsrf4(i) = ppsrf(i,4)
219
220	enddo
221	c enddo
222	c
223	c ecriture des champs
224	c
225	irec=irec+1
226
227	ccccc
228	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
229	CALL histwrite(physid,"t",itap,zx_tmp_3d,
230	. iim(jjm+1)klev,ndex)
231
232	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
233	CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
234	. iim(jjm+1)klev,ndex)
235	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
236	CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
237	. iim(jjm+1)klev,ndex)
238	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
239	CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
240	. iim(jjm+1)klev,ndex)
241	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
242	CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
243	. iim(jjm+1)klev,ndex)
244	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
245	CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
246	. iim(jjm+1)klev,ndex)
247	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)
248	CALL histwrite(physid,"de_d",itap,zx_tmp_3d,
249	. iim(jjm+1)klev,ndex)
250	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)
251	CALL histwrite(physid,"coefh",itap,zx_tmp_3d,
252	. iim(jjm+1)klev,ndex)
253	cccc
254	CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
255	CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
256	. iim(jjm+1)klev,ndex)
257
258	CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
259	CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
260	. iim(jjm+1)klev,ndex)
261
262	CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
263	CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
264
265	CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
266	CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
267
268	CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
269	CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
270	. iim*(jjm+1),ndex)
271	CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
272	CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
273	. iim*(jjm+1),ndex)
274	CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
275	CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
276	. iim*(jjm+1),ndex)
277
278	c
279	CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
280	CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
281	. iim*(jjm+1),ndex)
282
283	CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
284	CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,
285	. iim*(jjm+1),ndex)
286	CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
287	CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
288	. iim*(jjm+1),ndex)
289	CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
290	CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
291	. iim*(jjm+1),ndex)
292	CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
293	CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
294	. iim*(jjm+1),ndex)
295
296	c
297	cAA Test sur la valeur des coefficients de lessivage
298	c
299	zmin=1e33
300	zmax=-1e33
301	do k=1,klev
302	do i=1,klon
303	zmax=max(zmax,frac_nucl(i,k))
304	zmin=min(zmin,frac_nucl(i,k))
305	enddo
306	enddo
307	Print*,'------ coefs de lessivage (min et max) --------'
308	Print*,'facteur de nucleation ',zmin,zmax
309	zmin=1e33
310	zmax=-1e33
311	do k=1,klev
312	do i=1,klon
313	zmax=max(zmax,frac_impa(i,k))
314	zmin=min(zmin,frac_impa(i,k))
315	enddo
316	enddo
317	Print*,'facteur d impaction ',zmin,zmax
318
319	ENDIF
320
321
322	RETURN
323	END

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

Download in other formats:

Original Format