!OPTIONS XOPT(NOEVAL)
SUBROUTINE SWDE15 (KIDIA,KFDIA,KLON,PGG,PREF,PRMUZ,PTO1,PW,&
 & PRE1,PRE2,PTR1,PTR2         )  

!**** *SWDE15* - DELTA-EDDINGTON IN A CLOUDY LAYER
!****            FROZEN VERSION (CYCLE 15) OF SWDE

!     PURPOSE.
!     --------
!           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
!     LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.

!**   INTERFACE.
!     ----------
!          *SWDE15* IS CALLED BY *SWR15*, *SW2S15*

!        EXPLICIT ARGUMENTS :
!        --------------------
! PGG    : (NDLON)             ; ASSYMETRY FACTOR
! PREF   : (NDLON)             ; REFLECTIVITY OF THE UNDERLYING LAYER
! PRMUZ  : (NDLON)             ; COSINE OF SOLAR ZENITH ANGLE
! PTO1   : (NDLON)             ; OPTICAL THICKNESS
! PW     : (NDLON)             ; SINGLE SCATTERING ALBEDO
!     ==== OUTPUTS ===
! PRE1   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING NO
!                              ; REFLECTION FROM UNDERLYING LAYER
! PTR1   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING NO
!                              ; REFLECTION FROM UNDERLYING LAYER
! PRE2   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING
!                              ; REFLECTION FROM UNDERLYING LAYER
! PTR2   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING
!                              ; REFLECTION FROM UNDERLYING LAYER

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

!     METHOD.
!     -------

!          STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.

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

!          NONE

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

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

!     AUTHOR.
!     -------
!        96-11: Ph. Dandin. Meteo-France
!        ORIGINAL : 88-12-15 BY JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGG(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMUZ(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTO1(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PW(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRE1(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRE2(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR1(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR2(KLON) 
INTEGER(KIND=JPIM) :: JL

REAL(KIND=JPRB) :: ZA11, ZA12, ZA13, ZA21, ZA22, ZA23, ZALPHA,&
 & ZAM2B, ZAP2B, ZARG, ZARG2, ZB21, ZB22, ZB23, &
 & ZBETA, ZC1A, ZC1B, ZC2A, ZC2B, ZDENA, ZDENB, &
 & ZDT, ZEXKM, ZEXKP, ZEXMU0, ZFF, ZGP, ZRI0A, &
 & ZRI0B, ZRI0C, ZRI0D, ZRI1A, ZRI1B, ZRI1C, &
 & ZRI1D, ZRK, ZRM2, ZRP, ZTOP, ZWCP, ZWM, ZX1, &
 & ZX2, ZXM2P, ZXP2P  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*         1.      DELTA-EDDINGTON CALCULATIONS

IF (LHOOK) CALL DR_HOOK('SWDE15',0,ZHOOK_HANDLE)
DO JL   =   KIDIA,KFDIA

!*         1.1     SET UP THE DELTA-MODIFIED PARAMETERS

  ZFF = PGG(JL)*PGG(JL)
  ZGP = PGG(JL)/(1.0_JPRB+PGG(JL))
  ZTOP = (1.0_JPRB- PW(JL) * ZFF) * PTO1(JL)
  ZWCP = (1-ZFF)* PW(JL) /(1.0_JPRB- PW(JL) * ZFF)
  ZDT = 2.0_JPRB/3._JPRB
  ZX1 = 1.0_JPRB-ZWCP*ZGP
  ZWM = 1.0_JPRB-ZWCP
  ZRM2 =  PRMUZ(JL) * PRMUZ(JL)
  ZRK = SQRT(3._JPRB*ZWM*ZX1)
  ZX2 = 4._JPRB*(1.0_JPRB-ZRK*ZRK*ZRM2)
  ZRP=ZRK/ZX1
  ZALPHA = 3._JPRB*ZWCP*ZRM2*(1.0_JPRB+ZGP*ZWM)/ZX2
  ZBETA = 3._JPRB*ZWCP* PRMUZ(JL) *(1.0_JPRB+3._JPRB*ZGP*ZRM2*ZWM)/ZX2
!     ZARG=MIN(ZTOP/PRMUZ(JL),200.)
  ZARG=MAX(-200._JPRB,MIN(ZTOP/PRMUZ(JL),200._JPRB))
  ZEXMU0=EXP(-ZARG)
  ZARG2=MIN(ZRK*ZTOP,200._JPRB)
  ZEXKP=EXP(ZARG2)
  ZEXKM = 1.0_JPRB/ZEXKP
  ZXP2P = 1.0_JPRB+ZDT*ZRP
  ZXM2P = 1.0_JPRB-ZDT*ZRP
  ZAP2B = ZALPHA+ZDT*ZBETA
  ZAM2B = ZALPHA-ZDT*ZBETA

!*         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER

  ZA11 = ZXP2P
  ZA12 = ZXM2P
  ZA13 = ZAP2B
  ZA22 = ZXP2P*ZEXKP
  ZA21 = ZXM2P*ZEXKM
  ZA23 = ZAM2B*ZEXMU0
  ZDENA = ZA11 * ZA22 - ZA21 * ZA12
  ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA
  ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA
  ZRI0A = ZC1A+ZC2A-ZALPHA
  ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
  PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
  ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0
  ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0
  PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)

!*         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER

  ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM
  ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP
  ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) )
  ZDENB = ZA11 * ZB22 - ZB21 * ZA12
  ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB
  ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB
  ZRI0C = ZC1B+ZC2B-ZALPHA
  ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
  PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
  ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0
  ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0
  PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)

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

