source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/methox.F90 @ 4249

SUBROUTINE METHOX(KIDIA,  KFDIA,  KLON,  KLEV,PQ,     PTENQ,  PAP  &
#ifdef ISO      
        & ,Pxt,PTENxt &
#endif
        & )

!**** *METHOX*   - Calculate humidity tendencies from methane
!                  oxidation and photolysis

!**   INTERFACE.
!     ----------
!        CALL *METHOX* FROM *CALLPAR*
!              ------        -------

!        EXPLICIT ARGUMENTS :
!        --------------------
!     PARAMETER     DESCRIPTION                                   UNITS
!     ---------     -----------                                   -----
!     INPUT PARAMETERS (INTEGER):

!    *KIDIA*        START POINT
!    *KFDIA*        END POINT
!    *KLON*         NUMBER OF GRID POINTS PER PACKET
!    *KLEV*         NUMBER OF LEVELS

!     INPUT PARAMETERS (REAL):

!    *PAP*          PRESSURE                                      PA
!    *PQ*           SPECIFIC HUMIDITY                             KG/KG

!     UPDATED PARAMETERS (REAL):

!    *PTENQ*        TENDENCY OF SPECIFIC HUMIDITY                 KG/(KG*S)

!        NONE

!        IMPLICIT ARGUMENTS :
!        --------------------
!        MODULE YOEMETH
!        MODULE YOMCST

!     METHOD.
!     -------
!        SEE RD-MEMO R60.1/AJS/31

!     EXTERNALS.
!     ----------
!        NONE

!     REFERENCE.
!     ----------
!        SEE RD-MEMO R60.1/AJS/31

!     AUTHOR.
!     -------
!        C.JAKOB   *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 98-04-07
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        D. Cugnet     24-Feb-2012 Adapted for LMDZ
!     ------------------------------------------------------------------

USE YOEMETH   , ONLY : RALPHA1 ,RALPHA2  ,RQLIM   ,&
 & RPBOTOX,  RPBOTPH ,RPTOPOX  ,RPTOPPH ,&
 & RALPHA3,  RLOGPPH  
#ifdef ISO
USE infotrac_phy, ONLY: ntraciso,niso
USE isotopes_mod, ONLY: Rmethox, iso_eau
#ifdef ISOVERIF
  USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
#endif
#ifdef ISOTRAC
    use isotrac_mod, only: izone_poubelle,index_zone,index_iso
#endif
#endif

IMPLICIT NONE

#include "YOMCST.h"

INTEGER,INTENT(IN)    :: KLON 
INTEGER,INTENT(IN)    :: KLEV 
INTEGER,INTENT(IN)    :: KIDIA 
INTEGER,INTENT(IN)    :: KFDIA 
REAL   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL   ,INTENT(INOUT) :: PTENQ(KLON,KLEV) 
REAL   ,INTENT(IN)    :: PAP(KLON,KLEV) 
LOGICAL :: LLOXID,         LLPHOTO

INTEGER :: JK, JL

REAL :: ZARG, ZPRATIO, ZTAU1, ZTAU2, ZTDAYS

#ifdef ISO
REAL   ,INTENT(IN)    :: Pxt(ntraciso,KLON,KLEV) 
REAL   ,INTENT(INOUT) :: PTENxt(ntraciso,KLON,KLEV) 
INTEGER :: ixt
#ifdef ISOTRAC
integer izone_recoit 
#endif
#endif


DO JK=1,KLEV
  DO JL=KIDIA,KFDIA

    LLOXID=PAP(JL,JK) < RPBOTOX.AND.PQ(JL,JK) < RQLIM
    LLPHOTO=PAP(JL,JK) < RPBOTPH
    PTENQ(JL,JK)=0.0 ! ajout CRisi pour init   

!     METHANE OXIDATION

    IF(LLOXID) THEN
      IF(PAP(JL,JK) <= RPTOPOX) THEN
        ZTDAYS=100.
      ELSE
        ZPRATIO=(LOG(PAP(JL,JK)/RPTOPOX))**4./LOG(RPBOTOX/PAP(JL,JK))
        ZTDAYS=100.*(1+RALPHA1*ZPRATIO)
      ENDIF
      ZTAU1=86400.*ZTDAYS
      PTENQ(JL,JK)=PTENQ(JL,JK)+(RQLIM-PQ(JL,JK))/ZTAU1
    ENDIF

!     PHOTOLYSIS

    IF(LLPHOTO) THEN
      IF(PAP(JL,JK) <= RPTOPPH) THEN
        ZTDAYS=3.
      ELSE
        ZARG=RALPHA2-RALPHA3*(1+COS((RPI*LOG(PAP(JL,JK)/RPBOTPH))/RLOGPPH))
        ZTDAYS=1.0/(EXP(ZARG)-0.01)
      ENDIF
      ZTAU2=86400.*ZTDAYS
      PTENQ(JL,JK)=PTENQ(JL,JK)-PQ(JL,JK)/ZTAU2
    ENDIF
  ENDDO
ENDDO

#ifdef ISO
        ! supposer une source d'eau avec composition constante.
        ! dans la biblio: Bilan masse basé sur Zhan et al 2006.  
        write(*,*) 'Rmethox=',Rmethox
DO JK=1,KLEV
  DO JL=KIDIA,KFDIA        
        do ixt=1,niso
          PTENxt(ixt,JL,JK)=PTENQ(JL,JK)*Rmethox(ixt)
        enddo
  ENDDO
ENDDO
#ifdef ISOTRAC
        ! mettre dans la zone poubelle. 
izone_recoit= izone_poubelle
DO JK=1,KLEV
  DO JL=KIDIA,KFDIA  
        do ixt=niso+1,ntraciso
            if (index_zone(ixt).eq.izone_recoit) then
               PTENxt(ixt,JK,JL)=PTENxt(index_iso(ixt),JK,JL)
            else
               PTENxt(ixt,JK,JL)=0.0
            endif
        enddo   !do ixt=niso+1,ntraciso
  ENDDO
ENDDO
#endif
#ifdef ISOVERIF
DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
        if (iso_eau.gt.0) then
            call iso_verif_egalite_choix(PTENxt(iso_eau,JK,JL), &
     &        PTENQ(JK,JL),'methox 163', &
     &        errmax,errmaxrel)
        endif
  ENDDO
ENDDO
#endif
#endif
        write(*,*) 'methox 158: PTENQ(30,35)=',PTENQ(30,35)
        write(*,*) 'PTENQ(30,34)=',PTENQ(30,34)
        write(*,*) 'PTENQ(30,33)=',PTENQ(30,33)
        write(*,*) 'PTENQ(30,32)=',PTENQ(30,32)

END SUBROUTINE METHOX