SUBROUTINE LWU &
 & ( KIDIA, KFDIA, KLON, KLEV,&
 & PAER , PCCO2, PDP , PPMB, PQOF , PTAVE, PVIEW, PWV,&
 & PABCU &
 & )  

!**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS

!     PURPOSE.
!     --------
!           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
!           TEMPERATURE EFFECTS

!**   INTERFACE.
!     ----------

!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===
! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
! PCCO2  :                   ; CONCENTRATION IN CO2 (PA/PA)
! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS (PA)
! PPMB   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
! PQOF   : (KLON,KLEV)       ; CONCENTRATION IN OZONE (PA/PA)
! PTAVE  : (KLON,KLEV)       ; TEMPERATURE
! PWV    : (KLON,KLEV)       ; SPECIFIC HUMIDITY PA/PA
! PVIEW  : (KLON)            ; COSECANT OF VIEWING ANGLE
!     ==== OUTPUTS ===
! PABCU  :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------

!          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
!     ABSORBERS.

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

!          NONE

!     REFERENCE.
!     ----------

!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-07-14
!        JJ Morcrette 97-04-18 Revised Continuum + Clean-up
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M. Janiskova 06-Dec_2005 Optimisation

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

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

USE YOMCST   , ONLY : RG
USE YOESW    , ONLY : RAER
USE YOELW    , ONLY : NSIL     ,NUA      ,NG1      ,NG1P1    ,&
 & ALWT     ,BLWT     ,RO3T     ,RT1      ,TREF     ,&
 & RVGCO2   ,RVGH2O   ,RVGO3  
USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
USE YOERDU   , ONLY : R10E     ,REPSCO   ,REPSCQ
USE YOEPHLI  , ONLY : LPHYLIN
USE YOPHNC   , ONLY : LH2OCO2

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPMB(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQOF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVIEW(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PABCU(KLON,NUA,3*KLEV+1) 
!-----------------------------------------------------------------------

!*       0.1   ARGUMENTS
!              ---------

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

!              ------------
REAL(KIND=JPRB) :: ZABLY(KLON,7,3*KLEV+1)  , ZDPM(KLON,3*KLEV)&
 & , ZUPM(KLON,3*KLEV)  
REAL(KIND=JPRB) :: ZPHIO(KLON),ZPSC2(KLON) , ZPSC3(KLON), ZPSH1(KLON)&
 & ,  ZPSH2(KLON),ZPSH3(KLON) , ZPSH4(KLON), ZPSH5(KLON)&
 & ,  ZPSH6(KLON),ZPSIO(KLON) , ZTCON(KLON)&
 & ,  ZPHM6(KLON),ZPSM6(KLON) , ZPHN6(KLON), ZPSN6(KLON)  
REAL(KIND=JPRB) :: ZSSIG(KLON,3*KLEV+1)    &
 & ,  ZUAER(KLON,NSIL)        , ZXOZ(KLON) , ZXWV(KLON)
REAL(KIND=JPRB) :: ZUAERS(KLON,NSIL)
REAL(KIND=JPRB) :: ZFPPW(KLON), ZSUM(KLON) , ZDIV(KLON)
REAL(KIND=JPRB) :: ZTX(KLON), ZTX2(KLON)

INTEGER(KIND=JPIM) :: IAE1, IAE2, IAE3, IC, ICP1, IG1, IJ, IJPN,&
 & IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, JA, JAE, &
 & JK, JKI, JKK, JL  

REAL(KIND=JPRB) :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4,&
 & ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, &
 & ZCBH4, ZCBH5, ZCBH6, ZDPMP0, &
 & ZU6, ZUP, ZUPMCO2, ZUPMG, &
 & ZUPMH2O, ZUPMO3, ZZABLY  
REAL(KIND=JPRB) :: ZRGI, ZINORMP, ZDUCM, ZIPCCO2, ZDIFFCO2
REAL(KIND=JPRB) :: ZDIV1, ZDIV2, ZDIV3
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('LWU',0,ZHOOK_HANDLE)


!*         1.    INITIALIZATION
!                --------------

ZRGI = 0.1_JPRB/RG
ZIPCCO2 = 1.0_JPRB/PCCO2
ZINORMP = 1.0_JPRB/101325._JPRB

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

!*         2.    PRESSURE OVER GAUSS SUB-LEVELS
!                ------------------------------

DO JL = KIDIA,KFDIA
  ZSSIG(JL, 1 ) = PPMB(JL,1) * 100._JPRB
ENDDO

DO JK = 1 , KLEV
  IKJ=(JK-1)*NG1P1+1
  IKJR = IKJ
  IKJP = IKJ + NG1P1
  DO JL = KIDIA,KFDIA
    ZSSIG(JL,IKJP)=PPMB(JL,JK+1)* 100._JPRB
  ENDDO
  DO IG1=1,NG1
    IKJ=IKJ+1
    DO JL = KIDIA,KFDIA
      ZSSIG(JL,IKJ)= (ZSSIG(JL,IKJR) + ZSSIG(JL,IKJP)) * 0.5_JPRB &
       & + RT1(IG1) * (ZSSIG(JL,IKJP) - ZSSIG(JL,IKJR)) * 0.5_JPRB  
    ENDDO
  ENDDO
ENDDO

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

!*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
!                --------------------------------------------------

DO JKI=1,3*KLEV
  IKIP1=JKI+1
  DO JL = KIDIA,KFDIA
    ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,IKIP1))*0.5_JPRB
    ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,IKIP1))*ZRGI
  ENDDO
