Context Navigation

phytrac.F @ 777

Last change on this file since 777 was 101, checked in by slebonnois, 14 years ago
SL: modifications pour arriver a compiler le gcm VENUS ! Ca marche ! A noter: modifs de makelmdz
File size: 25.9 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 xlat,
20	I xlon,
21	I presnivs,
22	I pphis,
23	I pphi,
24	I albsol,
25	O tr_seri)
26
27	c======================================================================
28	c Auteur(s) FH
29	c Objet: Moniteur general des tendances traceurs
30	c
31	cAA Remarques en vrac:
32	cAA--------------------
33	cAA 1/ le call phytrac se fait avec nqmax
34	c======================================================================
35	USE ioipsl
36	USE infotrac
37	USE control_mod
38	use dimphy
39	USE comgeomphy
40	IMPLICIT none
41	#include "YOMCST.h"
42	#include "dimensions.h"
43	#include "clesphys.h" !///utile?
44	#include "temps.h"
45	#include "paramet.h"
46	c======================================================================
47
48	c Arguments:
49	c
50	c EN ENTREE:
51	c ==========
52	c
53	c divers:
54	c -------
55	c
56	integer nlon ! nombre de points horizontaux
57	integer nlev ! nombre de couches verticales
58	integer nqmax ! nombre de traceurs auxquels on applique la physique
59	integer nstep ! appel physique
60	integer nseuil ! numero du premier traceur non CV
61	c integer julien !jour julien
62	c integer itop_con(nlon)
63	c integer ibas_con(nlon)
64	real gmtime
65	real pdtphys ! pas d'integration pour la physique (seconde)
66	real t_seri(nlon,nlev) ! temperature
67	real tr_seri(nlon,nlev,nqmax) ! traceur
68	real u(nlon,nlev)
69	real v(nlon,nlev)
70	real albsol(nlon) ! albedo surface
71	real paprs(nlon,nlev+1) ! pression pour chaque inter-couche (en Pa)
72	real ps(nlon) ! pression surface
73	real pplay(nlon,nlev) ! pression pour le mileu de chaque couche (en Pa)
74	real pphi(nlon,nlev) ! geopotentiel
75	real pphis(nlon)
76	REAL xlat(nlon) ! latitudes pour chaque point
77	REAL xlon(nlon) ! longitudes pour chaque point
78	REAL presnivs(nlev)
79	logical debutphy ! le flag de l'initialisation de la physique
80	logical lafin ! le flag de la fin de la physique
81	c REAL flxmass_w(nlon,nlev)
82
83	cAA ----------------------------
84	cAA VARIABLES LOCALES TRACEURS
85	cAA ----------------------------
86	cAA
87
88	CHARACTER*2 itn
89	C maf ioipsl
90	CHARACTER*2 str2
91	INTEGER nhori, nvert
92	REAL zsto, zout, zjulian
93	INTEGER nid_tra
94	SAVE nid_tra
95	INTEGER nid_tra2,nid_tra3
96	SAVE nid_tra2,nid_tra3
97	INTEGER ndex(1)
98	INTEGER ndex2d(iim(jjm+1)),ndex3d(iim(jjm+1)*klev)
99	REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
100	REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
101	c
102	integer itau_w ! pas de temps ecriture = nstep + itau_phy
103	c
104
105	C
106	C Variables liees a l'ecriture de la bande histoire : phytrac.nc
107	c
108	c INTEGER ecrit_tra
109	c SAVE ecrit_tra
110	logical ok_sync
111	parameter (ok_sync = .true.)
112	C
113	C les traceurs
114	C
115	logical flagCO_OCS
116	c===================
117	c it--------indice de traceur
118	c k,i---------indices long, vert
119	c===================
120	c Variables deja declarees dont on a besoin pour traceurs
121	c k,i,it,tr_seri(klon,klev,nqmax),pplay(nlon,nlev),
122	integer nqCO_OCS
123	c real pzero,gamma
124	c parameter (pzero=85000.)
125	c parameter (gamma=5000.)
126	REAL alpha
127	real deltatr(klon,klev,nqtot) ! ecart au profil de ref zprof
128	real,save,allocatable :: zprof(:,:)
129	real,save,allocatable :: tau(:,:) ! temps de relaxation vers le profil (s)
130	c======================================================================
131	c
132	c Declaration des procedures appelees
133	c
134	c--modif convection tiedtke
135	INTEGER i, k, it
136	INTEGER iq, iiq
137	REAL delp(klon,klev)
138	c--end modif
139	c
140	c Variables liees a l'ecriture de la bande histoire physique
141	c
142	c Variables locales pour effectuer les appels en serie
143	c----------------------------------------------------
144	c
145	REAL d_tr(klon,klev), d_trs(klon) ! tendances de traceurs
146	REAL d_tr_cl(klon,klev,nqmax) ! tendance de traceurs couche limite
147	REAL d_tr_cv(klon,klev,nqmax) ! tendance de traceurs conv pour chq traceur
148	C
149	character*20 modname
150	character*80 abort_message
151	c
152	c Controles
153	c-------------
154	logical first,couchelimite,convection
155	save first,couchelimite,convection
156	c Olivia
157	data first,couchelimite,convection
158	s /.true.,.false.,.false./
159
160	modname = 'phytrac'
161	c======================================================================
162
163	if(first) then
164	allocate(zprof(klev,nqtot),tau(klev,nqtot))
165	first = .false.
166	endif
167
168	ps(:)=paprs(:,1)
169	c TRACEURS TYPE CO ET OCS
170	flagCO_OCS = .true.
171	if (flagCO_OCS) then
172	nqCO_OCS = 6
173	else
174	nqCO_OCS = 0
175	endif ! flagCO_OCS
176
177	c---------
178	c debutphy
179	c---------
180	if (debutphy) then
181	print*,"DEBUT PHYTRAC"
182	C
183	c=============================================================
184	c=============================================================
185	c=============================================================
186	c Initialisation des traceurs
187	c=============================================================
188	c=============================================================
189	c=============================================================
190	c
191	c=============================================================
192	c=============================================================
193
194	C=========================================================================
195	C=========================================================================
196	if (flagCO_OCS) then
197	c II) Declaration d'un profil vertical de traceur OK
198	c
199	c zprof = profil de rappel
200	c
201	c 1 -> CO ; 2 -> OCS
202	c def des profils en log(a) = a * log(P) + b par morceaux, cf. pollack et al
203	c tr_seri en ppm
204	c (initialisation seulement si ceux-ci sont nuls)
205
206	c ICI, ON UTILISE 3 CONSTANTES DE TEMPS DIFFERENTES POUR CHAQUE,
207	c DONC TRACEURS 1 A 3 POUR CO ET 4 A 6 POUR OCS
208	C=========================================================================
209
210
211	c Constantes de rappel:
212
213	print*,"INIT TAU"
214	do k=1,klev
215	tau(k,1)=1.e6
216	tau(k,2)=1.e7
217	tau(k,3)=1.e8
218	tau(k,4)=1.e6
219	tau(k,5)=1.e7
220	tau(k,6)=1.e8
221	enddo
222
223	c CO
224
225	do it=1,3
226	print*,"INIT ZPROF ",tname(it)
227	do k=1,klev
228	zprof(k,it)=0.
229	c pour l'instant, tau fixe, mais possibilite de le faire varier avec z
230	if (pplay(klon/2,k) >= 4.8e6) then
231	zprof(k,it)=14.
232	endif
233	if ((pplay(klon/2,k)<=4.8e6).and.(pplay(klon/2,k)>=1.9e6)) then
234	alpha=(log(pplay(klon/2,k))-log(1.9e6))/
235	. (log(4.8e6)-log(1.9e6))
236	zprof(k,it)=20.(14./20.)*alpha
237	endif
238	if ((pplay(klon/2,k)<=1.9e6).and.(pplay(klon/2,k)>=1.5e5)) then
239	alpha=(log(pplay(klon/2,k))-log(1.5e5))/
240	. (log(1.9e6)-log(1.5e5))
241	zprof(k,it)=39.(20./39.)*alpha
242	endif
243	if ((pplay(klon/2,k)<=1.5e5).and.(pplay(klon/2,k)>=1.1e4)) then
244	alpha=(log(pplay(klon/2,k))-log(1.1e4))/
245	. (log(2.73e5)-log(1.1e4))
246	zprof(k,it)=50.(39./50.)*alpha
247	endif
248	if ((pplay(klon/2,k)<=1.1e4).and.(pplay(klon/2,k)>=1.3e3)) then
249	alpha=(log(pplay(klon/2,k))-log(1.3e3))/
250	. (log(1.1e4)-log(1.3e3))
251	zprof(k,it)=2.(50./2.)*alpha
252	endif
253	if ((pplay(klon/2,k)<=1.3e3).and.(pplay(klon/2,k)>=2.4)) then
254	alpha=(log(pplay(klon/2,k))-log(2.4))/
255	. (log(1.3e3)-log(2.4))
256	zprof(k,it)=1000.(2./1000.)*alpha
257	endif
258	if (pplay(klon/2,k) <= 2.4) then
259	zprof(k,it)=1000.
260	endif
261	enddo
262	print*,zprof(:,it)
263
264	c OCS
265	print*,"INIT ZPROF ",tname(it+3)
266	do k=1,klev
267	zprof(k,it+3)=0.
268	if (pplay(klon/2,k) >= 4.8e6) then
269	zprof(k,it+3)=30.
270	endif
271	if ((pplay(klon/2,k)<=4.8e6).and.(pplay(klon/2,k)>=9.4e5))
272	* then
273	alpha=(log(pplay(klon/2,k))-log(9.4e5))/
274	* (log(4.8e6)-log(9.4e5))
275	zprof(k,it+3)=20.(30/20.)*alpha
276	endif
277	if ((pplay(klon/2,k)<=9.4e5).and.(pplay(klon/2,k)>=4.724e5))
278	* then
279	alpha=(log(pplay(klon/2,k))-log(4.724e5))/
280	* (log(9.4e5)-log(4.724e5))
281	zprof(k,it+3)=0.5(20/0.5)*alpha
282	endif
283	if ((pplay(klon/2,k)<=4.724e5).and.(pplay(klon/2,k)>=1.1e4))
284	* then
285	alpha=(log(pplay(klon/2,k))-log(1.1e4))/
286	* (log(4.724e5)-log(1.1e4))
287	zprof(k,it+3)=0.005(0.5/0.005)*alpha
288	endif
289	if (pplay(klon/2,k)<=1.1e4) then
290	zprof(k,it+3)=0.
291	endif
292	end do
293	print*,zprof(:,it+3)
294	enddo
295
296	c Initialisation du traceur s'il est nul:
297	do it=1,nqCO_OCS
298	if ((tr_seri(klon/2,1,it).eq.0.).and.
299	. (tr_seri(klon/2,klev/2,it).eq.0.).and.
300	. (tr_seri(klon/2,klev,it).eq.0.)) then
301	print*,"INITIALISATION DE ",tname(it)
302	do k=1,klev
303	do i=1,klon
304	tr_seri(i,k,it) = zprof(k,it)
305	enddo
306	enddo
307	endif
308	enddo
309
310	C=========================================================================
311	endif ! flagCO_OCS
312	C=========================================================================
313	C=========================================================================
314
315	c-------------
316	c fin debutphy
317	c-------------
318	ENDIF ! fin debutphy
319
320	c======================================================================
321	if (flagCO_OCS) then
322	c Rappel vers un profil
323	c======================================================================
324	do it=1,nqCO_OCS
325	do k=1,klev
326	do i=1,klon
327	c VERIF
328	if (tr_seri(i,k,it).lt.0) then
329	print*,"Traceur negatif AVANT rappel:",i,k,it
330	stop
331	endif
332	c FIN VERIF
333
334	deltatr(i,k,it) = (-tr_seri(i,k,it)+zprof(k,it))/tau(k,it)
335	tr_seri(i,k,it) = tr_seri(i,k,it) + deltatr(i,k,it)*pdtphys
336
337	c VERIF
338	if (tr_seri(i,k,it).lt.0) then
339	print*,"APRES rappel:",i,k,it,
340	. deltatr(i,k,it),zprof(k,it),tr_seri(i,k,it),pdtphys/tau(k,it)
341	stop
342	endif
343	c FIN VERIF
344	enddo
345	enddo
346	enddo
347
348	c======================================================================
349	endif ! flagCO_OCS
350	c======================================================================
351
352	c======================================================================
353	c Calcul de l'effet de la couche limite remis directement dans physiq
354	c======================================================================
355
356
357	RETURN
358	END
359
360
361	c=========================================================================
362	c=========================================================================
363	c=========================================================================
364	c ARCHIVES ===============================================================
365	c=========================================================================
366	c=========================================================================
367	c=========================================================================
368
369	c===========
370	c definition de traceurs idealises
371	c==========
372	c
373	c I) Declaration directe du traceur a altitude fixee
374	c
375	c a) traceur en carre OK
376	c
377	c do i=1,klon
378	c tr_seri(i,:,1)=0.
379	c if ((xlat(i)>=0.).and.(xlat(i)<=-30.)) then
380	c if ((xlon(i)>=0.).and.(xlon(i)<=40.)) then
381	c tr_seri(i,10,1)=1.
382	c endif
383	c endif
384	c end do
385	c
386	c a bis) 2 traceurs en carre lat/alt, uniforme en longitude OK
387	c
388	C entre 45-55 km
389	c
390	c do i=1,klon
391	c do k=1,klev+1
392	cc tr_seri(i,k,1)=0.
393	c if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
394	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
395	c if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
396	c tr_seri(i,k,1)=1.
397	c endif
398	c endif
399	c endif
400	c else
401	c tr_seri(i,k,1)=0.
402	c end do
403	c end do
404	cc
405	c do i=1,klon
406	c do k=1,klev+1
407	cc tr_seri(i,k,2)=0.
408	c if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
409	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
410	c if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
411	c tr_seri(i,k,2)=1.
412	c endif
413	c endif
414	c endif
415	c else
416	c tr_seri(i,k,2)=0.
417	c end do
418	c end do
419	cc
420	c do i=1,klon
421	c do k=1,klev+1
422	cc tr_seri(i,k,3)=0.
423	c if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
424	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
425	c if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
426	c tr_seri(i,k,3)=1.
427	c endif
428	c endif
429	c endif
430	c else
431	c tr_seri(i,k,3)=0.
432	c end do
433	c end do
434	cc
435	c do i=1,klon
436	c do k=1,klev+1
437	cc tr_seri(i,k,4)=0.
438	c if ((xlat(i)>=-40.).and.(xlat(i)<=-60.)) then
439	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
440	c if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
441	c tr_seri(i,k,4)=1.
442	c endif
443	c endif
444	c endif
445	c else
446	c tr_seri(i,k,4)=0.
447	c end do
448	c end do
449	cc
450	c do i=1,klon
451	c do k=1,klev+1
452	cc tr_seri(i,k,5)=0.
453	c if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
454	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
455	c if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
456	c tr_seri(i,k,5)=1.
457	c endif
458	c endif
459	c endif
460	c else
461	c tr_seri(i,k,5)=0.
462	c end do
463	c end do
464	c
465	c entre 35-45 km
466	c
467	c do i=1,klon
468	c do k=1,klev+1
469	cc tr_seri(i,k,6)=0.
470	c if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
471	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
472	c if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
473	c tr_seri(i,k,6)=1.
474	c endif
475	c endif
476	c endif
477	c else
478	c tr_seri(i,k,6)=0.
479	c end do
480	c end do
481	c
482	c do i=1,klon
483	c do k=1,klev+1
484	cc tr_seri(i,k,7)=0.
485	c if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
486	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
487	c if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
488	c tr_seri(i,k,7)=1.
489	c endif
490	c endif
491	c endif
492	c else
493	c tr_seri(i,k,7)=0.
494	c end do
495	c end do
496	c
497	C entre 50-60 km
498	c
499	c do i=1,klon
500	c do k=1,klev+1
501	cc tr_seri(i,k,8)=0.
502	c if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
503	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
504	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
505	c tr_seri(i,k,8)=1.
506	c endif
507	c endif
508	c endif
509	c else
510	c tr_seri(i,k,8)=0.
511	c end do
512	c end do
513	c
514	c do i=1,klon
515	c do k=1,klev+1
516	cc tr_seri(i,k,9)=0.
517	c if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
518	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
519	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
520	c tr_seri(i,k,9)=1.
521	c endif
522	c endif
523	c endif
524	c else
525	c tr_seri(i,k,9)=0.
526	c end do
527	c end do
528	c
529	c do i=1,klon
530	c do k=1,klev+1
531	cc tr_seri(i,k,10)=0.
532	c if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
533	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
534	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
535	c tr_seri(i,k,10)=1.
536	c endif
537	c endif
538	c endif
539	c else
540	c tr_seri(i,k,10)=0.
541	c end do
542	c end do
543	c
544	c do i=1,klon
545	c do k=1,klev+1
546	cc tr_seri(i,k,11)=0.
547	c if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
548	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
549	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
550	c tr_seri(i,k,11)=1.
551	c endif
552	c endif
553	c endif
554	c else
555	c tr_seri(i,k,11)=0.
556	c end do
557	c end do
558	c
559	c do i=1,klon
560	c do k=1,klev+1
561	cc tr_seri(i,k,12)=0.
562	c if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
563	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
564	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
565	c tr_seri(i,k,12)=1.
566	c endif
567	c endif
568	c endif
569	c else
570	c tr_seri(i,k,12)=0.
571	c end do
572	c end do
573	c
574	c entre 20-30 km
575	c
576	c do i=1,klon
577	c do k=1,klev+1
578	cc tr_seri(i,k,13)=0.
579	c if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
580	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
581	c if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
582	c tr_seri(i,k,13)=1.
583	c endif
584	c endif
585	c endif
586	c else
587	c tr_seri(i,k,13)=0.
588	c end do
589	c end do
590	c
591	c do i=1,klon
592	c do k=1,klev+1
593	cc tr_seri(i,k,14)=0.
594	c if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
595	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
596	c if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
597	c tr_seri(i,k,14)=1.
598	c endif
599	c endif
600	c endif
601	c else
602	c tr_seri(i,k,14)=0.
603	c end do
604	c end do
605	c
606	c do i=1,klon
607	c do k=1,klev+1
608	cc tr_seri(i,k,15)=0.
609	c if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
610	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
611	c if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
612	c tr_seri(i,k,15)=1.
613	c endif
614	c endif
615	c endif
616	c else
617	c tr_seri(i,k,15)=0.
618	c end do
619	c end do
620	c
621	c entre 55-65 km
622	c
623	c do i=1,klon
624	c do k=1,klev+1
625	cc tr_seri(i,k,16)=0.
626	c if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
627	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
628	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
629	c tr_seri(i,k,16)=1.
630	c endif
631	c endif
632	c endif
633	c endif
634	c else
635	c tr_seri(i,k,16)=0.
636	c end do
637	c end do
638	c
639	c do i=1,klon
640	c do k=1,klev+1
641	cc tr_seri(i,k,17)=0.
642	c if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
643	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
644	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
645	c tr_seri(i,k,17)=1.
646	c endif
647	c endif
648	c endif
649	c endif
650	c else
651	c tr_seri(i,k,17)=0.
652	c end do
653	c end do
654	c
655	c do i=1,klon
656	c do k=1,klev+1
657	cc tr_seri(i,k,18)=0.
658	c if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
659	c if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
660	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
661	c tr_seri(i,k,18)=1.
662	c endif
663	c endif
664	c endif
665	c endif
666	c else
667	c tr_seri(i,k,18)=0.
668	c end do
669	c end do
670	c
671	c b) traceur a une bande en latitudeOK
672	c
673	c a 65km
674	c
675	c do i=1,klon
676	c tr_seri(i,:,1)=0.
677	c if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
678	c tr_seri(i,20,1)=1.
679	c endif
680	c end do
681	c
682	c do i=1,klon
683	c tr_seri(i,:,2)=0.
684	c if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
685	c tr_seri(i,20,2)=1.
686	c endif
687	c end do
688	c
689	c do i=1,klon
690	c tr_seri(i,:,3)=0.
691	c if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
692	c tr_seri(i,20,3)=1.
693	c endif
694	c end do
695	c
696	c do i=1,klon
697	c tr_seri(i,:,4)=0.
698	c if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
699	c tr_seri(i,20,4)=1.
700	c endif
701	c end do
702	c
703	c do i=1,klon
704	c tr_seri(i,:,5)=0.
705	c if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
706	c tr_seri(i,20,5)=1.
707	c endif
708	c end do
709	c
710	c do i=1,klon
711	c tr_seri(i,:,6)=0.
712	c if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
713	c tr_seri(i,20,6)=1.
714	c endif
715	c end do
716	c
717	c do i=1,klon
718	c tr_seri(i,:,7)=0.
719	c if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
720	c tr_seri(i,20,7)=1.
721	c endif
722	c end do
723	c
724	c do i=1,klon
725	c tr_seri(i,:,8)=0.
726	c if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
727	c tr_seri(i,20,8)=1.
728	c endif
729	c end do
730	c
731	c a 50km
732	c
733	c do i=1,klon
734	c tr_seri(i,:,1)=0.
735	c if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
736	c tr_seri(i,27,1)=1.
737	c endif
738	c end do
739	c
740	c do i=1,klon
741	c tr_seri(i,:,2)=0.
742	c if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
743	c tr_seri(i,27,2)=1.
744	c endif
745	c end do
746	c
747	c do i=1,klon
748	c tr_seri(i,:,3)=0.
749	c if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
750	c tr_seri(i,27,3)=1.
751	c endif
752	c end do
753	c
754	c do i=1,klon
755	c tr_seri(i,:4)=0.
756	c if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
757	c tr_seri(i,27,4)=1.
758	c endif
759	c end do
760	c
761	c do i=1,klon
762	c tr_seri(i,:,5)=0.
763	c if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
764	c tr_seri(i,27,5)=1.
765	c endif
766	c end do
767	c
768	c do i=1,klon
769	c tr_seri(i,:,6)=0.
770	c if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
771	c tr_seri(i,27,6)=1.
772	c endif
773	c end do
774	c
775	c do i=1,klon
776	c tr_seri(i,:,7)=0.
777	c if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
778	c tr_seri(i,27,7)=1.
779	c endif
780	c end do
781	c
782	c do i=1,klon
783	c tr_seri(i,:,8)=0.
784	c if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
785	c tr_seri(i,27,8)=1.
786	c endif
787	c end do
788	c
789	c c) traceur a plusieurs bandes en latitude OK
790	c
791	c do i=1,klon
792	c tr_seri(i,:,2)=0.
793	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
794	c tr_seri(i,10,2)=1.
795	c endif
796	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
797	c tr_seri(i,10,2)=1.
798	c endif
799	c
800	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
801	c tr_seri(i,10,2)=1.
802	c endif
803	c end do
804	c
805	c d) traceur a une bande en altitude OK
806	c
807	c do k=1,klev+1
808	c tr_seri(:,k,1)=0.
809	c if ((pplay(klon/2,k)>=1.e5).and.(pplay(klon/2,k)<=1.e6)) then
810	c tr_seri(:,k,1)=1.
811	c endif
812	c end do
813	c
814	c dbis) plusieurs traceurs a une bande en altitude OK
815	c
816	c bande tres basse tropo
817	c do k=1,klev
818	c tr_seri(:,k,1)=0.
819	c if ((pplay(klon/2,k)>=5.e5).and.(pplay(klon/2,k)<=5.e6)) then
820	c tr_seri(:,k,1)=1.
821	c endif
822	c end do
823	c bande dans les nuages et un peu en-dessous
824	c do k=1,klev
825	c tr_seri(:,k,2)=0.
826	c if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=5.e5)) then
827	c tr_seri(:,k,2)=1.
828	c endif
829	c end do
830	cune grosse epaisseur: inclue toute la circulation meridienne
831	c do k=1,klev
832	c tr_seri(:,k,1)=0.
833	c if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e6)) then
834	c tr_seri(:,k,1)=1.
835	c endif
836	c end do
837	cune grosse epaisseur: inclue la mesosphere
838	c do k=1,klev
839	c tr_seri(:,k,2)=0.
840	c if ((pplay(klon/2,k)>=2.e2).and.(pplay(klon/2,k)<=1.e4)) then
841	c tr_seri(:,k,2)=1.
842	c endif
843	c end do
844	c
845	c do k=1,klev
846	c tr_seri(:,k,3)=0.
847	c if ((pplay(klon/2,k)>=5.e1).and.(pplay(klon/2,k)<=5.e2)) then
848	c tr_seri(:,k,3)=1.
849	c endif
850	c end do
851	c
852	c e) plusieurs couches verticales de traceurs, a plusieurs bandes en latitude???
853	c
854	c au sol
855	c do i=1,klon
856	c tr_seri(i,:,1)=0.
857	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
858	c tr_seri(i,5,1)=1.
859	c endif
860	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
861	c tr_seri(i,5,1)=1.
862	c endif
863	c
864	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
865	c tr_seri(i,5,1)=1.
866	c endif
867	c end do
868	c
869	c do i=1,klon
870	c tr_seri(i,:,2)=0.
871	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
872	c tr_seri(i,10,2)=1.
873	c endif
874	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
875	c tr_seri(i,10,2)=1.
876	c endif
877	c
878	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
879	c tr_seri(i,10,2)=1.
880	c endif
881	c end do
882	c
883	c do i=1,klon
884	c tr_seri(i,:,3)=0.
885	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
886	c tr_seri(i,30,3)=1.
887	c endif
888	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
889	c tr_seri(i,30,3)=1.
890	c endif
891	c
892	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
893	c tr_seri(i,30,3)=1.
894	c endif
895	c end do
896	c
897	c do i=1,klon
898	c tr_seri(i,:,4)=0.
899	c if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
900	c tr_seri(i,45,4)=1.
901	c endif
902	c if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
903	c tr_seri(i,45,4)=1.
904	c endif
905	c
906	c if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
907	c tr_seri(i,45,4)=1.
908	c endif
909	c end do
910	c
911

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

Download in other formats:

Original Format