source: trunk/libf/phyvenus/phytrac.F @ 100

Last change on this file since 100 was 97, checked in by slebonnois, 14 years ago

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