ENDDO

IF (LPHYLIN .AND. LH2OCO2) THEN

  DO JK = 1 , KLEV
    IKL = KLEV+1 - JK
    DO JL = KIDIA,KFDIA
      ZXWV(JL) = MAX (PWV(JL,IKL) , REPSCQ )
    ENDDO
    IKJ=(JK-1)*NG1P1+1
    IKJPN=IKJ+NG1
    DO JKK=IKJ,IKJPN
      DO JL = KIDIA,KFDIA
        ZDPMP0 = ZDPM(JL,JKK) * ZINORMP
        ZUPMCO2 = ( ZUPM(JL,JKK) + RVGCO2 ) * ZDPMP0
        ZUPMH2O = ( ZUPM(JL,JKK) + RVGH2O ) * ZDPMP0

!      ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB+0.608_JPRB*ZXWV(JL))
!- H2O
        ZABLY(JL,1,JKK)  = ZXWV(JL) * ZUPMH2O
!- CO2 (CH4,N2O)
        ZABLY(JL,3,JKK)  = PCCO2 * ZUPMCO2
      ENDDO
    ENDDO
  ENDDO

ELSE   

  DO JK = 1 , KLEV
    IKL = KLEV+1 - JK
    DO JL = KIDIA,KFDIA
      ZXWV(JL) = MAX (PWV(JL,IKL) , REPSCQ )
!- H2O continuum
      ZDIV1 = 1.0_JPRB / (1.0_JPRB+0.608_JPRB*ZXWV(JL))
      ZFPPW(JL) = 1.6078_JPRB * ZXWV(JL) * ZDIV1
!- O3
      ZDIV2 = 1.0_JPRB / PDP(JL,IKL)
      ZXOZ(JL) = MAX (PQOF(JL,IKL) * ZDIV2 , REPSCO )
    ENDDO
    IKJ=(JK-1)*NG1P1+1
    IKJPN=IKJ+NG1
    DO JKK=IKJ,IKJPN
      DO JL = KIDIA,KFDIA
        ZDPMP0 = ZDPM(JL,JKK) * ZINORMP
        ZUPMCO2 = ( ZUPM(JL,JKK) + RVGCO2 ) * ZDPMP0
        ZUPMH2O = ( ZUPM(JL,JKK) + RVGH2O ) * ZDPMP0
!      ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB+0.608_JPRB*ZXWV(JL))
!- H2O
        ZABLY(JL,1,JKK)  = ZXWV(JL) * ZUPMH2O
!- CO2 (CH4,N2O)
        ZABLY(JL,3,JKK)  = PCCO2 * ZUPMCO2
