SUBROUTINE OLWVB ( KIDIA,KFDIA,KLON,KLEV,KUAER &
     &  , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP &
     &  , PDISD,PDISU,PEMIS &
     &  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP &
     &  , PFLUC )
!
!**** *LWVB*   - L.W., VERTICAL INTEGRATION, EXCHANGE WITH BOUNDARIES
!
!     PURPOSE.
!     --------
!           INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
!           INTEGRATION
!
!**   INTERFACE.
!     ----------
!
!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===
! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS
! PADJ.. : (KLON,KLEV+1)     ; CONTRIBUTION BY ADJACENT LAYERS
! PB     : (KLON,NISP,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
! PBINT  : (KLON,KLEV+1)     ; HALF-LEVEL PLANCK FUNCTIONS
! PBSUI  : (KLON)            ; SURFACE PLANCK FUNCTION
! PBSUR  : (KLON,NISP)       ; SPECTRAL SURFACE PLANCK FUNCTION
! PBTOP  : (KLON,NISP)       ; SPECTRAL T.O.A. PLANCK FUNCTION
! PDIS.. : (KLON,KLEV+1)     ; CONTRIBUTION BY DISTANT LAYERS
! PEMIS  : (KLON)            ; SURFACE EMISSIVITY
! PGA, PGB                   ; PADE APPROXIMANTS
! PGASUR, PGBSUR             ; SURFACE PADE APPROXIMANTS
! PGATOP, PGBTOP             ; T.O.A. PADE APPROXIMANTS 
!     ==== OUTPUTS ===
! PFLUC(KLON,2,KLEV)         ; RADIATIVE FLUXES CLEAR-SKY:
!                     1  ==>  UPWARD   FLUX TOTAL
!
!        IMPLICIT ARGUMENTS :   NONE
!        --------------------
!
!     METHOD.
!     -------
!
!          1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
!     ATMOSPHERE
!          2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND
!     TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA
!          3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES
!
!     EXTERNALS.
!     ----------
!
!          *LWTT*
!
!     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 YOEOLW   , ONLY : NISP     ,NIPD     ,NTRA     ,NUA      ,NG1P1


IMPLICIT NONE


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


!-----------------------------------------------------------------------
!
!*       0.1   ARGUMENTS
!              ---------
!
!
REAL_B :: PABCU(KLON,NUA,3*KLEV+1) &
     &  ,  PADJD(KLON,KLEV+1), PADJU(KLON,KLEV+1) &
     &  ,  PB(KLON,NISP,KLEV+1), PBINT(KLON,KLEV+1) &
     &  ,  PBSUR(KLON,NISP), PBSUI(KLON), PBTOP(KLON,NISP) &
     &  ,  PDISD(KLON,KLEV+1), PDISU(KLON,KLEV+1) &
     &  ,  PEMIS(KLON) &
     &  ,  PGA(KLON,8,2,KLEV), PGB(KLON,8,2,KLEV) &
     &  ,  PGASUR(KLON,8,2), PGBSUR(KLON,8,2) &
     &  ,  PGATOP(KLON,8,2), PGBTOP(KLON,8,2)
!
REAL_B :: PFLUC(KLON,2,KLEV+1) 
!
!-----------------------------------------------------------------------
!
!*       0.2   LOCAL ARRAYS
!              ------------
!
INTEGER_M :: ITX(KLON)
!
REAL_B :: ZBGND(KLON), ZFD(KLON), ZFDN(KLON,KLEV+1) &
     &  ,  ZFN10(KLON), ZFU(KLON), ZFUP(KLON,KLEV+1) &
     &  ,  ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA) &
     &  ,  ZUU(KLON,NUA) , ZCNSOL(KLON), ZCNTOP(KLON)
!

!     LOCAL INTEGER SCALARS
INTEGER_M :: IN, JA, JK, JL, IND1, IND2, IND3, IND4, JLIM

!     LOCAL REAL SCALARS
REAL_B :: ZCNTOP1, ZCNTOP2, ZCNTOP3, ZCNTOP4, ZCNTOP5, ZCNTOP6

