SUBROUTINE SWR &
 &( KIDIA , KFDIA , KLON , KLEV  , KNU &
 &, PALBD , PCG   , PCLD , POMEGA, PSEC , PTAU &
 &, PCGAZ , PPIZAZ, PRAY1, PRAY2 , PREFZ, PRJ  , PRK , PRMUE &
 &, PTAUAZ, PTRA1 , PTRA2, PTRCLD &
 &)

!**** *SWR* - CONTINUUM SCATTERING COMPUTATIONS

!     PURPOSE.
!     --------
!           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
!     CONTINUUM SCATTERING

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

!          *SWR* IS CALLED EITHER FROM *SW1S*
!                              OR FROM *SWNI*

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

!     ==== INPUTS ===
!     ==== OUTPUTS ===

!     METHOD.
!     -------

!          1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL
!     OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION)

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

!          *SWDE*

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

!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-07-14
!        Ph. DANDIN Meteo-France 05-96 : Effect of cloud layer
!        JJMorcrette 990128 : sunshine duration
!        JJMorcrette 001218 : 6 spectral intervals
!     ------------------------------------------------------------------


#include "tsmbkind.h"

USE YOERAD   , ONLY : NOVLP    ,NSW
USE YOECLD   , ONLY : REPSEC
USE YOEOVLP  , ONLY : RA1OVLP


IMPLICIT NONE


!     DUMMY INTEGER SCALARS
INTEGER_M :: KFDIA
INTEGER_M :: KIDIA
INTEGER_M :: KLEV
INTEGER_M :: KLON
INTEGER_M :: KNU



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

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

REAL_B :: PALBD(KLON,NSW)      , PCG(KLON,NSW,KLEV)&
  &,  PCLD(KLON,KLEV)&
  &,  POMEGA(KLON,NSW,KLEV)&
  &,  PSEC(KLON)           , PTAU(KLON,NSW,KLEV)

REAL_B :: PRAY1(KLON,KLEV+1)   , PRAY2(KLON,KLEV+1)&
  &,  PREFZ(KLON,2,KLEV+1) , PRJ(KLON,6,KLEV+1)&
  &,  PRK(KLON,6,KLEV+1)   , PRMUE(KLON,KLEV+1)&
  &,  PCGAZ(KLON,KLEV)     , PPIZAZ(KLON,KLEV)&
  &,  PTAUAZ(KLON,KLEV)&
  &,  PTRA1(KLON,KLEV+1)   , PTRA2(KLON,KLEV+1)&
  &,  PTRCLD(KLON)

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

!*       0.2   LOCAL ARRAYS
!              ------------

REAL_B :: ZC1I(KLON,KLEV+1)    , ZCLEQ(KLON,KLEV)&
  &,  ZCLEAR(KLON)         , ZCLOUD(KLON) &
  &,  ZGG(KLON)            , ZREF(KLON)&
  &,  ZRE1(KLON)           , ZRE2(KLON)&
  &,  ZRMUZ(KLON)          , ZRNEB(KLON)&
  &,  ZR21(KLON)           , ZR22(KLON)&
  &,  ZR23(KLON)           , ZSS1(KLON)&
  &,  ZTO1(KLON)           , ZTR(KLON,2,KLEV+1)&
  &,  ZTR1(KLON)           , ZTR2(KLON)&
  &,  ZW(KLON)

!     LOCAL INTEGER SCALARS
INTEGER_M :: IKL, IKLP1, JA, JAJ, JK, JKM1, JL, INU1

!     LOCAL REAL SCALARS
REAL_B :: ZBMU0, ZBMU1, ZCORAE, ZCORCD, ZDEN, ZDEN1,&
          &ZFACOA, ZFACOC, ZGAP, ZMU1, ZMUE, ZRE11, &
          &ZTO, ZWW, ZALPHA1




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

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


DO JK = 1 , KLEV+1
  DO JA = 1 , 6
    DO JL = KIDIA,KFDIA
      PRJ(JL,JA,JK) = _ZERO_
      PRK(JL,JA,JK) = _ZERO_
    ENDDO
  ENDDO
ENDDO


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

!*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
!                ----------------------------------------------


DO JL = KIDIA,KFDIA
  ZR23(JL) = _ZERO_
  ZC1I(JL,KLEV+1) = _ZERO_
  ZCLEAR(JL) = _ONE_
  ZCLOUD(JL) = _ZERO_
ENDDO

JK = 1
IKL = KLEV+1 - JK
IKLP1 = IKL + 1
DO JL = KIDIA,KFDIA
  ZFACOA = _ONE_ - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
  ZFACOC = _ONE_ - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
  ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
  ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
  ZR21(JL) = EXP(MIN(-ZCORAE,500.)   )
  ZR22(JL) = EXP(MIN(-ZCORCD,500.)   )
  ZSS1(JL) = PCLD(JL,IKL)*(_ONE_-ZR21(JL)*ZR22(JL))&
   &+ (_ONE_-PCLD(JL,IKL))*(_ONE_-ZR21(JL))
  ZCLEQ(JL,IKL) = ZSS1(JL)

  IF (NOVLP == 1) THEN
