!OPTIONS XOPT(NOEVAL)
SUBROUTINE LWC15 ( KIDIA,KFDIA,KLON,KLEV,&
 & KLIM,&
 & PBINT,PBSUIN,PCLDLD,PCLDLU,PCNTRB,PCTS,PEMIS,PFDN,PFUP,&
 & PFLUX                                                 )  

!**** *LWC15*   - LONGWAVE RADIATION, CLOUD EFFECTS

!     PURPOSE.
!     --------
!           INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
!           RADIANCES

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

!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===
! PBINT  : (KLON,KLEV+1)     ; HALF LEVEL PLANCK FUNCTION
! PBSUIN : (KLON)            ; SURFACE PLANCK FUNCTION
! PCLDLD : (KLON,KLEV)       ; DOWNWARD EFFECTIVE CLOUD FRACTION
! PCLDLU : (KLON,KLEV)       ; UPWARD EFFECTIVE CLOUD FRACTION
! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE
! PCTS   : (KLON,KLEV)       ; CLEAR-SKY LAYER COOLING-TO-SPACE
! PEMIS  : (KLON)            ; SURFACE EMISSIVITY
! PFDN   : (KLON,KLEV+1)     ; CLEAR-SKY DOWNWARD FLUX
! PFUP   : (KLON,KLEV+1)     ; CLEAR-SKY UPWARD FLUX
!     ==== OUTPUTS ===
! PFLUX(KLON,2,KLEV)         ; RADIATIVE FLUXES :
!                     1  ==>  UPWARD   FLUX TOTAL
!                     2  ==>  DOWNWARD FLUX TOTAL

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

!     METHOD.
!     -------

!          1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
!          2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
!          3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
!     CLOUDS

!     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 : 89-07-14 BY JEAN-JACQUES MORCRETTE  *ECMWF*

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

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

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

USE YOMRAD15 , ONLY : NOVLP15
USE YOMRDU15 , ONLY : REPSC15  ,REPSEC15

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 
INTEGER(KIND=JPIM)               :: KLIM ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBINT(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBSUIN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDLD(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDLU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCNTRB(KLON,KLEV+1,KLEV+1) 
REAL(KIND=JPRB)                  :: PCTS(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFDN(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFUP(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KLON,2,KLEV+1) 
!-----------------------------------------------------------------------

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

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

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

INTEGER(KIND=JPIM) :: IMX(KLON), IMXP(KLON)

REAL(KIND=JPRB) :: ZCLEAR(KLON),ZCLOUD(KLON),ZDNF(KLON,KLEV+1,KLEV+1)&
 & , ZFD(KLON), ZFU(KLON)&
 & , ZUPF(KLON,KLEV+1,KLEV+1)  
REAL(KIND=JPRB) :: ZCLM(KLON,KLEV+1,KLEV+1)

INTEGER(KIND=JPIM) :: IMAXC, IMX1, IMX2, IMXM1, IMXP1, JCLOUD,&
 & JK, JK1, JK2, JKC, JKCP1, JKJ, JKM1, JKP1, &
 & JL  

REAL(KIND=JPRB) :: ZCFRAC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('LWC15',0,ZHOOK_HANDLE)
IMAXC = 0

DO JL = KIDIA,KFDIA
  IMX(JL)=0
  IMXP(JL)=0
  ZCLOUD(JL) = 0.0_JPRB
ENDDO

!*         1.1    SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
!                 -------------------------------------------

DO JK = 1 , KLEV
  DO JL = KIDIA,KFDIA
    IMX1=IMX(JL)
    IMX2=JK
    IF (PCLDLU(JL,JK) > REPSC15) THEN
      IMXP(JL)=IMX2
    ELSE
      IMXP(JL)=IMX1
    ENDIF
    IMAXC=MAX(IMXP(JL),IMAXC)
    IMX(JL)=IMXP(JL)
  ENDDO
ENDDO
!GM*******
IMAXC=KLEV
!GM*******

DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    PFLUX(JL,1,JK) = PFUP(JL,JK)
    PFLUX(JL,2,JK) = PFDN(JL,JK)
  ENDDO
ENDDO

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

!*         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
!                  ---------------------------------------

IF (IMAXC > 0) THEN

  IMXP1 = IMAXC + 1
  IMXM1 = IMAXC - 1

!*         2.0     INITIALIZE TO CLEAR-SKY FLUXES
!                  ------------------------------

  DO JK1=1,KLEV+1
    DO JK2=1,KLEV+1
      DO JL = KIDIA,KFDIA
        ZUPF(JL,JK2,JK1)=PFUP(JL,JK1)
        ZDNF(JL,JK2,JK1)=PFDN(JL,JK1)
      ENDDO
    ENDDO
  ENDDO

!*         2.1     FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
!                  ----------------------------------------------

  DO JKC = 1 , IMAXC
    JCLOUD=JKC
    JKCP1=JCLOUD+1

!*         2.1.1   ABOVE THE CLOUD
!                  ---------------

    DO JK=JKCP1,KLEV+1
      JKM1=JK-1
      DO JL = KIDIA,KFDIA
        ZFU(JL)=0.0_JPRB
      ENDDO
      IF (JK  >  JKCP1) THEN
        DO JKJ=JKCP1,JKM1
          DO JL = KIDIA,KFDIA
            ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
          ENDDO
        ENDDO
      ENDIF

      DO JL = KIDIA,KFDIA
        ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL)
      ENDDO
    ENDDO

!*         2.1.2   BELOW THE CLOUD
!                  ---------------

    DO JK=1,JCLOUD
      JKP1=JK+1
      DO JL = KIDIA,KFDIA
        ZFD(JL)=0.0_JPRB
      ENDDO

      IF (JK  <  JCLOUD) THEN
        DO JKJ=JKP1,JCLOUD
          DO JL = KIDIA,KFDIA
            ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
          ENDDO
        ENDDO
      ENDIF
      DO JL = KIDIA,KFDIA
        ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL)
      ENDDO
    ENDDO

  ENDDO

!*         2.2     CLOUD COVER MATRIX
!                  ------------------

!*    ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
!     HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1

  DO JK1 = 1 , KLEV+1
    DO JK2 = 1 , KLEV+1
      DO JL = KIDIA,KFDIA
        ZCLM(JL,JK1,JK2) = 0.0_JPRB
      ENDDO
    ENDDO
  ENDDO

!*         2.4     CLOUD COVER BELOW THE LEVEL OF CALCULATION
!                  ------------------------------------------

  DO JK1 = 2 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZCLEAR(JL)=1.0_JPRB
      ZCLOUD(JL)=0.0_JPRB
    ENDDO
    DO JK = JK1 - 1 , 1 , -1
      DO JL = KIDIA,KFDIA
        IF (NOVLP15 == 1) THEN
!* maximum-random       
          ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-MAX(PCLDLU(JL,JK),&
           & ZCLOUD(JL)))&
           & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC15))  
          ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL)
          ZCLOUD(JL) = PCLDLU(JL,JK)
        ELSEIF (NOVLP15 == 2) THEN
