source: trunk/LMDZ.VENUS/libf/phyvenus/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
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
27c======================================================================
28c Auteur(s) FH
29c Objet: Moniteur general des tendances traceurs
30c
31cAA Remarques en vrac:
32cAA--------------------
33cAA 1/ le call phytrac se fait avec nqmax
34c======================================================================
[101]35      USE ioipsl
36      USE infotrac
37      USE control_mod
38      use dimphy
39      USE comgeomphy
40      IMPLICIT none
[3]41#include "YOMCST.h"
42#include "dimensions.h"
43#include "clesphys.h" !///utile?
44#include "temps.h"
45#include "paramet.h"
46c======================================================================
47
48c Arguments:
49c
50c   EN ENTREE:
51c   ==========
52c
53c   divers:
54c   -------
55c
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
61c      integer julien !jour julien
62c      integer itop_con(nlon)
63c      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
81c      REAL flxmass_w(nlon,nlev)
82
83cAA ----------------------------
84cAA  VARIABLES LOCALES TRACEURS
85cAA ----------------------------
86cAA
87
88C les traceurs
89C
90      logical flagCO_OCS
91c===================
92c it--------indice de traceur
93c k,i---------indices long, vert
94c===================
95c Variables deja declarees dont on a besoin pour traceurs   
96c   k,i,it,tr_seri(klon,klev,nqmax),pplay(nlon,nlev),
97      integer nqCO_OCS
98c      real pzero,gamma
99c      parameter (pzero=85000.)
100c      parameter (gamma=5000.)
101      REAL alpha
[97]102      real deltatr(klon,klev,nqtot) ! ecart au profil de ref zprof
[101]103      real,save,allocatable :: zprof(:,:)
104      real,save,allocatable :: tau(:,:) ! temps de relaxation vers le profil (s)
[3]105c======================================================================
106c
107c Declaration des procedures appelees
108c
109c--modif convection tiedtke
110      INTEGER i, k, it
111      INTEGER iq, iiq
112      REAL delp(klon,klev)
113c--end modif
114c
115c Variables liees a l'ecriture de la bande histoire physique
116c
117c Variables locales pour effectuer les appels en serie
118c----------------------------------------------------
119c
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
123C
[101]124      character*20 modname
[3]125      character*80 abort_message
126c
127c   Controles
128c-------------
129      logical first,couchelimite,convection
130      save first,couchelimite,convection
131c Olivia
132       data first,couchelimite,convection
133     s     /.true.,.false.,.false./
134
[101]135      modname = 'phytrac'
[3]136c======================================================================
[101]137
138       if(first) then
139         allocate(zprof(klev,nqtot),tau(klev,nqtot))
140         first = .false.
141       endif
142
[3]143         ps(:)=paprs(:,1)
144c 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
152c---------
153c debutphy
154c---------
155         if (debutphy) then
156                 print*,"DEBUT PHYTRAC"
157C         
158c=============================================================
159c=============================================================
160c=============================================================
161c   Initialisation des traceurs
162c=============================================================
163c=============================================================
164c=============================================================
165c
166c=============================================================
167c=============================================================
168
169C=========================================================================
170C=========================================================================
171      if (flagCO_OCS) then
172c II) Declaration d'un profil vertical de traceur OK
173c
174c zprof   = profil de rappel
175c
176c 1 -> CO ; 2 -> OCS
177c def des profils en log(a) = a * log(P) + b par morceaux, cf. pollack et al
178c tr_seri en ppm
179c (initialisation seulement si ceux-ci sont nuls)
180
181c ICI, ON UTILISE 3 CONSTANTES DE TEMPS DIFFERENTES POUR CHAQUE,
182c DONC TRACEURS 1 A 3 POUR CO ET 4 A 6 POUR OCS
183C=========================================================================
184
185
186c 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
198c CO
199
200      do it=1,3
201       print*,"INIT ZPROF ",tname(it)
202       do k=1,klev
203         zprof(k,it)=0.
204c 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 
239c 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
271c 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
285C=========================================================================
286      endif  ! flagCO_OCS
287C=========================================================================
288C=========================================================================
289
290c-------------
291c fin debutphy
292c-------------
293      ENDIF  ! fin debutphy
294
295c======================================================================
296      if (flagCO_OCS) then
297c Rappel vers un profil
298c======================================================================
299         do it=1,nqCO_OCS
300           do k=1,klev
301             do i=1,klon
302c VERIF
303           if (tr_seri(i,k,it).lt.0) then
304             print*,"Traceur negatif AVANT rappel:",i,k,it
305             stop
306           endif
307c 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
312c 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
318c FIN VERIF
319             enddo
320           enddo
321         enddo
322
323c======================================================================
324      endif  ! flagCO_OCS
325c======================================================================
326
327c======================================================================
328c   Calcul de l'effet de la couche limite remis directement dans physiq
329c======================================================================
330
331
332      RETURN
333      END
334     
335     
336c=========================================================================
337c=========================================================================
338c=========================================================================
339c ARCHIVES ===============================================================
340c=========================================================================
341c=========================================================================
342c=========================================================================
343
344c===========
345c definition de traceurs idealises
346c==========
347c
348c I) Declaration directe du traceur a altitude fixee
349c
350c a) traceur en carre OK
351c
352c         do i=1,klon
353c         tr_seri(i,:,1)=0.
354c        if ((xlat(i)>=0.).and.(xlat(i)<=-30.)) then
355c          if ((xlon(i)>=0.).and.(xlon(i)<=40.)) then
356c              tr_seri(i,10,1)=1.
357c          endif
358c        endif
359c      end do
360c
361c a bis) 2 traceurs en carre lat/alt, uniforme en longitude OK
362c
363C entre 45-55 km
364c
365c         do i=1,klon
366c         do k=1,klev+1
367cc         tr_seri(i,k,1)=0.
368c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
369c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
370c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
371c               tr_seri(i,k,1)=1.
372c           endif
373c           endif
374c           endif
375c         else
376c            tr_seri(i,k,1)=0.
377c         end do
378c         end do
379cc
380c         do i=1,klon
381c         do k=1,klev+1
382cc         tr_seri(i,k,2)=0.
383c           if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
384c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
385c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
386c               tr_seri(i,k,2)=1.
387c           endif
388c           endif
389c           endif
390c         else
391c            tr_seri(i,k,2)=0.
392c         end do
393c         end do
394cc
395c         do i=1,klon
396c         do k=1,klev+1
397cc         tr_seri(i,k,3)=0.
398c           if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
399c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
400c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
401c               tr_seri(i,k,3)=1.
402c           endif
403c           endif
404c           endif
405c         else
406c            tr_seri(i,k,3)=0.
407c         end do
408c         end do
409cc
410c         do i=1,klon
411c         do k=1,klev+1
412cc         tr_seri(i,k,4)=0.
413c           if ((xlat(i)>=-40.).and.(xlat(i)<=-60.)) then
414c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
415c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
416c               tr_seri(i,k,4)=1.
417c           endif
418c           endif
419c           endif
420c         else
421c            tr_seri(i,k,4)=0.
422c         end do
423c         end do
424cc
425c         do i=1,klon
426c         do k=1,klev+1
427cc         tr_seri(i,k,5)=0.
428c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
429c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
430c           if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=4.e5)) then
431c              tr_seri(i,k,5)=1.
432c           endif
433c           endif
434c           endif
435c         else
436c            tr_seri(i,k,5)=0.
437c         end do
438c         end do
439c
440c entre 35-45 km
441c
442c         do i=1,klon
443c         do k=1,klev+1
444cc         tr_seri(i,k,6)=0.
445c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
446c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
447c           if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
448c               tr_seri(i,k,6)=1.
449c           endif
450c           endif
451c           endif
452c         else
453c            tr_seri(i,k,6)=0.
454c         end do
455c         end do
456c
457c         do i=1,klon
458c         do k=1,klev+1
459cc         tr_seri(i,k,7)=0.
460c           if ((xlat(i)>=-60.).and.(xlat(i)<=-80.)) then
461c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
462c           if ((pplay(klon/2,k)>=4.e5).and.(pplay(klon/2,k)<=8.e6)) then
463c               tr_seri(i,k,7)=1.
464c           endif
465c           endif
466c           endif
467c         else
468c            tr_seri(i,k,7)=0.
469c         end do
470c         end do
471c
472C entre 50-60 km
473c
474c         do i=1,klon
475c         do k=1,klev+1
476cc         tr_seri(i,k,8)=0.
477c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
478c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
479c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
480c               tr_seri(i,k,8)=1.
481c           endif
482c           endif
483c          endif
484c         else
485c            tr_seri(i,k,8)=0.
486c         end do
487c         end do
488c
489c         do i=1,klon
490c         do k=1,klev+1
491cc         tr_seri(i,k,9)=0.
492c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
493c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
494c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
495c               tr_seri(i,k,9)=1.
496c           endif
497c           endif
498c           endif
499c         else
500c            tr_seri(i,k,9)=0.
501c         end do
502c         end do
503c
504c         do i=1,klon
505c         do k=1,klev+1
506cc         tr_seri(i,k,10)=0.
507c           if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
508c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
509c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
510c               tr_seri(i,k,10)=1.
511c           endif
512c           endif
513c           endif
514c         else
515c            tr_seri(i,k,10)=0.
516c         end do
517c         end do
518c
519c         do i=1,klon
520c         do k=1,klev+1
521cc         tr_seri(i,k,11)=0.
522c           if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
523c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
524c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
525c               tr_seri(i,k,11)=1.
526c           endif
527c           endif
528c           endif
529c         else
530c            tr_seri(i,k,11)=0.
531c         end do
532c         end do
533c
534c         do i=1,klon
535c         do k=1,klev+1
536cc         tr_seri(i,k,12)=0.
537c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
538c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
539c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e5)) then
540c               tr_seri(i,k,12)=1.
541c           endif
542c           endif
543c           endif
544c         else
545c            tr_seri(i,k,12)=0.
546c         end do
547c         end do
548c
549c entre 20-30 km
550c
551c         do i=1,klon
552c         do k=1,klev+1
553cc         tr_seri(i,k,13)=0.
554c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
555c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
556c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
557c               tr_seri(i,k,13)=1.
558c           endif
559c           endif
560c           endif
561c         else
562c            tr_seri(i,k,13)=0.
563c         end do
564c         end do
565c
566c         do i=1,klon
567c         do k=1,klev+1
568cc         tr_seri(i,k,14)=0.
569c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
570c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
571c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
572c               tr_seri(i,k,14)=1.
573c           endif
574c           endif
575c           endif
576c         else
577c            tr_seri(i,k,14)=0.
578c         end do
579c         end do
580c
581c         do i=1,klon
582c         do k=1,klev+1
583cc         tr_seri(i,k,15)=0.
584c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
585c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
586c           if ((pplay(klon/2,k)>=1.e6).and.(pplay(klon/2,k)<=2.e6)) then
587c               tr_seri(i,k,15)=1.
588c           endif
589c           endif
590c           endif
591c         else
592c            tr_seri(i,k,15)=0.
593c         end do
594c         end do
595c
596c entre 55-65 km
597c
598c         do i=1,klon
599c         do k=1,klev+1
600cc         tr_seri(i,k,16)=0.
601c           if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
602c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
603c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
604c               tr_seri(i,k,16)=1.
605c           endif
606c           endif
607c           endif
608c           endif
609c         else
610c            tr_seri(i,k,16)=0.
611c         end do
612c         end do
613c
614c         do i=1,klon
615c         do k=1,klev+1
616cc         tr_seri(i,k,17)=0.
617c           if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
618c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
619c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
620c               tr_seri(i,k,17)=1.
621c          endif
622c          endif
623c           endif
624c           endif
625c         else
626c            tr_seri(i,k,17)=0.
627c         end do
628c         end do
629c
630c         do i=1,klon
631c         do k=1,klev+1
632cc         tr_seri(i,k,18)=0.
633c           if ((xlat(i)>=-20.).and.(xlat(i)<=20.)) then
634c           if ((xlon(i)>=-180.).and.(xlon(i)<=180.)) then
635c           if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=5.e4)) then
636c               tr_seri(i,k,18)=1.
637c           endif
638c           endif
639c           endif
640c           endif
641c         else
642c            tr_seri(i,k,18)=0.
643c         end do
644c         end do
645c
646c b) traceur a une bande en latitudeOK
647c
648c a 65km
649c
650c        do i=1,klon
651c         tr_seri(i,:,1)=0.
652c        if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
653c              tr_seri(i,20,1)=1.
654c        endif
655c      end do 
656c
657c        do i=1,klon
658c         tr_seri(i,:,2)=0.
659c        if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
660c              tr_seri(i,20,2)=1.
661c        endif
662c      end do 
663c
664c        do i=1,klon
665c         tr_seri(i,:,3)=0.
666c        if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
667c              tr_seri(i,20,3)=1.
668c        endif
669c      end do 
670c
671c        do i=1,klon
672c         tr_seri(i,:,4)=0.
673c        if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
674c              tr_seri(i,20,4)=1.
675c        endif
676c      end do 
677c
678c        do i=1,klon
679c         tr_seri(i,:,5)=0.
680c        if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
681c              tr_seri(i,20,5)=1.
682c        endif
683c      end do 
684c
685c        do i=1,klon
686c         tr_seri(i,:,6)=0.
687c        if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
688c              tr_seri(i,20,6)=1.
689c        endif
690c      end do 
691c
692c        do i=1,klon
693c         tr_seri(i,:,7)=0.
694c        if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
695c              tr_seri(i,20,7)=1.
696c        endif
697c      end do 
698c
699c        do i=1,klon
700c         tr_seri(i,:,8)=0.
701c        if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
702c              tr_seri(i,20,8)=1.
703c        endif
704c      end do 
705c
706c a 50km
707c
708c        do i=1,klon
709c        tr_seri(i,:,1)=0.
710c        if ((xlat(i)>=40.).and.(xlat(i)<=60.)) then
711c              tr_seri(i,27,1)=1.
712c        endif
713c      end do 
714c
715c        do i=1,klon
716c         tr_seri(i,:,2)=0.
717c        if ((xlat(i)>=60.).and.(xlat(i)<=80.)) then
718c              tr_seri(i,27,2)=1.
719c        endif
720c      end do 
721c
722c        do i=1,klon
723c         tr_seri(i,:,3)=0.
724c        if ((xlat(i)>=20.).and.(xlat(i)<=40.)) then
725c              tr_seri(i,27,3)=1.
726c        endif
727c      end do 
728c
729c        do i=1,klon
730c         tr_seri(i,:4)=0.
731c        if ((xlat(i)>=0.).and.(xlat(i)<=20.)) then
732c              tr_seri(i,27,4)=1.
733c       endif
734c      end do 
735c
736c        do i=1,klon
737c         tr_seri(i,:,5)=0.
738c        if ((xlat(i)>=-20.).and.(xlat(i)<=0.)) then
739c              tr_seri(i,27,5)=1.
740c        endif
741c      end do 
742c
743c        do i=1,klon
744c         tr_seri(i,:,6)=0.
745c        if ((xlat(i)>=-40.).and.(xlat(i)<=-20.)) then
746c              tr_seri(i,27,6)=1.
747c        endif
748c      end do 
749c
750c        do i=1,klon
751c         tr_seri(i,:,7)=0.
752c        if ((xlat(i)>=-60.).and.(xlat(i)<=-40.)) then
753c              tr_seri(i,27,7)=1.
754c        endif
755c      end do 
756c
757c        do i=1,klon
758c         tr_seri(i,:,8)=0.
759c        if ((xlat(i)>=-80.).and.(xlat(i)<=-60.)) then
760c              tr_seri(i,27,8)=1.
761c        endif
762c      end do 
763c
764c c) traceur a plusieurs bandes en latitude OK
765c
766c         do i=1,klon
767c        tr_seri(i,:,2)=0.
768c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
769c             tr_seri(i,10,2)=1.
770c        endif
771c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
772c              tr_seri(i,10,2)=1.
773c        endif
774c
775c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
776c              tr_seri(i,10,2)=1.
777c        endif         
778c      end do
779c
780c d) traceur a une bande en altitude OK
781c
782c       do k=1,klev+1
783c         tr_seri(:,k,1)=0.
784c         if ((pplay(klon/2,k)>=1.e5).and.(pplay(klon/2,k)<=1.e6)) then
785c             tr_seri(:,k,1)=1.
786c         endif
787c       end do
788c
789c dbis) plusieurs traceurs a une bande en altitude OK
790c
791c bande tres basse tropo
792c      do k=1,klev
793c        tr_seri(:,k,1)=0.
794c        if ((pplay(klon/2,k)>=5.e5).and.(pplay(klon/2,k)<=5.e6)) then
795c            tr_seri(:,k,1)=1.
796c        endif
797c      end do
798c bande dans les nuages et un peu en-dessous   
799c      do k=1,klev
800c         tr_seri(:,k,2)=0.
801c         if ((pplay(klon/2,k)>=5.e4).and.(pplay(klon/2,k)<=5.e5)) then
802c             tr_seri(:,k,2)=1.
803c         endif
804c       end do
805cune grosse epaisseur: inclue toute la circulation meridienne
806c      do k=1,klev
807c        tr_seri(:,k,1)=0.
808c        if ((pplay(klon/2,k)>=1.e4).and.(pplay(klon/2,k)<=1.e6)) then
809c            tr_seri(:,k,1)=1.
810c        endif
811c      end do
812cune grosse epaisseur: inclue la mesosphere
813c      do k=1,klev
814c         tr_seri(:,k,2)=0.
815c         if ((pplay(klon/2,k)>=2.e2).and.(pplay(klon/2,k)<=1.e4)) then
816c             tr_seri(:,k,2)=1.
817c         endif
818c       end do
819c
820c      do k=1,klev
821c        tr_seri(:,k,3)=0.
822c        if ((pplay(klon/2,k)>=5.e1).and.(pplay(klon/2,k)<=5.e2)) then
823c            tr_seri(:,k,3)=1.
824c        endif
825c      end do
826c
827c e) plusieurs couches verticales de traceurs, a plusieurs bandes en latitude???
828c       
829c au sol
830c         do i=1,klon
831c        tr_seri(i,:,1)=0.
832c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
833c             tr_seri(i,5,1)=1.
834c        endif
835c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
836c              tr_seri(i,5,1)=1.
837c        endif
838c
839c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
840c              tr_seri(i,5,1)=1.
841c        endif         
842c      end do
843c
844c         do i=1,klon
845c        tr_seri(i,:,2)=0.
846c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
847c             tr_seri(i,10,2)=1.
848c        endif
849c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
850c              tr_seri(i,10,2)=1.
851c      endif
852c
853c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
854c              tr_seri(i,10,2)=1.
855c        endif         
856c      end do
857c
858c         do i=1,klon
859c        tr_seri(i,:,3)=0.
860c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
861c             tr_seri(i,30,3)=1.
862c        endif
863c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
864c              tr_seri(i,30,3)=1.
865c        endif
866c
867c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
868c              tr_seri(i,30,3)=1.
869c        endif         
870c      end do
871c       
872c        do i=1,klon
873c        tr_seri(i,:,4)=0.
874c        if ((xlat(i)>=50.).and.(xlat(i)<=70.)) then
875c             tr_seri(i,45,4)=1.
876c        endif
877c        if ((xlat(i)>=-10.).and.(xlat(i)<=10.)) then
878c              tr_seri(i,45,4)=1.
879c        endif
880c
881c        if ((xlat(i)>=-70.).and.(xlat(i)<=-50.)) then
882c              tr_seri(i,45,4)=1.
883c        endif         
884c      end do
885c     
886
Note: See TracBrowser for help on using the repository browser.