!- O3
        ZUPMO3  = ( ZUPM(JL,JKK) + RVGO3  ) * ZDPMP0
        ZABLY(JL,6,JKK) = ZXOZ(JL) * ZDPM(JL,JKK)
        ZABLY(JL,7,JKK) = ZXOZ(JL) * ZUPMO3
!- H2O continuum
        ZUPMG = ZUPM(JL,JKK) * ZDPMP0       
        ZU6 = ZXWV(JL) * ZUPMG
        ZABLY(JL,5,JKK) = ZU6 * ZFPPW(JL)
        ZABLY(JL,4,JKK) = ZU6 * (1.0_JPRB-ZFPPW(JL))

        ZABLY(JL,2,JKK)  = PCCO2 * ZDPM(JL,JKK)
      ENDDO
    ENDDO
  ENDDO
ENDIF

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

!*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
!                --------------------------------------------------

DO JA = 1, NUA
  DO JL = KIDIA,KFDIA
    PABCU(JL,JA,3*KLEV+1) = 0.0_JPRB
  ENDDO
ENDDO

DO JK = 1 , KLEV
  IJ=(JK-1)*NG1P1+1
  IJPN=IJ+NG1
  IKL=KLEV+1-JK

!*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
!               --------------------------------------------------
! --            NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM

  IAE1=3*KLEV+1-IJ
  IAE2=3*KLEV+1-(IJ+1)
  IAE3=3*KLEV+1-IJPN
  DO JL = KIDIA,KFDIA
    ZSUM(JL) = ZDPM(JL,IAE1)+ZDPM(JL,IAE2)+ZDPM(JL,IAE3)
    ZDIV(JL) = 1.0_JPRB/ZSUM(JL)
  ENDDO

  DO JAE=1,6
    DO JL = KIDIA,KFDIA
      ZUAERS(JL,JAE) =&
       & RAER(JAE,1)*PAER(JL,1,JK)+RAER(JAE,2)*PAER(JL,2,JK)&
       & +RAER(JAE,3)*PAER(JL,3,JK)+RAER(JAE,4)*PAER(JL,4,JK)&
       & +RAER(JAE,5)*PAER(JL,5,JK)+RAER(JAE,6)*PAER(JL,6,JK)
      ZUAER(JL,JAE) = ZUAERS(JL,JAE)*ZDIV(JL)
    ENDDO
  ENDDO

!*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
!               --------------------------------------------------

  DO JL = KIDIA,KFDIA
!    ZFACT(JL)=1.0_JPRB-ZTAVI(JL)/296._JPRB
!    ZTCON(JL)=EXP(6.08*ZFACT(JL))

    ZTX(JL)=PTAVE(JL,IKL)-TREF
    ZTX2(JL)=ZTX(JL)*ZTX(JL)

    ZZABLY = ZABLY(JL,1,IAE1)+ZABLY(JL,1,IAE2)+ZABLY(JL,1,IAE3)
    ZUP=MIN( MAX( 0.5_JPRB*R10E*LOG( ZZABLY ) + 5._JPRB, 0.0_JPRB), 6.0_JPRB)

