SUBROUTINE OLWC ( KIDIA,KFDIA,KLON,KLEV &
     &  , PBINT,PBSUIN,PCLDLD,PCLDLU,PCNTRB,PEMIS,PFDN,PFUP &
     &  , PFLUX                                                 )
!
!**** *LWC*   - 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
! 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.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*
!
!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-07-14
!-----------------------------------------------------------------------

#include "tsmbkind.h"

USE YOERAD   , ONLY : NOVLP
USE YOERDI   , ONLY : REPCLC
USE YOEDBUG  , ONLY : LDEBUG


IMPLICIT NONE



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

!-----------------------------------------------------------------------
!
!*       0.1   ARGUMENTS
!              ---------
!
REAL_B :: PBINT(KLON,KLEV+1),PBSUIN(KLON),PCLDLD(KLON,KLEV) &
     &  ,  PCLDLU(KLON,KLEV) &
     &  ,  PCNTRB(KLON,KLEV+1,KLEV+1) &
     &  ,  PFDN(KLON,KLEV+1),PFUP(KLON,KLEV+1) &
     &  ,  PEMIS(KLON)
!
REAL_B :: PFLUX(KLON,2,KLEV+1)
!
!-----------------------------------------------------------------------
!
!*       0.2   LOCAL ARRAYS
!              ------------
!
INTEGER_M :: IMX(KLON), IMXP(KLON)
!
REAL_B :: ZCLEAR(KLON),ZCLOUD(KLON),ZDNF(KLON,KLEV+1,KLEV+1) &
     &  , ZFD(KLON), ZFN10(KLON), ZFU(KLON) &
     &  , ZUPF(KLON,KLEV+1,KLEV+1) &
     &  , ZCLM(KLON,KLEV+1,KLEV+1)
!
!     LOCAL INTEGER SCALARS
INTEGER_M :: IKCP1, IKM1, IKP1, IMAXC, IMXM1, IMXP1, JCLOUD,&
             &JK, JK1, JK2, JKJ, JL, IMX1, IMX2, JKC, JKCP1, JKM1, JKP1

!     LOCAL REAL SCALARS
REAL_B :: ZCFRAC

!     ------------------------------------------------------------------
!
!*         1.     INITIALIZATION
!                 --------------
!
IMAXC = 0
!
DO JL = KIDIA,KFDIA
  IMX(JL)=0
  IMXP(JL)=0
  ZCLOUD(JL) = 0.
END DO
!
!*         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).GT.REPCLC) THEN
      IMXP(JL)=IMX2
    ELSE
      IMXP(JL)=IMX1
    END IF
    IMAXC=MAX(IMXP(JL),IMAXC)
    IMX(JL)=IMXP(JL)
  END DO
END DO
!CGM*******
IMAXC=KLEV
!CGM*******
!
DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    PFLUX(JL,1,JK) = PFUP(JL,JK)
    PFLUX(JL,2,JK) = PFDN(JL,JK)
  END DO
END DO
!
!     ------------------------------------------------------------------
!
!*         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
!                  ---------------------------------------
!
IF (IMAXC.GT.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)
      END DO
    END DO
  END DO
!
!*         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.
      END DO
      IF (JK .GT. JKCP1) THEN
        DO JKJ=JKCP1,JKM1
          DO JL = KIDIA,KFDIA
            ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
          END DO
        END DO
      END IF
!
      DO JL = KIDIA,KFDIA
        ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL)
      END DO
    END DO
!
!*         2.1.2   BELOW THE CLOUD
!                  ---------------
!
    DO JK=1,JCLOUD
      JKP1=JK+1
      DO JL = KIDIA,KFDIA
        ZFD(JL)=0.
      END DO
!
      IF (JK .LT. JCLOUD) THEN
        DO JKJ=JKP1,JCLOUD
          DO JL = KIDIA,KFDIA
            ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
          END DO
        END DO
      END IF
      DO JL = KIDIA,KFDIA
        ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL)
      END DO
    END DO
