source: trunk/LMDZ.TITAN/libf/phytitan/sources.F @ 222

         SUBROUTINE sources(ngrid,nlay,
     $                      ptimestep,pz0,pu,pv,
     $                      pplev,pzlay,pzlev,
     $                      gaz1,gaz2,gaz3,
     $                      ptsrf,solesp,reserv)

c=======================================================================
c     Calcul des flux aux interfaces pour les sources
c     CH4 a la surface
c     Production de C2H6 en haut du modele.
c     Production de C2H2 en haut du modele.
c     
c     NOTE :
c     Les gaz ont la tete en haut. 
c     ils ne suivent pas la meme convention que muphys :
c     (1 -> sol  / klev = haut du modele)
c=======================================================================

c-----------------------------------------------------------------------
c   declarations:
c   -------------

         use dimphy
         IMPLICIT NONE
#include "dimensions.h"
#include "microtab.h"
#include "YOMCST.h"
c
c   arguments:
c   ----------

         INTEGER ngrid,nlay,nq,ihor
         REAL ptimestep
         REAL pplev(ngrid,nlay+1)
         REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
         REAL pu(ngrid),pv(ngrid)
         REAL gaz1(ngrid,nlay),gaz2(ngrid,nlay),gaz3(ngrid,nlay)
         REAL ptsrf(ngrid)
         REAL solesp(ngrid,klev+1,3)
c
c   local:
c   ------
 
         INTEGER ilev,ig,ilay,nlev,k,inch4,inc2h6

         REAL zgz1(klon,klev),zgz2(klon,klev),zgz3(klon,klev)
         REAL zcdv(klon),zu2,pz0
         REAL xmair,gg,zrho,ws,ch,qch4,flux
         REAL xmuair
         REAL zmem,zmem2,zmem3
         REAL prodc2h6,prodc2h2
         real reserv(ngrid),restemp,drestemp
         REAL evapch4

         real umin
         data umin/1.e-12/
         save umin

c
c-----------------------------------------------------------------------
c   initialisations:
c   -----------------

         nlev=nlay+1

         if(nlay.ne.klev) THEN
           PRINT*,'STOP dans sources.F'
           PRINT*,'probleme de dimensions :'
           PRINT*,'nlay  =',nlay
           PRINT*,'klev  =',klev
           STOP
         endif

         IF(ngrid.NE.klon) THEN
           PRINT*,'STOP dans sources.F'
           PRINT*,'probleme de dimensions :'
           PRINT*,'ngrid  =',ngrid
           PRINT*,'klon  =',klon
           STOP
         ENDIF

         zgz1 = gaz1
         zgz2 = gaz2
         zgz3 = gaz3

c-----------------------------------------------------------------------
c     2. calcul de  cd :
c     ----------------
c
         DO ig=1,ngrid
           zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin
           zcdv(ig)=pz0*(1.+sqrt(zu2))
c           write(99,'(I4,3(ES24.17,1X))') ig,
c     &     pz0,zu2,(1.+sqrt(zu2))
         ENDDO
c          write(99,*) ""

c-----------------------------------------------------------------------
c    4. Conditions aux limites pour CH4 et C2H6
c    -------------------------------------------
c

*   Conditions CH4
         DO ig=1,ngrid
           evapch4=0.
           restemp=0.
           gg=RG*RA**2/(RA+pzlay(ig,1))**2.
           zrho=(pplev(ig,1)-pplev(ig,2))/gg
           zrho=zrho/(pzlev(ig,2)-pzlev(ig,1))
           ws=sqrt(pu(ig)**2.+pv(ig)**2.)*(10./pzlay(ig,1))**0.2
           ch=1.5*sqrt(zcdv(ig))
c           write(100,'(I4,3(ES24.17,1X))')
c     &     ig,sqrt(pu(ig)**2.+pv(ig)**2.),
c     &     (10./pzlay(ig,1))**0.2,ws
           call ch4sat(ptsrf(ig),pplev(ig,1),qch4) ! qch4=kg/kg
           qch4=qch4*0.50 ! ici on impose 50% d'humidité au sol 
        
           if(reserv(ig).le. 1.e-10 ) then  
             flux=0.
             reserv(ig)=1.e-10
           else
             flux=zrho*ch*ws
             flux=flux*0.1 ! fraction occupée par les lacs 
           endif