!* maximum-random      
    ZCLEAR(JL) = ZCLEAR(JL)&
     &*(_ONE_-MAX(ZSS1(JL),ZCLOUD(JL)))&
     &/(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPSEC))
    ZC1I(JL,IKL) = _ONE_ - ZCLEAR(JL)
    ZCLOUD(JL) = ZSS1(JL)
  ELSEIF (NOVLP == 2) THEN
!* maximum
    ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
    ZC1I(JL,IKL) = ZCLOUD(JL)
  ELSEIF (NOVLP == 3) THEN
!* random
    ZCLEAR(JL) = ZCLEAR(JL)*(_ONE_ - ZSS1(JL))
    ZCLOUD(JL) = _ONE_ - ZCLEAR(JL)
    ZC1I(JL,IKL) = ZCLOUD(JL)
  ELSEIF (NOVLP == 4) THEN
!* Hogan & Illingworth, 2001  
    ZALPHA1=RA1OVLP(KLEV+1-JK)
    ZCLEAR(JL)=ZCLEAR(JL)*( &
      & ZALPHA1*(_ONE_-MAX(ZSS1(JL),ZCLOUD(JL))) &
      &        /(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPSEC)) &
      & +(_ONE_-ZALPHA1)*(_ONE_-ZSS1(JL)) )
    ZC1I(JL,IKL) = _ONE_ - ZCLEAR(JL) 
    ZCLOUD(JL) = ZSS1(JL)
  ENDIF
ENDDO

DO JK = 2 , KLEV
  IKL = KLEV+1 - JK
  IKLP1 = IKL + 1
  DO JL = KIDIA,KFDIA
    ZFACOA = _ONE_ - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
    ZFACOC = _ONE_ - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
    ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
    ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
    ZR21(JL) = EXP(MIN(-ZCORAE,500.)   )
    ZR22(JL) = EXP(MIN(-ZCORCD,500.)   )
    ZSS1(JL) = PCLD(JL,IKL)*(_ONE_-ZR21(JL)*ZR22(JL))&
     &+ (_ONE_-PCLD(JL,IKL))*(_ONE_-ZR21(JL))
    ZCLEQ(JL,IKL) = ZSS1(JL)

    IF (NOVLP == 1) THEN
!* maximum-random      
      ZCLEAR(JL) = ZCLEAR(JL)&
       &*(_ONE_-MAX(ZSS1(JL),ZCLOUD(JL)))&
       &/(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPSEC))
      ZC1I(JL,IKL) = _ONE_ - ZCLEAR(JL)
      ZCLOUD(JL) = ZSS1(JL)
    ELSEIF (NOVLP == 2) THEN
!* maximum
      ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
      ZC1I(JL,IKL) = ZCLOUD(JL)
    ELSEIF (NOVLP == 3) THEN
!* random
      ZCLEAR(JL) = ZCLEAR(JL)*(_ONE_ - ZSS1(JL))
      ZCLOUD(JL) = _ONE_ - ZCLEAR(JL)
      ZC1I(JL,IKL) = ZCLOUD(JL)
    ELSEIF (NOVLP == 4) THEN
!* Hogan & Illingworth, 2001  
      ZALPHA1=RA1OVLP(KLEV+1-JK)
      ZCLEAR(JL)=ZCLEAR(JL)*( &
        & ZALPHA1*(_ONE_-MAX(ZSS1(JL),ZCLOUD(JL))) &
        &        /(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPSEC)) &
        & +(_ONE_-ZALPHA1)*(_ONE_-ZSS1(JL)) )
      ZC1I(JL,IKL) = _ONE_ - ZCLEAR(JL) 
      ZCLOUD(JL) = ZSS1(JL)
    ENDIF
  ENDDO
ENDDO

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

!*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
!                -----------------------------------------------


DO JL = KIDIA,KFDIA
  PRAY1(JL,KLEV+1) = _ZERO_
  PRAY2(JL,KLEV+1) = _ZERO_
  PREFZ(JL,2,1) = PALBD(JL,KNU)
  PREFZ(JL,1,1) = PALBD(JL,KNU)
  PTRA1(JL,KLEV+1) = _ONE_
  PTRA2(JL,KLEV+1) = _ONE_
ENDDO

DO JK = 2 , KLEV+1
  JKM1 = JK-1
  DO JL = KIDIA,KFDIA
    ZRNEB(JL)= PCLD(JL,JKM1)
    ZRE1(JL)=_ZERO_
    ZTR1(JL)=_ZERO_
    ZRE2(JL)=_ZERO_
    ZTR2(JL)=_ZERO_


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

