Context Navigation

phytrac.older @ 402

Last change on this file since 402 was 3, checked in by slebonnois, 14 years ago

Creation de repertoires:

chantiers : pour communiquer sur nos projets de modifs
documentation : pour stocker les docs

Ajout de:

libf/phytitan : physique de Titan
libf/chimtitan: chimie de Titan
libf/phyvenus : physique de Venus

File size: 13.0 KB

Line
1	!
2	! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phytrac.F,v 1.16 2006/03/24 15:06:23 lmdzadmin Exp $
3	!
4	c
5	c
6	SUBROUTINE phytrac (nstep,
7	I gmtime,
8	I debutphy,
9	I lafin,
10	I nqmax,
11	I nlon,
12	I nlev,
13	I pdtphys,
14	I u,
15	I v,
16	I t_seri,
17	I paprs,
18	I pplay,
19	I coefh,
20	I yu1,
21	I yv1,
22	I ftsol,
23	I xlat,
24	I xlon,
25	I zlev,
26	I presnivs,
27	I pphis,
28	I pphi,
29	I albsol,
30	O tr_seri)
31
32	USE ioipsl
33
34	IMPLICIT none
35	c======================================================================
36	c Auteur(s) FH
37	c Objet: Moniteur general des tendances traceurs
38	c
39	cAA Remarques en vrac:
40	cAA--------------------
41	cAA 1/ le call phytrac se fait avec nqmax
42	c======================================================================
43	#include "YOMCST.h"
44	#include "dimensions.h"
45	#include "dimphy.h"
46	#include "clesphys.h" !///utile?
47	#include "temps.h"
48	#include "paramet.h"
49	#include "control.h"
50	#include "comgeomphy.h"
51	#include "advtrac.h"
52	c======================================================================
53
54	c Arguments:
55	c
56	c EN ENTREE:
57	c ==========
58	c
59	c divers:
60	c -------
61	c
62	integer nlon ! nombre de points horizontaux
63	integer nlev ! nombre de couches verticales
64	integer nqmax ! nombre de traceurs auxquels on applique la physique
65	integer nstep ! appel physique
66	integer nseuil ! numero du premier traceur non CV
67	c integer julien !jour julien
68	c integer itop_con(nlon)
69	c integer ibas_con(nlon)
70	real gmtime
71	real pdtphys ! pas d'integration pour la physique (seconde)
72	real t_seri(nlon,nlev) ! temperature
73	real tr_seri(nlon,nlev,nqmax) ! traceur
74	real u(nlon,nlev)
75	real v(nlon,nlev)
76	real albsol(nlon) ! albedo surface
77	real paprs(nlon,nlev+1) ! pression pour chaque inter-couche (en Pa)
78	real ps(nlon) ! pression surface
79	real pplay(nlon,nlev) ! pression pour le mileu de chaque couche (en Pa)
80	real pphi(nlon,nlev) ! geopotentiel
81	real pphis(nlon)
82	REAL presnivs(nlev)
83	logical debutphy ! le flag de l'initialisation de la physique
84	logical lafin ! le flag de la fin de la physique
85	c REAL flxmass_w(nlon,nlev)
86
87	cAA Rem : nqmax : nombre de vrais traceurs est defini dans dimphy.h
88	c
89	c convection:
90	c -----------
91	c
92	REAL pmfu(nlon,nlev) ! flux de masse dans le panache montant
93	REAL pmfd(nlon,nlev) ! flux de masse dans le panache descendant
94	REAL pen_u(nlon,nlev) ! flux entraine dans le panache montant
95
96	c
97	c Couche limite:
98	c --------------
99	c
100	REAL coefh(nlon,nlev) ! coeff melange CL
101	REAL yu1(nlon) ! vents au premier niveau
102	REAL yv1(nlon) ! vents au premier niveau
103	REAL xlat(nlon) ! latitudes pour chaque point
104	REAL xlon(nlon) ! longitudes pour chaque point
105	REAL zlev(nlon,nlev+1) ! altitude a chaque niveau (interface inferieure de la couche)
106	cAA
107	cAA Arguments necessaires pour les sources et puits de traceur:
108	cAA ----------------
109	cAA
110	real ftsol(nlon) ! Temperature du sol (surf)(Kelvin)
111
112	cAA ----------------------------
113	cAA VARIABLES LOCALES TRACEURS
114	cAA ----------------------------
115	cAA
116	cAA Sources et puits des traceurs:
117	cAA ------------------------------
118	cAA
119	REAL source(klon) ! a voir lorsque le flux est prescrit
120
121	CHARACTER*2 itn
122	C maf ioipsl
123	CHARACTER*2 str2
124	INTEGER nhori, nvert
125	REAL zsto, zout, zjulian
126	INTEGER nid_tra
127	SAVE nid_tra
128	INTEGER nid_tra2,nid_tra3
129	SAVE nid_tra2,nid_tra3
130	INTEGER ndex(1)
131	INTEGER ndex2d(iim(jjm+1)),ndex3d(iim(jjm+1)*klev)
132	REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
133	REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
134	c
135	integer itau_w ! pas de temps ecriture = nstep + itau_phy
136	c
137
138	C
139	C Variables liees a l'ecriture de la bande histoire : phytrac.nc
140	c
141	c INTEGER ecrit_tra
142	c SAVE ecrit_tra
143	logical ok_sync
144	parameter (ok_sync = .true.)
145	C
146	C nature du traceur
147	c
148	logical aerosol(nqmx) ! Nature du traceur
149	c ! aerosol(it) = true => aerosol
150	c ! aerosol(it) = false => gaz
151	c ! nat_trac(it) = 1. aerosol
152	logical clsol(nqmx) ! clsol(it) = true => CL sol calculee
153	save aerosol,clsol
154	C
155	C les traceurs
156	C
157	c===================
158	c it--------indice de traceur
159	c k,i---------indices long, vert
160	c===================
161	c Variables deja declarees dont on a besoin pour traceurs
162	c k,i,it,tr_seri(klon,klev,nqmax),pplay(nlon,nlev),
163	real zprof(klon,klev)
164	c real pzero,gamma
165	c parameter (pzero=85000.)
166	c parameter (gamma=5000.)
167	real deltatr(klon,klev,nqmax) ! ecart au profil de ref zprof
168	real tau ! temps de relaxation vers le profil
169	c tau pourra dependre de it
170	parameter (tau=1.) ! duree de vie du compose en secondes 3.e10
171	c======================================================================
172	c
173	c Declaration des procedures appelees
174	c
175	c--modif convection tiedtke
176	INTEGER i, k, it
177	INTEGER iq, iiq
178	REAL delp(klon,klev)
179	c--end modif
180	c
181	c Variables liees a l'ecriture de la bande histoire physique
182	c
183	c Variables locales pour effectuer les appels en serie
184	c----------------------------------------------------
185	c
186	REAL d_tr(klon,klev), d_trs(klon) ! tendances de traceurs
187	REAL d_tr_cl(klon,klev,nqmax) ! tendance de traceurs couche limite
188	REAL d_tr_cv(klon,klev,nqmax) ! tendance de traceurs conv pour chq traceur
189	C
190	character*80 abort_message
191	c
192	c Controles
193	c-------------
194	logical first,couchelimite,convection
195	save first,couchelimite,convection
196	c Olivia
197	data first,couchelimite,convection
198	s /.true.,.false.,.false./
199
200	c======================================================================
201	ps(:)=paprs(:,1)
202	c---------
203	c debutphy
204	c---------
205	if (debutphy) then
206	print*,"DEBUT PHYTRAC"
207	C
208	c=============================================================
209	c Initialisation des traceurs
210	c=============================================================
211	c
212	c Initialisation de la nature des traceurs
213	c
214	DO it = 1, nqmax
215	aerosol(it) = .FALSE. ! Tous les traceurs sont des gaz par defaut
216	clsol(it) = .FALSE. ! Par defaut couche limite avec flux prescrit
217	ENDDO
218	c
219	c===========
220	c definition de traceurs idealises
221	c==========
222	c
223	c I) Declaration directe du traceur a altitude fixee
224	c
225	c a) traceur en carre OK
226	c
227	c do i=1,klon
228	c tr_seri(i,:,1)=0.
229	c if ((xlat(i)>=0.).and.(xlat(i)<=-30.)) then
230	c if ((xlon(i)>=0.).and.(xlon(i)<=40.)) then
231	c tr_seri(i,10,1)=1.
232	c endif
233	c endif
234	c end do
235	c
236	c b) traceur a une bande en latitudeOK
237	c
238	c do i=1,klon
239	c tr_seri(i,:,1)=0.
240	c if ((xlat(i)>=50.).and.(xlat(i)<=60.)) then
241	c tr_seri(i,25,1)=1.
242	c endif
243	c end do
244	c
245	c c) traceur a plusieurs bandes en latitude OK
246	c
247	c do i=1,klon
248	c tr_seri(i,:,2)=0.
249	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
250	c tr_seri(i,10,2)=1.
251	c endif
252	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
253	c tr_seri(i,10,2)=1.
254	c endif
255	c
256	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
257	c tr_seri(i,10,2)=1.
258	c endif
259	c end do
260	c
261	c d) traceur a une bande en altitude OK
262	c
263	c do k=1,klev+1
264	c tr_seri(:,k,1)=0.
265	c if ((pplay(klon/2,k)>=1.e5).and.(pplay(klon/2,k)<=1.e6)) then
266	c tr_seri(:,k,1)=1.
267	c endif
268	c end do
269	c
270	c dbis) plusieurs traceurs a une bande en altitude OK
271	c
272	do k=1,klev
273	tr_seri(:,k,1)=0.
274	if ((pplay(klon/2,k)>=9.e5).and.(pplay(klon/2,k)<=9.e6)) then
275	tr_seri(:,k,1)=1.
276	endif
277	end do
278
279	do k=1,klev
280	tr_seri(:,k,2)=0.
281	if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
282	tr_seri(:,k,2)=1.
283	endif
284	end do
285
286	c do k=1,klev
287	c tr_seri(:,k,3)=0.
288	c if ((pplay(klon/2,k)>=5.e1).and.(pplay(klon/2,k)<=5.e2)) then
289	c tr_seri(:,k,3)=1.
290	c endif
291	c end do
292	c
293	c e) plusieurs couches verticales de traceurs, a plusieurs bandes en latitude???
294	c
295	c au sol
296	c do i=1,klon
297	c tr_seri(i,:,1)=0.
298	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
299	c tr_seri(i,5,1)=1.
300	c endif
301	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
302	c tr_seri(i,5,1)=1.
303	c endif
304	c
305	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
306	c tr_seri(i,5,1)=1.
307	c endif
308	c end do
309	c
310	c do i=1,klon
311	c tr_seri(i,:,2)=0.
312	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
313	c tr_seri(i,10,2)=1.
314	c endif
315	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
316	c tr_seri(i,10,2)=1.
317	c endif
318	c
319	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
320	c tr_seri(i,10,2)=1.
321	c endif
322	c end do
323	c
324	c do i=1,klon
325	c tr_seri(i,:,3)=0.
326	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
327	c tr_seri(i,30,3)=1.
328	c endif
329	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
330	c tr_seri(i,30,3)=1.
331	c endif
332	c
333	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
334	c tr_seri(i,30,3)=1.
335	c endif
336	c end do
337	c
338	c do i=1,klon
339	c tr_seri(i,:,4)=0.
340	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
341	c tr_seri(i,45,4)=1.
342	c endif
343	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
344	c tr_seri(i,45,4)=1.
345	c endif
346	c
347	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
348	c tr_seri(i,45,4)=1.
349	c endif
350	c end do
351	c
352	c II) Declaration d'un profil vertical de traceur OK
353	c
354	c do i=1,klon
355	c do k=1,klev
356	c zprof(i,k)=0.5*(1.+tanh((pplay(i,k)-pzero)/gamma))
357	c--------x=alog10P+b
358	c zprof(i,k)=-8.79e-6*(log10(pplay(i,k)))+7.6e-5
359	c zprof(i,k)=8.79e-6*(log10(pplay(i,k)))-7.6e-5
360	c--------alog10x=alog10P+b
361	c zprof(i,k)=-0.31*(log10(pplay(i,k)))+5.2
362	c zprof(i,k)=-0.31*(log10(pplay(i,k)))-2.68
363	c enddo
364	c enddo
365	c
366	c do i=1,klon
367	c do k=1,klev
368	c zprof(i,k)=0.5*(1.+tanh((pplay(i,k)-pzero)/gamma))
369	c enddo
370	c enddo
371	c-------------
372	c fin debutphy
373	c-------------
374	ENDIF ! fin debutphy
375
376	c======================================================================
377	c Rappel vers un profil
378	c======================================================================
379	c do it=1,nqmax-2
380	c do k=1,klev
381	c do i=1,klon
382	c deltatr(i,k,1) = 0.
383	c tr_seri(i,k,1) = 0.
384	c deltatr(i,k,1) = (-tr_seri(i,k,1)+zprof(i,k))/tau
385	c tr_seri(i,k,1) = tr_seri(i,k,1) + deltatr(i,k,1)
386	c enddo
387	c enddo
388	c enddo
389
390	c======================================================================
391	c Calcul de l'effet de la couche limite
392	c======================================================================
393
394	if (couchelimite) then
395
396	DO k = 1, klev
397	DO i = 1, klon
398	delp(i,k) = paprs(i,k)-paprs(i,k+1)
399	ENDDO
400	ENDDO
401
402	C maf modif pour tenir compte du cas rnpb + traceur
403	DO it=1, nqmax
404
405	c print *,'it',it,clsol(it)
406	if (clsol(it)) then ! couche limite avec quantite dans le sol calculee
407
408	else ! couche limite avec flux prescrit
409
410	Cmaf provisoire source / traceur a creer
411	DO i=1, klon
412	source(i) = 0.0 ! pas de source, pour l'instant
413	ENDDO
414	C
415
416	CALL cltrac(pdtphys, coefh,t_seri,
417	s tr_seri(1,1,it), source,
418	e paprs, pplay, delp,
419	s d_tr_cl(1,1,it))
420	DO k = 1, nlev
421	DO i = 1, klon
422	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
423	ENDDO
424	ENDDO
425	Cmaf WRITE(itn,'(i1)') it
426	cmaf CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'cltracn it='//itn)
427	endif
428	ENDDO
429	c
430	endif ! couche limite
431
432	c=============================================================
433
434	RETURN
435	END

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

Download in other formats:

Original Format