!-----------------------------------------------------------------------
!
!*         1.    INITIALIZATION
!                --------------
!
!
!*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
!                  ---------------------------------
!
DO JA=1,NTRA
  DO JL=KIDIA,KFDIA
    ZTT (JL,JA)=1.0
    ZTT1(JL,JA)=1.0
    ZTT2(JL,JA)=1.0
  END DO
END DO
!
DO JA=1,NUA
  DO JL=KIDIA,KFDIA
    ZUU(JL,JA)=1.0
  END DO
END DO
!
!     ------------------------------------------------------------------
!
!*         2.      VERTICAL INTEGRATION
!                  --------------------
!
IND1=0
IND3=0
IND4=1
IND2=1
!
!
!*         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE
!                  -----------------------------------
!
DO JK = 1 , KLEV
  IN=(JK-1)*NG1P1+1
!
  DO JA=1,KUAER
    DO JL=KIDIA,KFDIA
      ZUU(JL,JA)=PABCU(JL,JA,IN)
    END DO
  END DO
!
!
  CALL LWTT ( KIDIA,KFDIA,KLON &
     &          , PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT )
!
  DO JL = KIDIA,KFDIA
    ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1)          *ZTT(JL,10) &
    &      +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) &
    &      +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) &
    &      +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) &
    &      +PBTOP(JL,5)*ZTT(JL,3)          *ZTT(JL,14) &
    &      +PBTOP(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
    ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
    ZFDN(JL,JK)=ZFD(JL)
    PFLUC(JL,2,JK)=ZFD(JL)
  END DO
!
END DO
!
JK = KLEV+1
IN=(JK-1)*NG1P1+1
!
DO JL = KIDIA,KFDIA
  ZCNTOP(JL)= PBTOP(JL,1) &
  &   + PBTOP(JL,2) &
  &   + PBTOP(JL,3) &
  &   + PBTOP(JL,4) &
  &   + PBTOP(JL,5) &
  &   + PBTOP(JL,6)
  ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
  ZFDN(JL,JK)=ZFD(JL)
  PFLUC(JL,2,JK)=ZFD(JL)
END DO
!
!*         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
!                  ---------------------------------------
!
!
!*         2.4.1   INITIALIZATION
!                  --------------
!
!
!*         2.5     EXCHANGE WITH LOWER LIMIT
!                  -------------------------
!
DO JL = KIDIA,KFDIA
  ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL)) &
  &               *PFLUC(JL,2,1)-PBINT(JL,1)
END DO
!
JK = 1
IN=(JK-1)*NG1P1+1
!
DO JL = KIDIA,KFDIA
  ZCNSOL(JL)=PBSUR(JL,1) &
  & +PBSUR(JL,2) &
  & +PBSUR(JL,3) &
  & +PBSUR(JL,4) &
  & +PBSUR(JL,5) &
  & +PBSUR(JL,6)
  ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
  ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
  ZFUP(JL,JK)=ZFU(JL)
  PFLUC(JL,1,JK)=ZFU(JL)
END DO
!
DO JK = 2 , KLEV+1
  IN=(JK-1)*NG1P1+1
!
!
  DO JA=1,KUAER
    DO JL=KIDIA,KFDIA
      ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN)
    END DO
  END DO
!
!
  CALL LWTT ( KIDIA,KFDIA,KLON &
     &          , PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT )
!
  DO JL = KIDIA,KFDIA
    ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1)          *ZTT(JL,10) &
    &      +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) &
    &      +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) &
    &      +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) &
    &      +PBSUR(JL,5)*ZTT(JL,3)          *ZTT(JL,14) &
    &      +PBSUR(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
    ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
    ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
    ZFUP(JL,JK)=ZFU(JL)
    PFLUC(JL,1,JK)=ZFU(JL)
  END DO
!
!
END DO
!
!
!
!*         2.7     CLEAR-SKY FLUXES
!                  ----------------
!
DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    PFLUC(JL,1,JK) = ZFUP(JL,JK)
    PFLUC(JL,2,JK) = ZFDN(JL,JK)
  END DO
END DO
!
!     ------------------------------------------------------------------
!
RETURN
END SUBROUTINE OLWVB
