SUBROUTINE LWBVTL &
 & ( KIDIA, KFDIA, KLON , KLEV  , KMODE,&
 & PDT05 , PEMIS5, PEMIW5,&
 & PTL5  , PTAVE5,&
 & PEMIT5, PFLUC5,&
 & PABCU5, PBINT5, PBSUI5, PCNTRB5, &
 & PDT0  , PEMIS , PEMIW ,&
 & PTL   , PTAVE ,&
 & PEMIT , PFLUC ,&
 & PABCU , PBINT , PBSUI , PCNTRB &
 & )

!**** *LWBVTL*   - COMPUTE PLANCK FUNC., PERF. VERT. INTEGRATION
!                      (tangent linear)

!     PURPOSE.
!     --------
!           TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
!           VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
!           SAVING

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

!        *LWVB* IS CALLED FROM *LW*

!        EXPLICIT ARGUMENTS :
!        --------------------
!  Trajectory  Perturbation  Description                         Dimension
!  PDT05       PDT0          SURFACE TEMPERATURE DISCONTINUITY   (KLON)
!  PEMIS5      PEMIS         SURFACE LW EMISSIVITY               (KLON)
!  PEMIW5      PEMIW         SURFACE LW WINDOW EMISSIVITY        (KLON)
!  PTAVE5      PTAVE         TEMPERATURE                         (KLON,KLEV)
!  PTL5        PTL           HALF LEVEL TEMPERATURE              (KLON,KLEV+1)

!     ==== OUTPUTS ===
!  Trajectory  Perturbation  Description                         Dimension
!  PABCU5      PABCU         ABSORBER AMOUNTS               (KLON,NUA,3*KLEV+1)
!  PBINT5      PBINT         HALF-LEVEL PLANCK FUNCTIONS          (KLON,KLEV+1)
!  PBSUI5      PBSUI                                              (KLON)
!  PCNTRB5     PCNTRB        CLEAR-SKY ENERGY EXCHANGE 
!                            MATRIX                       (KLON,KLEV+1,KLEV+1) 
!  PEMIT5      PEMIT         SURFACE TOTAL LW EMISSIVITY          (KLON)
!  PFLUC5      PFLUC         RADIATIVE FLUXES CLEAR-SKY:          (KLON,2,KLEV)
!                    1  ==>  UPWARD   FLUX TOTAL

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

!     METHOD.
!     -------

!          1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
!     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
!          2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
!     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
!     BOUNDARIES.
!          3. COMPUTES THE CLEAR-SKY COOLING RATES.

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

!          *LWBTL*, *LWVTL*

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

!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHOR.
!     -------
!        M. Janiskova  *ECMWF*       27-Jan-2006

!     MODIFICATIONS.
!     --------------

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

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

