SUBROUTINE SWCLR &
  &( KIDIA , KFDIA , KLON  , KLEV  , KAER  , KNU &
  &, PAER  , PALBP , PDSIG , PRAYL , PSEC &
  &, PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ  &
  &, PRK   , PRMU0 , PTAUAZ, PTRA1 , PTRA2 , PTRCLR &
  &)

!**** *SWCLR* - CLEAR-SKY COLUMN COMPUTATIONS

!     PURPOSE.
!     --------
!           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
!     CLEAR-SKY COLUMN

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

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

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

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

!     METHOD.
!     -------


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

!          NONE

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

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

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 94-11-15
!        Modified : 96-03-19 JJM-PhD (loop 107 in absence of aerosols)
!        JJMorcrette 990128 : sunshine duration
!        JJMorcrette 990128 : sunshine duration
!        99-05-25   JJMorcrette    Revised aerosols
!        JJMorcrette 001218 : 6 spectral intervals
   
!     ------------------------------------------------------------------


#include "tsmbkind.h"

USE YOESW    , ONLY : RTAUA    ,RPIZA    ,RCGA
USE YOERAD   , ONLY : NOVLP    ,NSW
USE YOERDI   , ONLY : REPCLC
USE YOERDU   , ONLY : REPSCT


IMPLICIT NONE


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



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

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

REAL_B :: PAER(KLON,6,KLEV), PALBP(KLON,NSW)&
  &,  PDSIG(KLON,KLEV)&
  &,  PRAYL(KLON)&
  &,  PSEC(KLON)

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

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

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

REAL_B :: ZC0I(KLON,KLEV+1)&
  &,  ZCLE0(KLON,KLEV), ZCLEAR(KLON) &
  &,  ZR21(KLON)&
  &,  ZR23(KLON) , ZSS0(KLON) , ZSCAT(KLON)&
  &,  ZTR(KLON,2,KLEV+1)

!     LOCAL INTEGER SCALARS
INTEGER_M :: IKL, JA, JAE, JAJ, JK, JKL, JKLP1, JKM1, JL, INU1

!     LOCAL REAL SCALARS
REAL_B :: ZBMU0, ZBMU1, ZCORAE, ZDEN, ZDEN1, ZFACOA,&
          &ZFF, ZGAP, ZGAR, ZMU1, ZMUE, ZRATIO, ZRE11, &
          &ZTO, ZTRAY, ZWW


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

!*         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
!                --------------------------------------------


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

! ------   NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM

DO JK = 1 , KLEV
  IKL=KLEV+1-JK
  DO JL = KIDIA,KFDIA
    PCGAZ(JL,JK) = _ZERO_
    PPIZAZ(JL,JK) =  _ZERO_
    PTAUAZ(JL,JK) = _ZERO_
  ENDDO
  DO JAE=1,6
    DO JL = KIDIA,KFDIA
      PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL, JAE, IKL)*RTAUA(KNU,JAE)
      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL, JAE, IKL)&
       &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
      PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL, JAE, IKL)&
       &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
    ENDDO
  ENDDO

  DO JL = KIDIA,KFDIA
    IF (KAER /= 0) THEN
      PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
      ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
      ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))
      ZGAR = PCGAZ(JL,JK)
      ZFF = ZGAR * ZGAR
      PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(_ONE_-PPIZAZ(JL,JK)*ZFF)
      PCGAZ(JL,JK) = ZGAR * (_ONE_ - ZRATIO) / (_ONE_ + ZGAR)
      PPIZAZ(JL,JK) =ZRATIO+(_ONE_-ZRATIO)*PPIZAZ(JL,JK)*(_ONE_-ZFF)&
       &/ (_ONE_ - PPIZAZ(JL,JK) * ZFF)
    ELSE
      ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
      PTAUAZ(JL,JK) = ZTRAY
      PCGAZ(JL,JK) = _ZERO_
      PPIZAZ(JL,JK) = _ONE_-REPSCT
    ENDIF
  ENDDO
ENDDO

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

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


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