c           write(101,'(I4,5(ES24.17,1X))') 
c     &     ig,reserv(ig),ws,ch,zrho,(pzlev(ig,1+1)-pzlev(ig,1))
c           flux=flux/zrho/(pzlev(ig,1+1)-pzlev(ig,1)) ! dx/ds

           zmem=zgz1(ig,1)
           zgz1(ig,1)=(zgz1(ig,1)+flux*ptimestep*qch4*28./16.)
     &                /(1.+flux*ptimestep)

           gg=RG!*RA**2/(RA+pzlay(ig,1))**2.
           xmair=(pplev(ig,1)-pplev(ig,1+1))/gg
           xmair=xmair/(pzlev(ig,1+1)-pzlev(ig,1))
           xmuair=28.!*(1.-zmem)+zmem*16.

           drestemp = - (zgz1(ig,1)-zmem)*xmair ! en m3/m2=m
     &     *(pzlev(ig,2)-pzlev(ig,1))*16./xmuair/425.

c           ici on peut fixer un seuil sur drestemp 
c           (ie limiter l'echange atm/surface)
      
           restemp=reserv(ig) +drestemp

           IF (restemp.ge.0.) THEN 
             reserv(ig) = reserv(ig) + drestemp
             evapch4    = evapch4    + drestemp
           ELSE
*          Il n'y a pas suffisamment de méthane; on re-évalue le flux d'évaporation
*          Quelle nouvelle concentration zgz1(ig,1) atteint-on en évaporant tout ?
             zgz1(ig,1)=reserv(ig)/(xmair*(pzlev(ig,1+1)-pzlev(ig,1))
     &                 *16./xmuair/425.)+zmem
             evapch4=evapch4-reserv(ig)

             if(reserv(ig).eq.0.) 
     &       print*,'assechement du sol en ig=', ig,reserv(ig),flux

             reserv(ig)=0.  ! on a tout évaporé...
           ENDIF
c         
           solesp(ig,klev+1,1)=solesp(ig,klev+1,1)+evapch4  ! <0 si volume évaporé (m3/m2)

c         write(498,'(I3,4(ES24.17,1X))') ig,gaz1(ig,1),zgz1(ig,1),flux
         ENDDO
c         write(498,*) "" 
c         write(101,*) "" 
*   Conditions C2H6

         prodc2h6=6.e-12/5. ! kg/m2/s
 
         IF (1.EQ.1) THEN
           DO ig=1,ngrid
             DO ilev=nlay,nlay-4,-1
*            calcule de zrho (kg/m3) pour la couche...
               gg=RG*RA**2/(RA+pzlay(ig,ilev))**2.
               zrho=(pplev(ig,ilev)-pplev(ig,ilev+1))/gg
               zrho=zrho/(pzlev(ig,ilev+1)-pzlev(ig,ilev))

*              passage taux de production --> Dx_c2h6 a rajouter au niveau ilev
               zmem2=zgz2(ig,ilev)
               zgz2(ig,ilev)=zgz2(ig,ilev)+
     &         prodc2h6*ptimestep/
     &         abs(pzlev(ig,ilev+1)-pzlev(ig,ilev))    !  kg/m3/s
     &         /zrho*28./30.

             ENDDO
           ENDDO

         ELSE

           DO ig=1,ngrid
             DO ilev=nlay,nlay-8,-1
               zgz2(ig,ilev)=1.2e-5
             ENDDO
           ENDDO

         ENDIF  ! (fin 1.eq.0)

*-------------------------------------
*   Conditions C2H2

         prodc2h2=1.6e-12/5. ! kg/m2/s

         IF(1  .EQ.  1) THEN 

           DO ig=1,ngrid
             DO ilev=nlay,nlay-4,-1
*            calcule de zrho (kg/m3) pour la couche...
                gg=RG*RA**2/(RA+pzlay(ig,ilev))**2.
                zrho=(pplev(ig,ilev)-pplev(ig,ilev+1))/gg
                zrho=zrho/(pzlev(ig,ilev+1)-pzlev(ig,ilev))

*            passage taux de production --> Dx_c2h2 a rajouter au niveau ilev
                zmem3=zgz3(ig,ilev)
                zgz3(ig,ilev)=zgz3(ig,ilev)+
     &          (prodc2h2)*ptimestep/
     &          abs(pzlev(ig,ilev+1)-pzlev(ig,ilev))  !  kg/m3/s
     &          /zrho*28./26.

             ENDDO

           ENDDO

         ENDIF

c-----------------------------------------------------------------------
         DO ig=1,ngrid
           DO ilev=1,nlay
             gaz1(ig,ilev)=zgz1(ig,ilev)
             gaz2(ig,ilev)=zgz2(ig,ilev)
             gaz3(ig,ilev)=zgz3(ig,ilev)
           ENDDO
         ENDDO

        RETURN
        END