!OPTIONS XOPT(HSFUN)
SUBROUTINE SWDEAD &
 & ( KIDIA, KFDIA, KLON,&
 & PGG5 , PREF5, PRMUZ5, PTO15, PW5,&
 & PRE15, PRE25, PTR15 , PTR25,&
 & PGG  , PREF , PRMUZ , PTO1 , PW,&
 & PRE1 , PRE2 , PTR1  , PTR2 &
 & )  

!**** *SWDEAD* - DELTA-EDDINGTON IN A CLOUDY LAYER
!                -> ADJOINT <-

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

!**   INTERFACE.
!     ----------
!          *SWDEAD* IS CALLED BY *SWRAD*, *SWNIAD*

!        EXPLICIT ARGUMENTS :
!        --------------------
! PGG    : (KLON)             ; ASSYMETRY FACTOR
! PREF   : (KLON)             ; REFLECTIVITY OF THE UNDERLYING LAYER
! PRMUZ  : (KLON)             ; COSINE OF SOLAR ZENITH ANGLE
! PTO1   : (KLON)             ; OPTICAL THICKNESS
! PW     : (KLON)             ; SINGLE SCATTERING ALBEDO
!     ==== OUTPUTS ===
! PRE1   : (KLON)             ; LAYER REFLECTIVITY ASSUMING NO
!                             ; REFLECTION FROM UNDERLYING LAYER
! PTR1   : (KLON)             ; LAYER TRANSMISSIVITY ASSUMING NO
!                             ; REFLECTION FROM UNDERLYING LAYER
! PRE2   : (KLON)             ; LAYER REFLECTIVITY ASSUMING
!                             ; REFLECTION FROM UNDERLYING LAYER
! PTR2   : (KLON)             ; 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.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 96-10-17
!        Modified : 99-05-12 M.Janiskova - code corrections
!        03-10-10 Deborah Salmond and Marta Janiskova Optimisation
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        03-12-13 John Hague - MASS Vector Fns
!        08-03-26 M.Janiskova - code optimization and cleaning

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

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

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

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

USE YOERDU   , ONLY : REPLOG