JK = 1
JKL = KLEV+1 - JK
JKLP1 = JKL + 1
DO JL = KIDIA,KFDIA
  ZFACOA = _ONE_ - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
  ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
  ZR21(JL) = EXP(-ZCORAE   )
  ZSS0(JL) = _ONE_-ZR21(JL)
  ZCLE0(JL,JKL) = ZSS0(JL)

  IF (NOVLP == 1 .OR. NOVLP == 4) THEN
!* maximum-random      
    ZCLEAR(JL) = ZCLEAR(JL)&
     &*(_ONE_-MAX(ZSS0(JL),ZSCAT(JL)))&
     &/(_ONE_-MIN(ZSCAT(JL),_ONE_-REPCLC))
    ZC0I(JL,JKL) = _ONE_ - ZCLEAR(JL)
    ZSCAT(JL) = ZSS0(JL)
  ELSEIF (NOVLP == 2) THEN
!* maximum
    ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
    ZC0I(JL,JKL) = ZSCAT(JL)
  ELSEIF (NOVLP == 3) THEN
!* random
    ZCLEAR(JL)=ZCLEAR(JL)*(_ONE_-ZSS0(JL))
    ZSCAT(JL) = _ONE_ - ZCLEAR(JL)
    ZC0I(JL,JKL) = ZSCAT(JL)
  ENDIF
ENDDO

DO JK = 2 , KLEV
  JKL = KLEV+1 - JK
  JKLP1 = JKL + 1
  DO JL = KIDIA,KFDIA
    ZFACOA = _ONE_ - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
    ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
    ZR21(JL) = EXP(-ZCORAE   )
    ZSS0(JL) = _ONE_-ZR21(JL)
    ZCLE0(JL,JKL) = ZSS0(JL)

    IF (NOVLP == 1 .OR. NOVLP == 4) THEN
!* maximum-random      
      ZCLEAR(JL) = ZCLEAR(JL)&
       &*(_ONE_-MAX(ZSS0(JL),ZSCAT(JL)))&
       &/(_ONE_-MIN(ZSCAT(JL),_ONE_-REPCLC))
      ZC0I(JL,JKL) = _ONE_ - ZCLEAR(JL)
      ZSCAT(JL) = ZSS0(JL)
    ELSEIF (NOVLP == 2) THEN
!* maximum
      ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
      ZC0I(JL,JKL) = ZSCAT(JL)
    ELSEIF (NOVLP == 3) THEN
!* random
      ZCLEAR(JL)=ZCLEAR(JL)*(_ONE_-ZSS0(JL))
      ZSCAT(JL) = _ONE_ - ZCLEAR(JL)
      ZC0I(JL,JKL) = ZSCAT(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) = PALBP(JL,KNU)
  PREFZ(JL,1,1) = PALBP(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


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

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


    ZMUE = (_ONE_-ZC0I(JL,JK)) * PSEC(JL)+ ZC0I(JL,JK) * 1.66_JPRB
    PRMU0(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



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

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

    PREFZ(JL,2,JK) = (PRAY1(JL,JKM1)&
     &+ PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
     &* PTRA2(JL,JKM1) )

    ZTR(JL,2,JKM1) = PTRA1(JL,JKM1)

  ENDDO
ENDDO
DO JL = KIDIA,KFDIA
  ZMUE = (_ONE_-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66_JPRB
  PRMU0(JL,1)=_ONE_/ZMUE
  PTRCLR(JL)=_ONE_-ZC0I(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
    JKL = KLEV+1 - JK
    JKLP1 = JKL + 1
    DO JL = KIDIA,KFDIA
      ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
      PRJ(JL,JAJ,JKL) = ZRE11
      PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,  1,JKL)
    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
      JKL = KLEV+1 - JK
      JKLP1 = JKL + 1
      DO JL = KIDIA,KFDIA
        ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
        PRJ(JL,JAJ,JKL) = ZRE11
        PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
      ENDDO
    ENDDO
  ENDDO

ENDIF

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

RETURN
END SUBROUTINE SWCLR