!*         3.1  EQUIVALENT ZENITH ANGLE
!               -----------------------


    ZMUE = (_ONE_-ZC1I(JL,JK)) * PSEC(JL)+ ZC1I(JL,JK) * 1.66_JPRB
!-- just to test Box-type computations
!    ZMUE = PSEC(JL)
    PRMUE(JL,JK) = _ONE_/ZMUE


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

!*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
!               ----------------------------------------------------


    ZGAP = PCGAZ(JL,JKM1)
    ZBMU0 = _HALF_ - 0.75_JPRB * ZGAP / ZMUE
    ZWW = PPIZAZ(JL,JKM1)
    ZTO = PTAUAZ(JL,JKM1)
    ZDEN = _ONE_ + (_ONE_ - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE &
     &+ (1-ZWW) * (_ONE_ - ZWW +_TWO_*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
    PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
    PTRA1(JL,JKM1) = _ONE_ / ZDEN

    ZMU1 = _HALF_
    ZBMU1 = _HALF_ - 0.75_JPRB * ZGAP * ZMU1
    ZDEN1= _ONE_ + (_ONE_ - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1 &
     &+ (1-ZWW) * (_ONE_ - ZWW +_TWO_*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1
    PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
    PTRA2(JL,JKM1) = _ONE_ / ZDEN1


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

!*         3.3  EFFECT OF CLOUD LAYER
!               ---------------------


    ZW(JL) = POMEGA(JL,KNU,JKM1)
    ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL)+ PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1)
    ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1)
    ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
    ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)&
     &+ (_ONE_ - ZR22(JL)) * PCGAZ(JL,JKM1)
    IF (ZW(JL) == _ONE_ .AND. PPIZAZ(JL,JKM1) == _ONE_) THEN
      ZW(JL)=_ONE_
    ELSE
      ZW(JL) = ZR21(JL) / ZTO1(JL)
    ENDIF
    ZREF(JL) = PREFZ(JL,1,JKM1)
    ZRMUZ(JL) = PRMUE(JL,JK)
  ENDDO

  CALL SWDE ( KIDIA, KFDIA , KLON &
   &, ZGG  , ZREF  , ZRMUZ , ZTO1 , ZW &
   &, ZRE1 , ZRE2  , ZTR1  , ZTR2      )

  DO JL = KIDIA,KFDIA

    PREFZ(JL,1,JK) = (_ONE_-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
     &+ PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)&
     &* PTRA2(JL,JKM1)&
     &/ (_ONE_-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))&
     &+ ZRNEB(JL) * ZRE2(JL)

    ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1)&
     &/ (_ONE_-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))&
     &* (_ONE_-ZRNEB(JL))

    PREFZ(JL,2,JK) = (_ONE_-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
     &+ PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
     &* PTRA2(JL,JKM1) )&
     &+ ZRNEB(JL) * ZRE1(JL)

    ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)+ PTRA1(JL,JKM1) * (_ONE_-ZRNEB(JL))

  ENDDO
ENDDO
DO JL = KIDIA,KFDIA
  ZMUE = (_ONE_-ZC1I(JL,1))*PSEC(JL)+ZC1I(JL,1)*1.66_JPRB
!-- just to test Box-type computations
!  ZMUE = PSEC(JL)
  PRMUE(JL,1)=_ONE_/ZMUE
  PTRCLD(JL)=_ONE_-ZC1I(JL,1)
ENDDO


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

!*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
!                 -------------------------------------------------


IF (NSW <= 4) THEN
  INU1=1
ELSE IF (NSW == 6) THEN
  INU1=3
END IF    

IF (KNU <= INU1) THEN
  JAJ = 2
  DO JL = KIDIA,KFDIA
    PRJ(JL,JAJ,KLEV+1) = _ONE_
    PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1)
  ENDDO

  DO JK = 1 , KLEV
    IKL = KLEV+1 - JK
    IKLP1 = IKL + 1
    DO JL = KIDIA,KFDIA
      ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL,  1,IKL)
      PRJ(JL,JAJ,IKL) = ZRE11
      PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL,  1,IKL)
    ENDDO
  ENDDO

ELSE

  DO JAJ = 1 , 2
    DO JL = KIDIA,KFDIA
      PRJ(JL,JAJ,KLEV+1) = _ONE_
      PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1)
    ENDDO

    DO JK = 1 , KLEV
      IKL = KLEV+1 - JK
      IKLP1 = IKL + 1
      DO JL = KIDIA,KFDIA
        ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL,JAJ,IKL)
        PRJ(JL,JAJ,IKL) = ZRE11
        PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL,JAJ,IKL)
      ENDDO
    ENDDO
  ENDDO

ENDIF

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

RETURN
END SUBROUTINE SWR