!- H2O
    ZCAH1=ALWT(1,1)+ZUP*(ALWT(1,2)+ZUP*(ALWT(1,3)))
    ZCBH1=BLWT(1,1)+ZUP*(BLWT(1,2)+ZUP*(BLWT(1,3)))
    ZPSH1(JL)=EXP( ZCAH1 * ZTX(JL) + ZCBH1 * ZTX2(JL) )
    ZCAH2=ALWT(2,1)+ZUP*(ALWT(2,2)+ZUP*(ALWT(2,3)))
    ZCBH2=BLWT(2,1)+ZUP*(BLWT(2,2)+ZUP*(BLWT(2,3)))
    ZPSH2(JL)=EXP( ZCAH2 * ZTX(JL) + ZCBH2 * ZTX2(JL) )
    ZCAH3=ALWT(3,1)+ZUP*(ALWT(3,2)+ZUP*(ALWT(3,3)))
    ZCBH3=BLWT(3,1)+ZUP*(BLWT(3,2)+ZUP*(BLWT(3,3)))
    ZPSH3(JL)=EXP( ZCAH3 * ZTX(JL) + ZCBH3 * ZTX2(JL) )
    ZCAH4=ALWT(4,1)+ZUP*(ALWT(4,2)+ZUP*(ALWT(4,3)))
    ZCBH4=BLWT(4,1)+ZUP*(BLWT(4,2)+ZUP*(BLWT(4,3)))
    ZPSH4(JL)=EXP( ZCAH4 * ZTX(JL) + ZCBH4 * ZTX2(JL) )
    ZCAH5=ALWT(5,1)+ZUP*(ALWT(5,2)+ZUP*(ALWT(5,3)))
    ZCBH5=BLWT(5,1)+ZUP*(BLWT(5,2)+ZUP*(BLWT(5,3)))
    ZPSH5(JL)=EXP( ZCAH5 * ZTX(JL) + ZCBH5 * ZTX2(JL) )
    ZCAH6=ALWT(6,1)+ZUP*(ALWT(6,2)+ZUP*(ALWT(6,3)))
    ZCBH6=BLWT(6,1)+ZUP*(BLWT(6,2)+ZUP*(BLWT(6,3)))
    ZPSH6(JL)=EXP( ZCAH6 * ZTX(JL) + ZCBH6 * ZTX2(JL) )

    IF (.NOT.LH2OCO2 .OR. .NOT.LPHYLIN) THEN
!- CH4
      ZPHM6(JL)=EXP(-5.81E-4_JPRB * ZTX(JL) - 1.13E-6_JPRB * ZTX2(JL) )
      ZPSM6(JL)=EXP(-5.57E-4_JPRB * ZTX(JL) - 3.30E-6_JPRB * ZTX2(JL) )
!- N2O
      ZPHN6(JL)=EXP(-3.46E-5_JPRB * ZTX(JL) + 2.05E-7_JPRB * ZTX2(JL) )
      ZPSN6(JL)=EXP( 3.70E-3_JPRB * ZTX(JL) - 2.30E-6_JPRB * ZTX2(JL) )
    ENDIF
  ENDDO

  DO JL = KIDIA,KFDIA
    ZZABLY = ZABLY(JL,3,IAE1)+ZABLY(JL,3,IAE2)+ZABLY(JL,3,IAE3)
    ZALUP = R10E * LOG ( ZZABLY )
    ZUP   = MAX( 0.0_JPRB , 5.0_JPRB + 0.5_JPRB * ZALUP )
!- CO2
    ZPSC2(JL) = (PTAVE(JL,IKL)/TREF) ** ZUP
    ZCAC8=ALWT(8,1)+ZUP*(ALWT(8,2)+ZUP*(ALWT(8,3)))
    ZCBC8=BLWT(8,1)+ZUP*(BLWT(8,2)+ZUP*(BLWT(8,3)))
    ZPSC3(JL)=EXP( ZCAC8 * ZTX(JL) + ZCBC8 * ZTX2(JL) )

    IF (.NOT.LH2OCO2 .OR. .NOT.LPHYLIN) THEN
!- O3
      ZPHIO(JL) = EXP( RO3T(1) * ZTX(JL) + RO3T(2) * ZTX2(JL))
      ZPSIO(JL) = EXP( 2.0_JPRB* (RO3T(3)*ZTX(JL)+RO3T(4)*ZTX2(JL)))
    ENDIF
  ENDDO

  DO JKK=IJ,IJPN
    IC=3*KLEV+1-JKK
    ICP1=IC+1
    DO JL = KIDIA,KFDIA
      ZDIFFCO2 = ZIPCCO2*PVIEW(JL)
      ZDUCM = ZDPM(JL,IC)*PVIEW(JL)
