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

!
! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phytrac.F,v 1.16 2006/03/24 15:06:23 lmdzadmin Exp $
!
c
c
      SUBROUTINE phytrac_emiss (timesimu,
     I                    debutphy,
     I                    lafin,
     I                    nqmax,
     I                    nlon,
     I                    nlev, 
     I                    pdtphys,
     I                    paprs,
     I                    xlat,xlon,
     O                    tr_seri)

c======================================================================
c Auteur(s) FH
c Objet: Moniteur general des tendances traceurs
c
cAA Remarques en vrac:
cAA--------------------
cAA 1/ le call phytrac se fait avec nqmax 
c
c SL: Janvier 2014
c Version developed for surface emission
c Maybe could be used just to compute the 'source' variable from physiq
c
c======================================================================
      USE ioipsl
      USE infotrac
      USE control_mod
      use dimphy
      USE comgeomphy
      IMPLICIT none
#include "YOMCST.h"
#include "dimensions.h"
#include "clesphys.h"
#include "paramet.h"
c======================================================================

c Arguments:

c   EN ENTREE:
c   ==========

      real timesimu   ! duree depuis debut simu (s)
      logical debutphy       ! le flag de l'initialisation de la physique
      logical lafin          ! le flag de la fin de la physique
      integer nqmax ! nombre de traceurs auxquels on applique la physique
      integer nlon  ! nombre de points horizontaux
      integer nlev  ! nombre de couches verticales
      real pdtphys  ! pas d'integration pour la physique (seconde)
      real paprs(nlon,nlev+1)  ! pression pour chaque inter-couche (en Pa)
      REAL xlat(nlon)       ! latitudes pour chaque point 
      REAL xlon(nlon)       ! longitudes pour chaque point 

c   EN ENTREE/SORTIE:
c   =================

      real tr_seri(nlon,nlev,nqmax) ! traceur  

cAA ----------------------------
cAA  VARIABLES LOCALES TRACEURS
cAA ----------------------------

C les traceurs

c===================
c it--------indice de traceur
c k,i---------indices long, vert
c===================
c pour emission volcan
      real :: deltatr(klon,klev,nqtot)

      integer,parameter :: nbsrc=2,nblat=5,nblon=4
!     integer,parameter :: Nemiss=1   ! duree emission (Ed)
      integer,save :: Nemiss(nbsrc)      ! duration emission (Ed)
      real,save :: source_volcan(nbsrc)  ! flux emission (kg/s)
      real,save :: lat_volcan(nblat),lon_volcan(nblon)
      real,save :: area_emiss(nblat,nblon)
      integer,save :: ig_volcan(nblat,nblon)

c======================================================================

      INTEGER i, k, it
      integer ilat,ilon,iemiss
      real    deltalat,deltalon

c Variables liees a l'ecriture de la bande histoire physique

c Variables locales pour effectuer les appels en serie
c----------------------------------------------------

      REAL d_tr(nlon,nlev) ! tendances de traceurs 

      character*20 modname
      character*80 abort_message

c======================================================================

      modname = 'phytrac_emiss'
c EMISSION TRACEURS 

c---------
c debutphy
c---------
      if (debutphy) then
         print*,"DEBUT PHYTRAC"
         print*,"PHYTRAC: EMISSION"

c=============================================================
c=============================================================
c=============================================================
c   Initialisation des traceurs
c=============================================================
c=============================================================
c=============================================================

C=========================================================================
C=========================================================================
c Caracteristiques des traceurs emis:

c nombre total de traceur
         if (nbsrc*nblat*nblon .gt. nqtot) then
            write(*,*) "Attention, pas assez de traceurs"
            write(*,*) "le dernier sera bien le dernier"
         endif

c source en kg/s
         source_volcan(1) = 1.
         source_volcan(2) = 1000.
c duration in Ed
         Nemiss(1) = 1
         Nemiss(2) = 10
c localisation volcan
         lat_volcan(1) =  70.
         lat_volcan(2) =  35.
         lat_volcan(3) =   0.
         lat_volcan(4) = -35.
         lat_volcan(5) = -70.
         lon_volcan(1) = -120.
         lon_volcan(2) =  -30.
         lon_volcan(3) =   60.
         lon_volcan(4) =  150.

         deltalat = 180./jjm
         deltalon = 360./jjm
         do i=1,nlon
          do ilat=1,nblat
           do ilon=1,nblon
            if ((xlat(i).ge.lat_volcan(ilat))
     &     .and.((xlat(i)-deltalat).lt.lat_volcan(ilat))
     &     .and.(xlon(i).le.lon_volcan(ilon))
     &     .and.((xlon(i)+deltalon).gt.lon_volcan(ilon)) ) then
             ig_volcan(ilat,ilon)= i
             area_emiss(ilat,ilon) = airephy(i)
            endif
           enddo
          enddo
         enddo

C=========================================================================
C=========================================================================

c-------------
c fin debutphy
c-------------
      ENDIF  ! fin debutphy 

c======================================================================
c Emission d'un traceur pendant un certain temps
c======================================================================
         do i = 1,nlon
          do iemiss = 1,nbsrc
           do ilat  = 1,nblat
            do ilon  = 1,nblon
             it=(iemiss-1)*nblat*nblon+(ilat-1)*nblon+ilon
             it=min(it,nqtot)
             deltatr(i,1,it) = 0.

             if (i .eq. ig_volcan(ilat,ilon)) then

c source appliquee pendant Nemiss Ed
               if (timesimu .lt. 86400.*Nemiss(iemiss)) then

c source en kg/kg/s
           deltatr(i,1,it) = source_volcan(iemiss)*RG
     $     /(area_emiss(ilat,ilon)*(paprs(i,1) - paprs(i,2)))
           tr_seri(i,1,it) = tr_seri(i,1,it) + deltatr(i,1,it)*pdtphys

               end if  ! duree emission
             end if ! i localisation
            end do
           end do
          end do
         end do
c======================================================================
c======================================================================

      RETURN
      END