!
  END DO
!
!
!*         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.
      END DO
    END DO
  END DO
!
!
!
!*         2.4     CLOUD COVER BELOW THE LEVEL OF CALCULATION
!                  ------------------------------------------
!
  DO JK1 = 2 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZCLEAR(JL)=1.
      ZCLOUD(JL)=0.
    END DO
    DO JK = JK1 - 1 , 1 , -1
      DO JL = KIDIA,KFDIA
        IF (NOVLP.EQ.1) THEN
!* maximum-random       
          ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL))) &
          &                       /(1.0-MIN(ZCLOUD(JL),1.-REPCLC))
          ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
          ZCLOUD(JL) = PCLDLU(JL,JK)
        ELSE IF (NOVLP.EQ.2) THEN 
!* maximum      
          ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK))
          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
        ELSE IF (NOVLP.EQ.3) THEN
!* random      
          ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK))
          ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
        END IF
      END DO
    END DO
  END DO
!
!
!*         2.5     CLOUD COVER ABOVE THE LEVEL OF CALCULATION
!                  ------------------------------------------
!
  DO JK1 = 1 , KLEV
    DO JL = KIDIA,KFDIA
      ZCLEAR(JL)=1.
      ZCLOUD(JL)=0.
    END DO
    DO JK = JK1 , KLEV
      DO JL = KIDIA,KFDIA
        IF (NOVLP.EQ.1) THEN
!* maximum-random       
           ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL))) &
           &                    /(1.0-MIN(ZCLOUD(JL),1.-REPCLC))
           ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
           ZCLOUD(JL) = PCLDLD(JL,JK)
         ELSE IF (NOVLP.EQ.2) THEN 
!* maximum      
           ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
           ZCLM(JL,JK1,JK) = ZCLOUD(JL)
         ELSE IF (NOVLP.EQ.3) THEN
!* random      
           ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK))
           ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
           ZCLM(JL,JK1,JK) = ZCLOUD(JL)
         END IF
       END DO
     END DO
   END DO
!
!
!
!*         3.      FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
!                  ----------------------------------------------
!
!*         3.1     DOWNWARD FLUXES
!                  ---------------
!
  DO JL = KIDIA,KFDIA
    PFLUX(JL,2,KLEV+1) = 0.
  END DO
!
  DO JK1 = KLEV , 1 , -1
!
!*                 CONTRIBUTION FROM CLEAR-SKY FRACTION
!
    DO JL = KIDIA,KFDIA
      ZFD (JL) = (1. - ZCLM(JL,JK1,KLEV)) * ZDNF(JL,1,JK1)
!
!*                 CONTRIBUTION FROM ADJACENT CLOUD
!
      ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
    END DO
!
!*                 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)
      END DO
    END DO
!
    DO JL = KIDIA,KFDIA
      PFLUX(JL,2,JK1) = ZFD (JL)
    END DO
!
  END DO
!
!
!
!
!*         3.2     UPWARD FLUX AT THE SURFACE
!                  --------------------------
!
  DO JL = KIDIA,KFDIA
    PFLUX(JL,1,1) = PEMIS(JL)*PBSUIN(JL)-(1.-PEMIS(JL))*PFLUX(JL,2,1)
  END DO
!
!
!
!*         3.3     UPWARD FLUXES
!                  -------------
!
  DO JK1 = 2 , KLEV+1
!
!*                 CONTRIBUTION FROM CLEAR-SKY FRACTION
!
    DO JL = KIDIA,KFDIA
      ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
!
!*                 CONTRIBUTION FROM ADJACENT CLOUD
!
      ZFU(JL) =  ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
    END DO
!
!*                 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)
      END DO
    END DO
!
    DO JL = KIDIA,KFDIA
      PFLUX(JL,1,JK1) = ZFU (JL)
    END DO
!
  END DO
!
!
END IF
!
!
!*         2.3     END OF CLOUD EFFECT COMPUTATIONS
!
!----------------------------------------------------------------------
RETURN
END SUBROUTINE OLWC
