Context Navigation

phytrac.F @ 937

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

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

Download in other formats:

Original Format