!* maximum      
          ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK))
          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
        ELSEIF (NOVLP15 == 3) THEN
!* random      
          ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - PCLDLU(JL,JK))
          ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
        ENDIF
      ENDDO
    ENDDO
  ENDDO

!*         2.5     CLOUD COVER ABOVE THE LEVEL OF CALCULATION
!                  ------------------------------------------

  DO JK1 = 1 , KLEV
    DO JL = KIDIA,KFDIA
      ZCLEAR(JL)=1.0_JPRB
      ZCLOUD(JL)=0.0_JPRB
    ENDDO
    DO JK = JK1 , KLEV
      DO JL = KIDIA,KFDIA
        IF (NOVLP15 == 1) THEN
!* maximum-random       
          ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-MAX(PCLDLD(JL,JK),&
           & ZCLOUD(JL)))&
           & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC15))  
          ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL)
          ZCLOUD(JL) = PCLDLD(JL,JK)
        ELSEIF (NOVLP15 == 2) THEN
!* maximum      
          ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
        ELSEIF (NOVLP15 == 3) THEN
!* random      
          ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - PCLDLD(JL,JK))
          ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
        ENDIF
      ENDDO
    ENDDO
  ENDDO

!*         3.      FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
!                  ----------------------------------------------

!*         3.1     DOWNWARD FLUXES
!                  ---------------

  DO JL = KIDIA,KFDIA
    PFLUX(JL,2,KLEV+1) = 0.0_JPRB
  ENDDO

  DO JK1 = KLEV , 1 , -1

!*                 CONTRIBUTION FROM CLEAR-SKY FRACTION

    DO JL = KIDIA,KFDIA
      ZFD (JL) = (1.0_JPRB - ZCLM(JL,JK1,KLEV)) * ZDNF(JL,1,JK1)
    ENDDO

!*                 CONTRIBUTION FROM ADJACENT CLOUD

    DO JL = KIDIA,KFDIA
      ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
    ENDDO

!*                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS

    DO JK = KLEV-1 , JK1 , -1
      DO JL = KIDIA,KFDIA
        ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
        ZFD(JL) =  ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
      ENDDO
    ENDDO

    DO JL = KIDIA,KFDIA
      PFLUX(JL,2,JK1) = ZFD (JL)
    ENDDO

  ENDDO

!*         3.2     UPWARD FLUX AT THE SURFACE
!                  --------------------------

  DO JL = KIDIA,KFDIA
    PFLUX(JL,1,1) = PEMIS(JL)*PBSUIN(JL)-(1.0_JPRB-PEMIS(JL))*PFLUX(JL,2,1)
  ENDDO

!*         3.3     UPWARD FLUXES
!                  -------------

  DO JK1 = 2 , KLEV+1

!*                 CONTRIBUTION FROM CLEAR-SKY FRACTION

    DO JL = KIDIA,KFDIA
      ZFU (JL) = (1.0_JPRB - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
    ENDDO

!*                 CONTRIBUTION FROM ADJACENT CLOUD

    DO JL = KIDIA,KFDIA
      ZFU(JL) =  ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
    ENDDO

!*                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS

    DO JK = 2 , JK1-1
      DO JL = KIDIA,KFDIA
        ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
        ZFU(JL) =  ZFU(JL) + ZCFRAC * ZUPF(JL,JK  ,JK1)
      ENDDO
    ENDDO

    DO JL = KIDIA,KFDIA
      PFLUX(JL,1,JK1) = ZFU (JL)
    ENDDO

  ENDDO

ENDIF

!*         2.3     END OF CLOUD EFFECT COMPUTATIONS

IF (LHOOK) CALL DR_HOOK('LWC15',1,ZHOOK_HANDLE)

!-----------------------------------------------------------------------
!                       FORMATS
!                       -------

884 FORMAT (1X,F7.2,18F6.1,F7.2)
886 FORMAT (1X,20I5)
888 FORMAT (1X,13E9.2)
890 FORMAT (1X,2I4,13F9.2)

END SUBROUTINE LWC15