USE YOELW    , ONLY : NSIL     ,NIPD     ,NUA
USE YOERDU   , ONLY : NUAER    ,NTRAER
USE YOPHNC   , ONLY : LH2OCO2

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),INTENT(IN)    :: KMODE 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDT05(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTL5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC5(KLON,2,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU5(KLON,NUA,3*KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBINT5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBSUI5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB5(KLON,KLEV+1,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDT0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTL(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(KLON,NUA,3*KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBINT(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBSUI(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(KLON,KLEV+1,KLEV+1)

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

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

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

!              ------------
REAL(KIND=JPRB) :: ZB(KLON,NSIL,KLEV+1), ZBSUR(KLON,NSIL), ZBTOP(KLON,NSIL)
REAL(KIND=JPRB) :: ZDBSL(KLON,NSIL,KLEV*2)
REAL(KIND=JPRB) :: ZGA(KLON,NIPD,2,KLEV)  , ZGB(KLON,NIPD,2,KLEV)
REAL(KIND=JPRB) :: ZGASUR(KLON,NIPD,2)    , ZGBSUR(KLON,NIPD,2)
REAL(KIND=JPRB) :: ZGATOP(KLON,NIPD,2)    , ZGBTOP(KLON,NIPD,2)
REAL(KIND=JPRB) :: ZB5(KLON,NSIL,KLEV+1), ZBSUR5(KLON,NSIL), ZBTOP5(KLON,NSIL)
REAL(KIND=JPRB) :: ZDBSL5(KLON,NSIL,KLEV*2)

REAL(KIND=JPRB) :: ZDIV5

INTEGER(KIND=JPIM) :: JL, JLW
INTEGER(KIND=JPIM) :: IUAER, ITRAER
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "lwbtl.intfb.h"
#include "lwvtl.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('LWBVTL',0,ZHOOK_HANDLE)

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

IF (LH2OCO2) THEN
  IUAER  = 9
  ITRAER = 9
ELSE
  IUAER  = NUAER
  ITRAER = NTRAER
ENDIF

!*         2.    COMPUTES PLANCK FUNCTIONS
!                -------------------------

CALL LWBTL &
 & ( KIDIA, KFDIA, KLON  , KLEV  , KMODE,&
 & ZGA   , ZGB   , ZGASUR, ZGBSUR, ZGATOP, ZGBTOP,& 
 & PDT05 , PTAVE5, PTL5   ,&
 & ZB5   , PBINT5, ZBSUR5 , ZBTOP5 , ZDBSL5,&
 & PDT0  , PTAVE , PTL    ,&
 & ZB    , PBINT , ZBSUR  , ZBTOP  , ZDBSL &
 & )

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

!*         3.    PERFORMS THE VERTICAL INTEGRATION
!                ---------------------------------

CALL LWVTL &
 & ( KIDIA , KFDIA, KLON  , KLEV,&
! & NUAER , NTRAER,&
 & IUAER , ITRAER,&
 & ZGA    , ZGB   , ZGASUR , ZGBSUR , ZGATOP , ZGBTOP,&
 & PABCU5 , ZB5   , PBINT5 , ZBSUR5 , ZBTOP5 , ZDBSL5,&
 & PEMIS5 , PEMIW5,&
 & PCNTRB5, PFLUC5,&
 & PABCU  , ZB    , PBINT  , ZBSUR  , ZBTOP  , ZDBSL ,&
 & PEMIS  , PEMIW ,&
 & PCNTRB , PFLUC &
 & )

DO JL=KIDIA,KFDIA
  PEMIT (JL) = 0.0_JPRB
  PEMIT5(JL) = 0.0_JPRB
  PBSUI (JL) = 0.0_JPRB
  PBSUI5(JL) = 0.0_JPRB
ENDDO
DO JLW=1,NSIL
  DO JL=KIDIA,KFDIA
    PBSUI (JL) = PBSUI (JL)+ZBSUR (JL,JLW)
    PBSUI5(JL) = PBSUI5(JL)+ZBSUR5(JL,JLW)
    IF (JLW >= 3.AND. JLW <= 4) THEN
      PEMIT (JL) = PEMIT (JL)+ZBSUR5(JL,JLW)*PEMIW(JL) &
       &         + PEMIW5(JL)*ZBSUR(JL,JLW)
      PEMIT5(JL) = PEMIT5(JL)+ZBSUR5(JL,JLW)*PEMIW5(JL)
    ELSE
      PEMIT (JL) = PEMIT (JL)+ZBSUR5(JL,JLW)*PEMIS(JL) &
       &         + PEMIS5(JL)*ZBSUR(JL,JLW)
      PEMIT5(JL) = PEMIT5(JL)+ZBSUR5(JL,JLW)*PEMIS5(JL)
    ENDIF
  ENDDO
ENDDO
DO JL=KIDIA,KFDIA
  ZDIV5 = 1.0_JPRB/PBSUI5(JL)
  PEMIT (JL) = PEMIT(JL)*ZDIV5-PEMIT5(JL)*ZDIV5*ZDIV5*PBSUI(JL)
  PEMIT5(JL) = PEMIT5(JL)*ZDIV5
ENDDO

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

IF (LHOOK) CALL DR_HOOK('LWBVTL',1,ZHOOK_HANDLE)
END SUBROUTINE LWBVTL