!- CO2
      PABCU(JL,7,IC)=PABCU(JL,7,ICP1)+ ZABLY(JL,3,IC)*ZPSC2(JL)*PVIEW(JL)
      PABCU(JL,8,IC)=PABCU(JL,8,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*PVIEW(JL)
      PABCU(JL,9,IC)=PABCU(JL,9,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*PVIEW(JL)
!- H2O
      PABCU(JL,1,IC)=PABCU(JL,1,ICP1)+ ZABLY(JL,1,IC)*ZPSH1(JL)
      PABCU(JL,2,IC)=PABCU(JL,2,ICP1)+ ZABLY(JL,1,IC)*ZPSH2(JL)
      PABCU(JL,3,IC)=PABCU(JL,3,ICP1)+ ZABLY(JL,1,IC)*ZPSH5(JL)*PVIEW(JL)
      PABCU(JL,4,IC)=PABCU(JL,4,ICP1)+ ZABLY(JL,1,IC)*ZPSH3(JL)
      PABCU(JL,5,IC)=PABCU(JL,5,ICP1)+ ZABLY(JL,1,IC)*ZPSH4(JL)
      PABCU(JL,6,IC)=PABCU(JL,6,ICP1)+ ZABLY(JL,1,IC)*ZPSH6(JL)*PVIEW(JL)

      IF (.NOT.LH2OCO2 .OR. .NOT.LPHYLIN) THEN
!- H2O continuum
        ZDIV3 = 1.0_JPRB/PTAVE(JL,IKL)
        ZTCON(JL)=EXP(6.08_JPRB*(296._JPRB*ZDIV3-1.0_JPRB))      
        PABCU(JL,10,IC)=PABCU(JL,10,ICP1)+ZABLY(JL,4,IC)          *PVIEW(JL)
        PABCU(JL,11,IC)=PABCU(JL,11,ICP1)+ZABLY(JL,5,IC)*ZTCON(JL)*PVIEW(JL)
!- O3      
        PABCU(JL,12,IC)=PABCU(JL,12,ICP1)+ZABLY(JL,6,IC)*ZPHIO(JL)*PVIEW(JL)
        PABCU(JL,13,IC)=PABCU(JL,13,ICP1)+ZABLY(JL,7,IC)*ZPSIO(JL)*PVIEW(JL)
!- aerosols
        PABCU(JL,14,IC)=PABCU(JL,14,ICP1)+ ZUAER(JL,1)*ZDUCM
        PABCU(JL,15,IC)=PABCU(JL,15,ICP1)+ ZUAER(JL,2)*ZDUCM
        PABCU(JL,16,IC)=PABCU(JL,16,ICP1)+ ZUAER(JL,3)*ZDUCM
        PABCU(JL,17,IC)=PABCU(JL,17,ICP1)+ ZUAER(JL,4)*ZDUCM
        PABCU(JL,18,IC)=PABCU(JL,18,ICP1)+ ZUAER(JL,5)*ZDUCM
!- CH4
        PABCU(JL,19,IC)=PABCU(JL,19,ICP1)&
         & + ZABLY(JL,2,IC)*RCH4*ZPHM6(JL)*ZDIFFCO2  
        PABCU(JL,20,IC)=PABCU(JL,20,ICP1)&
         & + ZABLY(JL,3,IC)*RCH4*ZPSM6(JL)*ZDIFFCO2
!- N2O
        PABCU(JL,21,IC)=PABCU(JL,21,ICP1)&
         & + ZABLY(JL,2,IC)*RN2O*ZPHN6(JL)*ZDIFFCO2 
        PABCU(JL,22,IC)=PABCU(JL,22,ICP1)&
         & + ZABLY(JL,3,IC)*RN2O*ZPSN6(JL)*ZDIFFCO2
!- CFC11
        PABCU(JL,23,IC)=PABCU(JL,23,ICP1)&
         & + ZABLY(JL,2,IC)*RCFC11*ZDIFFCO2
!- CFC12
        PABCU(JL,24,IC)=PABCU(JL,24,ICP1)&
         & + ZABLY(JL,2,IC)*RCFC12*ZDIFFCO2
      ENDIF
    ENDDO
  ENDDO

ENDDO
!      print *,'END OF LWU'

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

IF (LHOOK) CALL DR_HOOK('LWU',1,ZHOOK_HANDLE)
END SUBROUTINE LWU