USE YOMJFH   , ONLY : N_VMASS

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)    :: PGG5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMUZ5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTO15(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PW5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRE15(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRE25(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR15(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR25(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGG(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PREF(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRMUZ(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTO1(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PW(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRE1(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRE2(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTR1(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTR2(KLON) 
INTEGER(KIND=JPIM) :: JL

REAL(KIND=JPRB) :: ZA21,&
 & ZA215, ZA22, ZA225, ZA23, ZA235, ZALPHA, &
 & ZALPHA5, ZAM2B, ZAM2B5, ZAP2B, ZAP2B5, ZARG, &
 & ZARG2, ZARG25, ZARG5, ZARG15, ZB21, ZB215, ZB22, &
 & ZB225, ZB23, ZB235, ZBETA, ZBETA5, ZC1A, &
 & ZC1A5, ZC1B, ZC1B5, ZC2A, ZC2A5, ZC2B, ZC2B5, &
 & ZDENA, ZDENA5, ZDENB, ZDENB5, ZDT5, &
 & ZEXKM, ZEXKM5, ZEXKP, ZEXKP5, ZEXMU0, ZEXMU05, &
 & ZFF, ZFF5, ZGP, ZGP5, ZRI0A, ZRI0A5, ZRI0B, &
 & ZRI0B5, ZRI0C, ZRI0C5, ZRI0D, ZRI0D5, ZRI1A, &
 & ZRI1A5, ZRI1B, ZRI1B5, ZRI1C, ZRI1C5, ZRI1D, &
 & ZRI1D5, ZRK, ZRK5, ZRKI5, ZRM2, ZRM25, ZRP, ZRP5, &
 & ZTOP, ZTOP5, ZWCP, ZWCP5, ZWM, ZWM5, ZX1, &
 & ZX15, ZX2, ZX25, ZXM2P, ZXM2P5, ZXP2P, ZXP2P5  
REAL(KIND=JPRB) :: ZPRMUZ5,ZPRMUZ,ZIDENA5,ZIDENA,ZIDENB5,ZIDENB,ZRR5,ZRR
REAL(KIND=JPRB) :: ZDT25, ZPWFF5, ZPWFF
REAL(KIND=JPRB) :: ZDIV15, ZDIV25, ZDIV35

REAL(KIND=JPRB) :: ZHOOK_HANDLE

REAL(KIND=JPRB) :: ZTMP(15,KFDIA-KIDIA+1)
REAL(KIND=JPRB) :: ZARG5A  (KFDIA-KIDIA+1)
REAL(KIND=JPRB) :: ZARG25A (KFDIA-KIDIA+1)
REAL(KIND=JPRB) :: ZEXMU05A(KFDIA-KIDIA+1)
REAL(KIND=JPRB) :: ZEXKP5A (KFDIA-KIDIA+1)
INTEGER(KIND=JPIM) :: JLL,JLEN

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

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

!*         1.      DELTA-EDDINGTON CALCULATIONS

! 100 CONTINUE

ZDT5  = 2.0_JPRB/3._JPRB
ZDT25 = 2.0_JPRB*ZDT5

DO JL   =   KIDIA,KFDIA

!*         1.1     SET UP THE DELTA-MODIFIED PARAMETERS

! 110 CONTINUE

  JLL=JL-KIDIA+1

  ZFF5 = PGG5(JL)*PGG5(JL)
  ZDIV15 = 1.0_JPRB/(1.0_JPRB+PGG5(JL))
  ZGP5 = PGG5(JL)*ZDIV15
  ZPWFF5 = 1.0_JPRB- PW5(JL) * ZFF5
  ZTOP5 = ZPWFF5 * PTO15(JL)
  ZDIV25 = 1.0_JPRB/ZPWFF5
  ZWCP5 = (1.0_JPRB-ZFF5)* PW5(JL) * ZDIV25

  ZX15 = 1.0_JPRB-ZWCP5*ZGP5
  ZWM5 = 1.0_JPRB-ZWCP5
  ZRM25=    PRMUZ5(JL) * PRMUZ5(JL)
!! ZRK5 = SQRT(3._JPRB*ZWM5*ZX15)
! ZRKI5 = 3._JPRB*ZWM5*ZX15                        ! Calculated later
  ZRK5 = SQRT(MAX(REPLOG,3._JPRB*ZWM5*ZX15))
  ZX25 = (1.0_JPRB-  ZRK5*ZRK5*ZRM25)*ZDT25
  ZRR5 = 1.0_JPRB/ZX25
! ZRP5=ZRK5/ZX15                                   ! Calculated later
! ZALPHA5 = ZWCP5*ZRM25*(1.0_JPRB+ZGP5*ZWM5)*ZRR5  ! Calculated later
! ZBETA5 = ZWCP5* PRMUZ5(JL) *(1.0_JPRB+3._JPRB*ZGP5*ZRM25*ZWM5)*ZRR5
  ZPRMUZ5=1.0_JPRB/PRMUZ5(JL)
  IF (ZTOP5*ZPRMUZ5 >= 200._JPRB) THEN
    ZARG15=200._JPRB
  ELSE
    ZARG15=ZTOP5*ZPRMUZ5
  ENDIF
  IF (ZARG15 < -200._JPRB) THEN
    ZARG5 = -200._JPRB
  ELSE
    ZARG5 = ZARG15
  ENDIF
  ZEXMU05=EXP(-ZARG5)
  IF (ZRK5*ZTOP5 >= 200._JPRB) THEN
    ZARG25= 200._JPRB
  ELSE
    ZARG25= ZRK5*ZTOP5
  ENDIF
  ZEXKP5=EXP(ZARG25)

  ZTMP( 1,JLL) = ZFF5 
  ZTMP( 2,JLL) = ZGP5
  ZTMP( 3,JLL) = ZTOP5
  ZTMP( 4,JLL) = ZWCP5
  ZTMP( 5,JLL) = ZX15
  ZTMP( 6,JLL) = ZWM5
  ZTMP( 7,JLL) = ZRM25
  ZTMP( 8,JLL) = ZRK5 
  ZTMP( 9,JLL) = ZX25
  ZTMP(10,JLL) = ZRR5 
  ZTMP(11,JLL) = ZPRMUZ5
  ZTMP(12,JLL) = ZPWFF5
  ZTMP(13,JLL) = ZDIV15
  ZTMP(14,JLL) = ZDIV25
  ZARG25A(JLL) = ZARG25
  ZARG5A(JLL)  =-ZARG5

ENDDO

IF(N_VMASS /= 0 ) THEN  ! USING VECTOR MASS
  JLEN=KFDIA-KIDIA+1
  CALL VEXP(ZEXMU05A,ZARG5A, JLEN)
  CALL VEXP(ZEXKP5A,ZARG25A,JLEN)
ELSE
  DO JL   =   KIDIA,KFDIA
    JLL=JL-KIDIA+1
    ZEXMU05A(JLL) = EXP(ZARG5A(JLL))
    ZEXKP5A(JLL)  = EXP(ZARG25A(JLL))
  ENDDO
ENDIF

DO JL   =   KIDIA,KFDIA

  JLL=JL-KIDIA+1
  ZFF5   = ZTMP( 1,JLL)
  ZGP5   = ZTMP( 2,JLL)
  ZTOP5  = ZTMP( 3,JLL)
  ZWCP5  = ZTMP( 4,JLL)
  ZX15   = ZTMP( 5,JLL)
  ZWM5   = ZTMP( 6,JLL)
  ZRM25  = ZTMP( 7,JLL)
  ZRK5   = ZTMP( 8,JLL)
  ZX25   = ZTMP( 9,JLL)
  ZRR5   = ZTMP(10,JLL)
  ZPRMUZ5= ZTMP(11,JLL)
  ZPWFF5 = ZTMP(12,JLL)
  ZDIV15 = ZTMP(13,JLL)
  ZDIV25 = ZTMP(14,JLL)
  ZEXMU05= ZEXMU05A(JLL)
  ZEXKP5 = ZEXKP5A(JLL)
  ZRKI5  = 3._JPRB*ZWM5*ZX15 
  ZDIV35 = 1.0_JPRB/ZX15
  ZRP5   = ZRK5*ZDIV35 
  ZALPHA5= ZWCP5*ZRM25*(1.0_JPRB+ZGP5*ZWM5)*ZRR5
  ZBETA5 = ZWCP5* PRMUZ5(JL) *(1.0_JPRB+3._JPRB*ZGP5*ZRM25*ZWM5)*ZRR5

  ZEXKM5 = 1.0_JPRB/ZEXKP5
  ZXP2P5 = 1.0_JPRB+ZDT5*ZRP5
  ZXM2P5 = 1.0_JPRB-ZDT5*ZRP5
  ZAP2B5 = ZALPHA5+ZDT5*ZBETA5
  ZAM2B5 = ZALPHA5-ZDT5*ZBETA5

!*         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER

! 120 CONTINUE

  ZA225 = ZXP2P5*ZEXKP5
  ZA215 = ZXM2P5*ZEXKM5
  ZA235 = ZAM2B5*ZEXMU05
  ZDENA5 = ZXP2P5 * ZA225 - ZA215 * ZXM2P5
  ZIDENA5 = 1.0_JPRB/ZDENA5 
  ZC1A5 = (ZA225*ZAP2B5-ZXM2P5*ZA235)*ZIDENA5
  ZC2A5 = (ZXP2P5*ZA235-ZA215*ZAP2B5)*ZIDENA5
  ZRI0A5 = ZC1A5+ZC2A5-ZALPHA5
  ZRI1A5 = ZRP5*(ZC1A5-ZC2A5)-ZBETA5
  PRE15(JL) = (ZRI0A5-ZDT5*ZRI1A5)*ZPRMUZ5
  ZRI0B5 = ZC1A5*ZEXKM5+ZC2A5*ZEXKP5-ZALPHA5*ZEXMU05
  ZRI1B5 = ZRP5*(ZC1A5*ZEXKM5-ZC2A5*ZEXKP5)-ZBETA5*ZEXMU05
  PTR15(JL) = ZEXMU05+(ZRI0B5+ZDT5*ZRI1B5)*ZPRMUZ5

!*         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER

! 130 CONTINUE

  ZB215 = ZA215- PREF5(JL) *ZXP2P5*ZEXKM5
  ZB225 = ZA225- PREF5(JL) *ZXM2P5*ZEXKP5
  ZB235 = ZA235- PREF5(JL) *ZEXMU05*(ZAP2B5 - PRMUZ5(JL) )
  ZDENB5 = ZXP2P5* ZB225 - ZB215* ZXM2P5
  ZIDENB5 = 1.0_JPRB/ZDENB5
  ZC1B5 = (ZB225*ZAP2B5-ZXM2P5*ZB235)*ZIDENB5
  ZC2B5 = (ZXP2P5*ZB235-ZB215*ZAP2B5)*ZIDENB5
  ZRI0C5 = ZC1B5+ZC2B5-ZALPHA5
  ZRI1C5 = ZRP5*(ZC1B5-ZC2B5)-ZBETA5
  PRE25(JL) = (ZRI0C5-ZDT5*ZRI1C5) *ZPRMUZ5
  ZRI0D5 = ZC1B5*ZEXKM5 + ZC2B5*ZEXKP5 - ZALPHA5*ZEXMU05
  ZRI1D5 = ZRP5 * (ZC1B5*ZEXKM5 - ZC2B5*ZEXKP5) - ZBETA5*ZEXMU05
  PTR25(JL) = ZEXMU05 + (ZRI0D5 + ZDT5*ZRI1D5) *ZPRMUZ5

!     ==================================================================

!*         10.     ADJOINT CALCULATIONS
!                  --------------------

  ZEXMU0 = 0.0_JPRB
  ZRI0D  = 0.0_JPRB
  ZRI1D  = 0.0_JPRB
  ZRP    = 0.0_JPRB
  ZC1B   = 0.0_JPRB
  ZC2B   = 0.0_JPRB
  ZALPHA = 0.0_JPRB
  ZRI0C  = 0.0_JPRB
  ZRI1C  = 0.0_JPRB
  ZBETA  = 0.0_JPRB
  ZA21   = 0.0_JPRB
  ZA22   = 0.0_JPRB
  ZA23   = 0.0_JPRB
  ZB21   = 0.0_JPRB
  ZB22   = 0.0_JPRB
  ZB23   = 0.0_JPRB
  ZDENB  = 0.0_JPRB
  ZAP2B  = 0.0_JPRB
  ZXM2P  = 0.0_JPRB
  ZXP2P  = 0.0_JPRB
  ZEXKM  = 0.0_JPRB
  ZEXKP  = 0.0_JPRB
  ZRI0B  = 0.0_JPRB
  ZRI1B  = 0.0_JPRB
  ZC1A   = 0.0_JPRB
  ZC2A   = 0.0_JPRB
  ZRI0A  = 0.0_JPRB
  ZRI1A  = 0.0_JPRB
  ZDENA  = 0.0_JPRB
  ZAM2B  = 0.0_JPRB
  ZARG2  = 0.0_JPRB
  ZRK    = 0.0_JPRB
  ZTOP   = 0.0_JPRB
  ZARG   = 0.0_JPRB
  ZWCP   = 0.0_JPRB
  ZGP    = 0.0_JPRB
  ZRM2   = 0.0_JPRB
  ZWM    = 0.0_JPRB
  ZX2    = 0.0_JPRB
  ZX1    = 0.0_JPRB
  ZFF    = 0.0_JPRB
  ZPRMUZ = 0.0_JPRB
  ZRR    = 0.0_JPRB
  ZIDENA = 0.0_JPRB
  ZIDENB = 0.0_JPRB
  ZPWFF  = 0.0_JPRB

  ZEXMU0 = ZEXMU0 + PTR2(JL)
  ZRI0D  = ZRI0D + PTR2(JL) *ZPRMUZ5
  ZRI1D  = ZRI1D + PTR2(JL)*ZDT5 *ZPRMUZ5
  ZPRMUZ = ZPRMUZ + PTR2(JL)*(ZRI0D5+ZDT5*ZRI1D5)

  PTR2(JL)=0.0_JPRB

  ZRP    = ZRP + ZRI1D * (ZC1B5*ZEXKM5-ZC2B5*ZEXKP5)
  ZC1B   = ZC1B + ZRI1D * ZRP5*ZEXKM5
  ZC2B   = ZC2B - ZRI1D * ZRP5*ZEXKP5
  ZEXKM  = ZEXKM + ZRI1D * ZRP5 * ZC1B5
  ZEXKP  = ZEXKP - ZRI1D * ZRP5 * ZC2B5
!mj
  ZBETA  = ZBETA - ZRI1D * ZEXMU05
  ZEXMU0 = ZEXMU0 - ZRI1D * ZBETA5
!mj

  ZC1B   = ZC1B + ZRI0D * ZEXKM5
  ZC2B   = ZC2B + ZRI0D * ZEXKP5
  ZALPHA = ZALPHA - ZRI0D * ZEXMU05
  ZEXKM  = ZEXKM + ZRI0D * ZC1B5
  ZEXKP  = ZEXKP + ZRI0D * ZC2B5
  ZEXMU0 = ZEXMU0 - ZRI0D * ZALPHA5

  ZRI0C  = ZRI0C + PRE2(JL) *ZPRMUZ5
  ZRI1C  = ZRI1C - PRE2(JL)*ZDT5 *ZPRMUZ5
  ZPRMUZ = ZPRMUZ+ PRE2(JL)*(ZRI0C5-ZDT5*ZRI1C5)
  PRE2(JL)=0.0_JPRB

  ZRP    = ZRP + ZRI1C * (ZC1B5-ZC2B5)
  ZC1B   = ZC1B + ZRI1C * ZRP5
  ZC2B   = ZC2B - ZRI1C * ZRP5
  ZBETA  = ZBETA - ZRI1C

  ZC1B   = ZC1B + ZRI0C
  ZC2B   = ZC2B + ZRI0C
  ZALPHA = ZALPHA - ZRI0C

  ZXP2P   = ZXP2P + ZC2B * ZB235 * ZIDENB5
  ZB21   = ZB21 - ZC2B * ZAP2B5 * ZIDENB5
  ZB23   = ZB23 + ZC2B * ZXP2P5 * ZIDENB5
  ZAP2B   = ZAP2B - ZC2B * ZB215 * ZIDENB5
  ZIDENB  = ZIDENB + ZC2B*(ZXP2P5*ZB235-ZB215*ZAP2B5)

  ZB22   = ZB22 + ZC1B * ZAP2B5 * ZIDENB5
  ZXM2P   = ZXM2P - ZC1B * ZB235 * ZIDENB5
  ZAP2B   = ZAP2B + ZC1B * ZB225 * ZIDENB5
  ZB23   = ZB23 - ZC1B * ZXM2P5 * ZIDENB5
  ZIDENB  = ZIDENB + ZC1B*(ZB225*ZAP2B5-ZXM2P5*ZB235)
  ZDENB  = ZDENB -ZIDENB*(ZIDENB5**2)

  ZXP2P   = ZXP2P + ZDENB * ZB225
  ZB21   = ZB21 - ZDENB * ZXM2P5
  ZB22   = ZB22 + ZDENB * ZXP2P5
  ZXM2P   = ZXM2P - ZDENB * ZB215

  ZA23   = ZA23 + ZB23
  PREF(JL) = PREF(JL) - ZB23 *ZEXMU05*(ZAP2B5-PRMUZ5(JL))
  ZEXMU0 = ZEXMU0 - ZB23 *PREF5(JL)*(ZAP2B5-PRMUZ5(JL))
  ZAP2B  = ZAP2B - ZB23 *PREF5(JL)*ZEXMU05
  PRMUZ(JL) = PRMUZ(JL) + ZB23 *PREF5(JL)*ZEXMU05

  ZA22   = ZA22 + ZB22
  PREF(JL) = PREF(JL) - ZB22 *ZXM2P5*ZEXKP5
  ZXM2P  = ZXM2P - ZB22 *PREF5(JL)*ZEXKP5
  ZEXKP  = ZEXKP - ZB22 *PREF5(JL)*ZXM2P5

  ZA21   = ZA21 + ZB21
  PREF(JL) = PREF(JL) - ZB21 *ZXP2P5*ZEXKM5
  ZXP2P  = ZXP2P - ZB21 *PREF5(JL)*ZEXKM5
  ZEXKM  = ZEXKM - ZB21 *PREF5(JL)*ZXP2P5

!1130 CONTINUE

  ZEXMU0 = ZEXMU0 + PTR1(JL)
  ZRI0B  = ZRI0B + PTR1(JL) *ZPRMUZ5
  ZRI1B  = ZRI1B + PTR1(JL)*ZDT5 *ZPRMUZ5
  ZPRMUZ = ZPRMUZ+ PTR1(JL)*(ZRI0B5+ZDT5*ZRI1B5)
  PTR1(JL)=0.0_JPRB

  ZRP    = ZRP + ZRI1B *(ZC1A5*ZEXKM5-ZC2A5*ZEXKP5)
  ZC1A   = ZC1A + ZRI1B *ZRP5*ZEXKM5
  ZC2A   = ZC2A - ZRI1B *ZRP5*ZEXKP5
  ZEXKM  = ZEXKM + ZRI1B *ZRP5*ZC1A5
  ZEXKP  = ZEXKP - ZRI1B *ZRP5*ZC2A5
  ZBETA  = ZBETA - ZRI1B *ZEXMU05
  ZEXMU0 = ZEXMU0 - ZRI1B *ZBETA5

  ZC1A   = ZC1A + ZRI0B *ZEXKM5
  ZC2A   = ZC2A + ZRI0B *ZEXKP5
  ZALPHA = ZALPHA - ZRI0B *ZEXMU05
  ZEXKM  = ZEXKM + ZRI0B *ZC1A5
  ZEXKP  = ZEXKP + ZRI0B *ZC2A5
  ZEXMU0 = ZEXMU0 - ZRI0B * ZALPHA5

  ZRI0A  = ZRI0A + PRE1(JL) *ZPRMUZ5
  ZRI1A  = ZRI1A - PRE1(JL)*ZDT5 *ZPRMUZ5
  ZPRMUZ = ZPRMUZ + PRE1(JL)*(ZRI0A5-ZDT5*ZRI1A5)
  PRE1(JL)=0.0_JPRB

  ZRP    = ZRP + ZRI1A *(ZC1A5-ZC2A5)
  ZC1A   = ZC1A + ZRI1A *ZRP5
  ZC2A   = ZC2A - ZRI1A *ZRP5
  ZBETA  = ZBETA - ZRI1A

  ZC1A   = ZC1A + ZRI0A
  ZC2A   = ZC2A + ZRI0A
  ZALPHA = ZALPHA - ZRI0A

  ZXP2P   = ZXP2P + ZC2A * ZA235 * ZIDENA5
  ZA21   = ZA21 - ZC2A * ZAP2B5 * ZIDENA5
  ZA23   = ZA23 + ZC2A * ZXP2P5 * ZIDENA5
  ZAP2B   = ZAP2B - ZC2A * ZA215 * ZIDENA5
  ZIDENA  = ZIDENA + ZC2A*(ZXP2P5*ZA235-ZA215*ZAP2B5)

  ZA22   = ZA22 + ZC1A * ZAP2B5 * ZIDENA5
  ZXM2P   = ZXM2P - ZC1A * ZA235 * ZIDENA5
  ZAP2B   = ZAP2B + ZC1A * ZA225 * ZIDENA5
  ZA23   = ZA23 - ZC1A * ZXM2P5 * ZIDENA5
  ZIDENA  = ZIDENA + ZC1A*(ZA225*ZAP2B5-ZXM2P5*ZA235)

  ZDENA  = ZDENA -ZIDENA*(ZIDENA5**2)

  ZXP2P   = ZXP2P + ZDENA * ZA225
  ZA21   = ZA21 - ZDENA * ZXM2P5
  ZA22   = ZA22 + ZDENA * ZXP2P5
  ZXM2P   = ZXM2P - ZDENA * ZA215

  ZAM2B  = ZAM2B + ZA23 * ZEXMU05
  ZEXMU0 = ZEXMU0 + ZA23 * ZAM2B5

  ZXM2P  = ZXM2P + ZA21 * ZEXKM5
  ZEXKM  = ZEXKM + ZA21 * ZXM2P5

  ZXP2P  = ZXP2P + ZA22 * ZEXKP5
  ZEXKP  = ZEXKP + ZA22 * ZXP2P5

!1120 CONTINUE

  ZALPHA = ZALPHA + ZAM2B
  ZBETA  = ZBETA - ZAM2B * ZDT5

  ZALPHA = ZALPHA + ZAP2B
  ZBETA  = ZBETA + ZAP2B * ZDT5

  ZRP    = ZRP - ZXM2P * ZDT5

  ZRP    = ZRP + ZXP2P * ZDT5

  ZEXKP  = ZEXKP - ZEXKM * (ZEXKM5**2)

  ZARG2  = ZARG2 + ZEXKP * ZEXKP5

  IF (ZRK5*ZTOP5 < 200._JPRB) THEN
    ZRK  = ZRK + ZARG2 * ZTOP5
    ZTOP = ZTOP + ZARG2 * ZRK5
  ENDIF

  ZARG   = ZARG - ZEXMU0 * ZEXMU05

  IF (ZARG15 < -200._JPRB) THEN
    ZARG = 0.0_JPRB
  ENDIF

  IF (ZTOP5*ZPRMUZ5 < 200._JPRB) THEN
    ZTOP = ZTOP + ZARG *ZPRMUZ5
    ZPRMUZ = ZPRMUZ + ZARG * ZTOP5 
  ENDIF

  PRMUZ(JL) = PRMUZ(JL) -ZPRMUZ*(ZPRMUZ5**2)

  ZWCP   = ZWCP &
   & + ZBETA *PRMUZ5(JL)*(1.0_JPRB+3._JPRB*ZGP5*ZRM25*ZWM5)*ZRR5  
  PRMUZ(JL) = PRMUZ(JL)&
   & + ZBETA *ZWCP5*(1.0_JPRB+3._JPRB*ZGP5*ZRM25*ZWM5)*ZRR5  
  ZGP    = ZGP+ ZBETA *ZWCP5*PRMUZ5(JL)*3._JPRB*ZRM25*ZWM5*ZRR5
  ZRM2   = ZRM2+ ZBETA *ZWCP5*PRMUZ5(JL)*3._JPRB*ZGP5*ZWM5*ZRR5
  ZWM    = ZWM+ ZBETA *ZWCP5*PRMUZ5(JL)*3._JPRB*ZGP5*ZRM25*ZRR5

  ZRR = ZRR + ZBETA *ZWCP5*PRMUZ5(JL)*(1.0_JPRB+3._JPRB*ZGP5*ZRM25*ZWM5)

  ZWCP   = ZWCP + ZALPHA *ZRM25*(1.0_JPRB+ZGP5*ZWM5)*ZRR5
  ZRM2   = ZRM2 + ZALPHA *ZWCP5*(1.0_JPRB+ZGP5*ZWM5)*ZRR5
  ZGP    = ZGP + ZALPHA *ZWCP5*ZRM25*ZWM5*ZRR5
  ZWM    = ZWM + ZALPHA *ZWCP5*ZRM25*ZGP5*ZRR5

  ZRR    = ZRR + ZALPHA *ZWCP5*ZRM25*(1.0_JPRB+ZGP5*ZWM5)

  ZRK    = ZRK + ZRP * ZDIV35
  ZX1    = ZX1 - ZRP *ZRK5*(ZDIV35**2)

  ZX2=ZX2-ZRR*(ZRR5*ZRR5)

  ZRK    = ZRK - ZX2 *2.0_JPRB*ZRK5*ZRM25*ZDT25
  ZRM2   = ZRM2 - ZX2 *ZRK5*ZRK5*ZDT25

  IF (ZRKI5 >= REPLOG) THEN
    ZWM    = ZWM + ZRK *0.5_JPRB*3._JPRB*ZX15 / ZRK5
    ZX1    = ZX1 + ZRK *0.5_JPRB*3._JPRB*ZWM5 / ZRK5
  ENDIF

  PRMUZ(JL) = PRMUZ(JL) + ZRM2 * 2 * PRMUZ5(JL)

  ZWCP   = ZWCP - ZWM

  ZWCP   = ZWCP - ZX1 * ZGP5
  ZGP    = ZGP - ZX1 * ZWCP5

  PW(JL) = PW(JL)+(1.0_JPRB-ZFF5)*ZDIV25*ZWCP
  ZFF = ZFF-PW5(JL)*ZDIV25*ZWCP
  ZPWFF = ZPWFF-(1.0_JPRB-ZFF5)*PW5(JL)*(ZDIV25**2)*ZWCP

  PTO1(JL) = PTO1(JL)+ZPWFF5*ZTOP
  ZPWFF = ZPWFF+PTO15(JL)*ZTOP

  ZFF = ZFF-PW5(JL)*ZPWFF
  PW(JL) = PW(JL)-ZFF5*ZPWFF

  PGG(JL) = PGG(JL) + ZGP * ZDIV15 
  PGG(JL) = PGG(JL) - ZGP *PGG5(JL)*(ZDIV15**2)

  PGG(JL) = PGG(JL) + ZFF *2*PGG5(JL)

!1110 CONTINUE      

ENDDO

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

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