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

Last change on this file since 86 was 3, checked in by slebonnois, 15 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: 25.8 KB
RevLine 
[3]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
29      IMPLICIT none
30c======================================================================
31c Auteur(s) FH
32c Objet: Moniteur general des tendances traceurs
33c
34cAA Remarques en vrac:
35cAA--------------------
36cAA 1/ le call phytrac se fait avec nqmax
37c======================================================================
38#include "YOMCST.h"
39#include "dimensions.h"
40#include "dimphy.h"
41#include "clesphys.h" !///utile?
42#include "temps.h"
43#include "paramet.h"
44#include "control.h"
45#include "comgeomphy.h"
46#include "advtrac.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,nqmx)
127c      real pzero,gamma
128c      parameter (pzero=85000.)
129c      parameter (gamma=5000.)
130      REAL alpha
131      real deltatr(klon,klev,nqmx) ! ecart au profil de ref zprof
132      real tau(klev,nqmx)          ! 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.