source: trunk/LMDZ.VENUS/libf/phyvenus/phytrac_emiss.F @ 1314

Last change on this file since 1314 was 1305, checked in by slebonnois, 11 years ago

SL: VENUS PHOTOCHEMISTRY. Needs Lapack (see arch files...)

File size: 6.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!
4c
5c
6      SUBROUTINE phytrac_emiss (timesimu,
7     I                    debutphy,
8     I                    lafin,
9     I                    nqmax,
10     I                    nlon,
11     I                    nlev,
12     I                    pdtphys,
13     I                    paprs,
14     I                    xlat,xlon,
15     O                    tr_seri)
16
17c======================================================================
18c Auteur(s) FH
19c Objet: Moniteur general des tendances traceurs
20c
21cAA Remarques en vrac:
22cAA--------------------
23cAA 1/ le call phytrac se fait avec nqmax
24c
25c SL: Janvier 2014
26c Version developed for surface emission
27c Maybe could be used just to compute the 'source' variable from physiq
28c
29c======================================================================
30      USE ioipsl
31      USE infotrac
32      USE control_mod
33      use dimphy
34      USE comgeomphy
35      IMPLICIT none
36#include "YOMCST.h"
37#include "dimensions.h"
38#include "clesphys.h"
39#include "temps.h"
40#include "paramet.h"
41c======================================================================
42
43c Arguments:
44
45c   EN ENTREE:
46c   ==========
47
48      real timesimu   ! duree depuis debut simu (s)
49      logical debutphy       ! le flag de l'initialisation de la physique
50      logical lafin          ! le flag de la fin de la physique
51      integer nqmax ! nombre de traceurs auxquels on applique la physique
52      integer nlon  ! nombre de points horizontaux
53      integer nlev  ! nombre de couches verticales
54      real pdtphys  ! pas d'integration pour la physique (seconde)
55      real paprs(nlon,nlev+1)  ! pression pour chaque inter-couche (en Pa)
56      REAL xlat(nlon)       ! latitudes pour chaque point
57      REAL xlon(nlon)       ! longitudes pour chaque point
58
59c   EN ENTREE/SORTIE:
60c   =================
61
62      real tr_seri(nlon,nlev,nqmax) ! traceur 
63
64cAA ----------------------------
65cAA  VARIABLES LOCALES TRACEURS
66cAA ----------------------------
67
68C les traceurs
69
70c===================
71c it--------indice de traceur
72c k,i---------indices long, vert
73c===================
74c pour emission volcan
75      real :: deltatr(klon,klev,nqtot)
76
77      integer,parameter :: nbsrc=2,nblat=5,nblon=4
78!     integer,parameter :: Nemiss=1   ! duree emission (Ed)
79      integer,save :: Nemiss(nbsrc)      ! duration emission (Ed)
80      real,save :: source_volcan(nbsrc)  ! flux emission (kg/s)
81      real,save :: lat_volcan(nblat),lon_volcan(nblon)
82      real,save :: area_emiss(nblat,nblon)
83      integer,save :: ig_volcan(nblat,nblon)
84
85c======================================================================
86
87      INTEGER i, k, it
88      integer ilat,ilon,iemiss
89      real    deltalat,deltalon
90
91c Variables liees a l'ecriture de la bande histoire physique
92
93c Variables locales pour effectuer les appels en serie
94c----------------------------------------------------
95
96      REAL d_tr(nlon,nlev) ! tendances de traceurs
97
98      character*20 modname
99      character*80 abort_message
100
101c======================================================================
102
103      modname = 'phytrac_emiss'
104c EMISSION TRACEURS
105
106c---------
107c debutphy
108c---------
109      if (debutphy) then
110         print*,"DEBUT PHYTRAC"
111         print*,"PHYTRAC: EMISSION"
112
113c=============================================================
114c=============================================================
115c=============================================================
116c   Initialisation des traceurs
117c=============================================================
118c=============================================================
119c=============================================================
120
121C=========================================================================
122C=========================================================================
123c Caracteristiques des traceurs emis:
124
125c nombre total de traceur
126         if (nbsrc*nblat*nblon .gt. nqtot) then
127            write(*,*) "Attention, pas assez de traceurs"
128            write(*,*) "le dernier sera bien le dernier"
129         endif
130
131c source en kg/s
132         source_volcan(1) = 1.
133         source_volcan(2) = 1000.
134c duration in Ed
135         Nemiss(1) = 1
136         Nemiss(2) = 10
137c localisation volcan
138         lat_volcan(1) =  70.
139         lat_volcan(2) =  35.
140         lat_volcan(3) =   0.
141         lat_volcan(4) = -35.
142         lat_volcan(5) = -70.
143         lon_volcan(1) = -120.
144         lon_volcan(2) =  -30.
145         lon_volcan(3) =   60.
146         lon_volcan(4) =  150.
147
148         deltalat = 180./jjm
149         deltalon = 360./jjm
150         do i=1,nlon
151          do ilat=1,nblat
152           do ilon=1,nblon
153            if ((xlat(i).ge.lat_volcan(ilat))
154     &     .and.((xlat(i)-deltalat).lt.lat_volcan(ilat))
155     &     .and.(xlon(i).le.lon_volcan(ilon))
156     &     .and.((xlon(i)+deltalon).gt.lon_volcan(ilon)) ) then
157             ig_volcan(ilat,ilon)= i
158             area_emiss(ilat,ilon) = airephy(i)
159            endif
160           enddo
161          enddo
162         enddo
163
164C=========================================================================
165C=========================================================================
166
167c-------------
168c fin debutphy
169c-------------
170      ENDIF  ! fin debutphy
171
172c======================================================================
173c Emission d'un traceur pendant un certain temps
174c======================================================================
175         do i = 1,nlon
176          do iemiss = 1,nbsrc
177           do ilat  = 1,nblat
178            do ilon  = 1,nblon
179             it=(iemiss-1)*nblat*nblon+(ilat-1)*nblon+ilon
180             it=min(it,nqtot)
181             deltatr(i,1,it) = 0.
182
183             if (i .eq. ig_volcan(ilat,ilon)) then
184
185c source appliquee pendant Nemiss Ed
186               if (timesimu .lt. 86400.*Nemiss(iemiss)) then
187
188c source en kg/kg/s
189           deltatr(i,1,it) = source_volcan(iemiss)*RG
190     $     /(area_emiss(ilat,ilon)*(paprs(i,1) - paprs(i,2)))
191           tr_seri(i,1,it) = tr_seri(i,1,it) + deltatr(i,1,it)*pdtphys
192
193               end if  ! duree emission
194             end if ! i localisation
195            end do
196           end do
197          end do
198         end do
199c======================================================================
200c======================================================================
201
202      RETURN
203      END
Note: See TracBrowser for help on using the repository browser.