SUBROUTINE SRTM_SRTM_224GP &
 & ( KIDIA, KFDIA, KLON , KLEV , KSW  , KOVLP ,&
 &   PAER , PALBD, PALBP, PAPH , PAP  ,&
 &   PTS  , PTH  , PT   ,&
 &   PQ   , PCO2 , PCH4 , PN2O , PNO2 , POZN  , PRMU0 ,&
 &   PFRCL, PTAUC, PASYC, POMGC,&
 &   PFSUX, PFSUC, PFUVF, PSUDU &
 & )  

!-- interface to RRTM_SW
!     JJMorcrette 030225
!     JJMorcrette 20071015 3D fields of CO2, CH4, N2O and NO2
!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE PARSRTM  , ONLY : JPLAY
USE YOERAD   , ONLY : NAER
USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
USE YOMPHY3  , ONLY : RII0
USE YOMCST   , ONLY : RI0 
USE YOESRTWN , ONLY : RI0_SRTM

IMPLICIT NONE

!-- Input arguments

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
INTEGER(KIND=JPIM),INTENT(IN)    :: KSW
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOVLP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)    ! top to bottom
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,KSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,KSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2(KLON,KLEV),PCH4(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PN2O(KLON,KLEV),PNO2(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRCL(KLON,KLEV)     ! bottom to top
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC(KLON,KSW,KLEV) ! bottom to top
REAL(KIND=JPRB)   ,INTENT(IN)    :: PASYC(KLON,KSW,KLEV) ! bottom to top
REAL(KIND=JPRB)   ,INTENT(IN)    :: POMGC(KLON,KSW,KLEV) ! bottom to top
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUX(KLON,2,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUC(KLON,2,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUVF(KLON) , PSUDU(KLON)
!INTEGER_M :: KMOL, KCLDATM, KNFLAG, KCEFLAG, KIQFLAG, KSTR  

!-- Output arguments

!-----------------------------------------------------------------------

!-- dummy integers

INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, I_NMOL, I_NSTR

INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW

!-- dummy reals

REAL(KIND=JPRB) :: Z_PZ(KIDIA:KFDIA,0:JPLAY)   , Z_PAVEL(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_TAVEL(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_COLDRY(KIDIA:KFDIA,JPLAY) , Z_COLMOL(KIDIA:KFDIA,JPLAY) , Z_WKL(KIDIA:KFDIA,35,JPLAY)
REAL(KIND=JPRB) :: Z_COLCH4(KIDIA:KFDIA,JPLAY) , Z_COLCO2(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_COLH2O(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_COLO2(KIDIA:KFDIA,JPLAY)  , Z_COLO3(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_FORFAC(KIDIA:KFDIA,JPLAY) , Z_FORFRAC(KIDIA:KFDIA,JPLAY), Z_SELFFAC(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_SELFFRAC(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_FAC00(KIDIA:KFDIA,JPLAY)  , Z_FAC01(KIDIA:KFDIA,JPLAY)  , Z_FAC10(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_FAC11(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: Z_ONEMINUS(KIDIA:KFDIA)    , ZRMU0(KIDIA:KFDIA) , ZADJI0
REAL(KIND=JPRB) :: ZALBD(KIDIA:KFDIA,KSW)    , ZALBP(KIDIA:KFDIA,KSW)    , ZFRCL(KIDIA:KFDIA,JPLAY)
REAL(KIND=JPRB) :: ZTAUC(KIDIA:KFDIA,JPLAY,KSW), ZASYC(KIDIA:KFDIA,JPLAY,KSW), ZOMGC(KIDIA:KFDIA,JPLAY,KSW)
REAL(KIND=JPRB) :: ZTAUA(KIDIA:KFDIA,JPLAY,KSW), ZASYA(KIDIA:KFDIA,JPLAY,KSW), ZOMGA(KIDIA:KFDIA,JPLAY,KSW)

REAL(KIND=JPRB) :: ZBBCD(KIDIA:KFDIA,JPLAY+1), ZBBCU(KIDIA:KFDIA,JPLAY+1), ZBBFD(KIDIA:KFDIA,JPLAY+1), ZBBFU(KIDIA:KFDIA,JPLAY+1)
REAL(KIND=JPRB) :: ZSUDU(KIDIA:KFDIA), ZSUDUC(KIDIA:KFDIA)

INTEGER(KIND=JPIM) :: I_LAYTROP(KIDIA:KFDIA)
INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,JPLAY), INDSELF(KIDIA:KFDIA,JPLAY)
INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,JPLAY), JT(KIDIA:KFDIA,JPLAY), JT1(KIDIA:KFDIA,JPLAY)

REAL(KIND=JPRB) :: Z_AMD                  ! Effective molecular weight of dry air (g/mol)
REAL(KIND=JPRB) :: Z_AMW                  ! Molecular weight of water vapor (g/mol)
REAL(KIND=JPRB) :: Z_AMCO2                ! Molecular weight of carbon dioxide (g/mol)
REAL(KIND=JPRB) :: Z_AMO                  ! Molecular weight of ozone (g/mol)
REAL(KIND=JPRB) :: Z_AMCH4                ! Molecular weight of methane (g/mol)
REAL(KIND=JPRB) :: Z_AMN2O                ! Molecular weight of nitrous oxide (g/mol)
REAL(KIND=JPRB) :: Z_AMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
REAL(KIND=JPRB) :: Z_AMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
REAL(KIND=JPRB) :: Z_AVGDRO               ! Avogadro's number (molecules/mole)
REAL(KIND=JPRB) :: Z_GRAVIT               ! Gravitational acceleration (cm/sec2)
REAL(KIND=JPRB) :: Z_AMM(KIDIA:KFDIA)

! Atomic weights for conversion from mass to volume mixing ratios; these
!  are the same values used in ECRT to assure accurate conversion to vmr
data Z_AMD   /  28.970_JPRB    /
data Z_AMW   /  18.0154_JPRB   /
data Z_AMCO2 /  44.011_JPRB    /
data Z_AMO   /  47.9982_JPRB   /
data Z_AMCH4 /  16.043_JPRB    /
data Z_AMN2O /  44.013_JPRB    /
data Z_AMC11 / 137.3686_JPRB   /
data Z_AMC12 / 120.9140_JPRB   /
data Z_AVGDRO/ 6.02214E23_JPRB /
data Z_GRAVIT/ 9.80665E02_JPRB /

REAL(KIND=JPRB) :: ZCLEAR(KIDIA:KFDIA), ZCLOUD(KIDIA:KFDIA), ZEPSEC, ZTOTCC(KIDIA:KFDIA)

INTEGER(KIND=JPIM) :: IOVLP
REAL(KIND=JPRB) :: ZHOOK_HANDLE


#include "srtm_setcoef.intfb.h"
#include "srtm_spcvrt.intfb.h"


!-----------------------------------------------------------------------
!-- calculate information needed ny the radiative transfer routine 

IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP',0,ZHOOK_HANDLE)
ZEPSEC  = 1.E-06_JPRB
Z_ONEMINUS=1.0_JPRB -  ZEPSEC
ZADJI0 = RII0 / RI0_SRTM
!-- overlap: 1=max-ran, 2=maximum, 3=random
IOVLP=3

!print *,'Entering srtm_srtm_224gp'

ICLDATM = 1
INFLAG    = 2
ICEFLAG    = 3
I_LIQFLAG = 1
I_NMOL    = 7
I_NSTR    = 2

ZRMU0(KIDIA:KFDIA) = PRMU0(KIDIA:KFDIA)
PFUVF(KIDIA:KFDIA)=0.0_JPRB

!- coefficients related to the cloud optical properties (original RRTM_SW)


!  DO JK=1,KLEV 
!    CLDFRAC(JK) = PFRCL (JL,JK)
!    CLDDAT1(JK) = PSCLA1(JL,JK)
!    CLDDAT2(JK) = PSCLA2(JL,JK)
!    CLDDAT3(JK) = PSCLA3(JL,JK)
!    CLDDAT4(JK) = PSCLA4(JL,JK)
!    DO JMOM=0,16
!      CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK)
!    ENDDO
!  ENDDO

!  CALL SRTM_CLDPROP &
!    &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR &
!    &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM &
!    &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM &
!    &)

!- coefficients for the temperature and pressure dependence of the 
! molecular absorption coefficients

DO J1=1,35
  DO J2=1,KLEV
    DO JL = KIDIA, KFDIA
      IF (PRMU0(JL) > 0.0_JPRB) THEN
        Z_WKL(JL,J1,J2)=0.0_JPRB 
      ENDIF
    ENDDO
  ENDDO
ENDDO

DO JL = KIDIA, KFDIA
  IF (PRMU0(JL) > 0.0_JPRB) THEN
    Z_PZ(JL,0) = paph(JL,klev+1)*0.01_JPRB
    ZCLEAR(JL)=1.0_JPRB
    ZCLOUD(JL)=0.0_JPRB
    ZTOTCC(JL)=0.0_JPRB
  ENDIF
ENDDO

DO JK = 1, KLEV
  DO JL = KIDIA, KFDIA
    IF (PRMU0(JL) > 0.0_JPRB) THEN
      Z_PAVEL(JL,JK) = pap(JL,KLEV-JK+1)*0.01_JPRB
      Z_TAVEL(JL,JK) = pt (JL,KLEV-JK+1)
      Z_PZ(JL,JK)    = paph(JL,KLEV-JK+1)*0.01_JPRB
      Z_WKL(JL,1,JK) = PQ(JL,KLEV-JK+1)  *Z_AMD/Z_AMW
      Z_WKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*Z_AMD/Z_AMCO2
      Z_WKL(JL,3,JK) = POZN(JL,KLEV-JK+1)*Z_AMD/Z_AMO
      Z_WKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*Z_AMD/Z_AMN2O
      Z_WKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*Z_AMD/Z_AMCH4
      Z_WKL(JL,7,JK) = 0.20944_JPRB
      Z_AMM(JL) = (1-Z_WKL(JL,1,JK))*Z_AMD + Z_WKL(JL,1,JK)*Z_AMW
      Z_COLDRY(JL,JK) = (Z_PZ(JL,JK-1)-Z_PZ(JL,JK))*1.E3_JPRB*Z_AVGDRO/(Z_GRAVIT*Z_AMM(JL)*(1+Z_WKL(JL,1,JK)))

      IF (KOVLP == 1) THEN
        ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-MAX(PFRCL(JL,JK),ZCLOUD(JL))) &
         & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-ZEPSEC))  
        ZCLOUD(JL)=PFRCL(JL,JK)
        ZTOTCC(JL)=1.0_JPRB-ZCLEAR(JL)
      ELSEIF (KOVLP == 2) THEN
        ZCLOUD(JL)=MAX(ZCLOUD(JL),PFRCL(JL,JK))
        ZCLEAR(JL)=1.0_JPRB-ZCLOUD(JL)
        ZTOTCC(JL)=ZCLOUD(JL)
      ELSEIF (KOVLP == 3) THEN
        ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-PFRCL(JL,JK))
        ZCLOUD(JL)=1.0_JPRB-ZCLEAR(JL)
        ZTOTCC(JL)=ZCLOUD(JL)
      ENDIF

    ENDIF
  ENDDO
ENDDO

DO IMOL=1,I_NMOL
  DO JK=1,KLEV
    DO JL = KIDIA, KFDIA
      IF (PRMU0(JL) > 0.0_JPRB) THEN
        Z_WKL(JL,IMOL,JK)=Z_COLDRY(JL,JK)* Z_WKL(JL,IMOL,JK)
      ENDIF
    ENDDO
  ENDDO
ENDDO

DO JL = KIDIA, KFDIA
  IF (PRMU0(JL) > 0.0_JPRB) THEN
    ZFRCL(JL,1:KLEV)=PFRCL(JL,1:KLEV)
  ENDIF
ENDDO

DO JL = KIDIA, KFDIA
  IF (PRMU0(JL) > 0.0_JPRB) THEN
    ZCLEAR(JL)=0._JPRB
    ZCLOUD(JL)=1._JPRB
  ENDIF
ENDDO

CALL SRTM_SETCOEF &
 & ( KIDIA  , KFDIA     , KLEV,&
 & Z_PAVEL  , Z_TAVEL,&
 & Z_COLDRY , Z_WKL,&
 & I_LAYTROP,&
 & Z_COLCH4  , Z_COLCO2 , Z_COLH2O , Z_COLMOL  , Z_COLO2 , Z_COLO3,&
 & Z_FORFAC , Z_FORFRAC , INDFOR , Z_SELFFAC, Z_SELFFRAC, INDSELF,&
 & Z_FAC00  , Z_FAC01   , Z_FAC10  , Z_FAC11,&
 & JP       , JT        , JT1      , ZRMU0   &
 & )  

!- call the radiation transfer routine

DO JSW=1,KSW
  DO JL = KIDIA, KFDIA
    IF (PRMU0(JL) > 0.0_JPRB) THEN
      ZALBD(JL,JSW)=PALBD(JL,JSW)
      ZALBP(JL,JSW)=PALBP(JL,JSW)
    ENDIF
  ENDDO
  DO JK=1,KLEV
    DO JL = KIDIA, KFDIA
      IF (PRMU0(JL) > 0.0_JPRB) THEN
        ZTAUC(JL,JK,JSW) = PTAUC(JL,JSW,JK)
        ZASYC(JL,JK,JSW) = PASYC(JL,JSW,JK)
        ZOMGC(JL,JK,JSW) = POMGC(JL,JSW,JK)
      ENDIF
    ENDDO
  ENDDO
ENDDO

!- mixing of aerosols

IF (NAER == 0) THEN
  DO JSW=1,KSW
    DO JK=1,KLEV
      DO JL = KIDIA, KFDIA
        IF (PRMU0(JL) > 0.0_JPRB) THEN
          ZTAUA(JL,JK,JSW)= 0.0_JPRB
          ZASYA(JL,JK,JSW)= 0.0_JPRB
          ZOMGA(JL,JK,JSW)= 1.0_JPRB
        ENDIF
      ENDDO
    ENDDO
  ENDDO
ELSE
  DO JSW=1,KSW
    DO JK=1,KLEV
      DO JL = KIDIA, KFDIA
        IF (PRMU0(JL) > 0.0_JPRB) THEN
          IK=KLEV+1-JK
          ZTAUA(JL,JK,JSW)=0.0_JPRB
          ZASYA(JL,JK,JSW)=0.0_JPRB
          ZOMGA(JL,JK,JSW)=0.0_JPRB
!CDIR UNROLL=6
          DO JAE=1,6
            ZTAUA(JL,JK,JSW)=ZTAUA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
            ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
             & *RSRPIZA(JSW,JAE)  
            ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
             & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE)  
          ENDDO
          IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
            ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
          ENDIF
          IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
            ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
          ENDIF
        ENDIF
      ENDDO
    ENDDO
  ENDDO
ENDIF

DO JK=1,KLEV+1
  DO JL = KIDIA, KFDIA
    IF (PRMU0(JL) > 0.0_JPRB) THEN
      ZBBCU(JL,JK)=0.0_JPRB
      ZBBCD(JL,JK)=0.0_JPRB
      ZBBFU(JL,JK)=0.0_JPRB
      ZBBFD(JL,JK)=0.0_JPRB
    ENDIF
  ENDDO
ENDDO

ZSUDU=0.0_JPRB
ZSUDUC=0.0_JPRB

!  print *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0

CALL SRTM_SPCVRT &
 & ( KIDIA  , KFDIA     , KLEV   , KSW    , Z_ONEMINUS,&
 & ZALBD   , ZALBP,&
 & ZFRCL  , ZTAUC   , ZASYC  , ZOMGC  , ZTAUA   , ZASYA   , ZOMGA , &
 & ZRMU0,&
 & I_LAYTROP,&
 & Z_COLCH4  , Z_COLCO2 , Z_COLH2O , Z_COLMOL  , Z_COLO2 , Z_COLO3,&
 & Z_FORFAC , Z_FORFRAC , INDFOR , Z_SELFFAC, Z_SELFFRAC, INDSELF,&
 & Z_FAC00  , Z_FAC01   , Z_FAC10  , Z_FAC11,&
 & JP     , JT      , JT1,&
 & ZBBFD  , ZBBFU   , ZBBCD  , ZBBCU   , ZSUDU , ZSUDUC &
 & )  

DO JK=1,KLEV+1
  DO JL = KIDIA, KFDIA
    IF (PRMU0(JL) > 0.0_JPRB) THEN
      PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JL,JK)
      PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JL,JK)
      PFSUX(JL,1,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR(JL))*ZBBFU(JL,JK)+ZCLEAR(JL)*ZBBCU(JL,JK) )
      PFSUX(JL,2,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR(JL))*ZBBFD(JL,JK)+ZCLEAR(JL)*ZBBCD(JL,JK) )
    ENDIF
  ENDDO
ENDDO
DO JL = KIDIA, KFDIA
  IF (PRMU0(JL) > 0.0_JPRB) THEN
    PSUDU(JL)=ZADJI0* ( (1.0_JPRB-ZCLEAR(JL))*ZSUDU(JL) + ZCLEAR(JL)*ZSUDUC(JL) )
  ENDIF
ENDDO

DO JK=1,KLEV+1
  DO JL = KIDIA, KFDIA
    IF (PRMU0(JL) <= 0.0_JPRB) THEN
      PFSUC(JL,1,JK)=0.0_JPRB
      PFSUC(JL,2,JK)=0.0_JPRB
      PFSUX(JL,1,JK)=0.0_JPRB
      PFSUX(JL,2,JK)=0.0_JPRB
    ENDIF
  ENDDO
ENDDO
DO JL = KIDIA, KFDIA
  IF (PRMU0(JL) <= 0.0_JPRB) THEN
    PSUDU(JL)=0.0_JPRB
  ENDIF
ENDDO

!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP',1,ZHOOK_HANDLE)
END SUBROUTINE SRTM_SRTM_224GP

