SUBROUTINE LWVDTL &
 & ( KIDIA, KFDIA, KLON , KLEV  , KTRAER,&
 & PGA    , PGB    ,&
 & PABCU5 , PDBDT5 ,&
 & PCNTRB5, PDISD5 , PDISU5, PDWFSU5, &
 & PABCU  , PDBDT  ,&
 & PCNTRB , PDISD  , PDISU , PDWFSU &
 & )

!**** *LWVDTL*   - L.W., VERTICAL INTEGRATION, DISTANT LAYERS
!                      (tangent linear)

!     PURPOSE.
!     --------
!           CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS

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

!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===
!  Trajectory  Perturbation  Description                    Dimension
!  PABCU5      PABCU         ABSORBER AMOUNTS               (KLON,NUA,3*KLEV+1)
!  PDBDT5      PDBDT         LAYER PLANCK FUNCTION GRADIENT (KLON,KLEV)
!  PGA         ---           PADE APPROXIMANTS              (KLON,NIPD,2)
!  PGB         ---           PADE APPROXIMANTS              (KLON,NIPD,2)

!     ==== OUTPUTS ===
!  Trajectory  Perturbation  Description                       Dimension
!  PCNTRB5     PCNTRB        ENERGY EXCHANGE MATRIX        (KLON,KLEV+1,KLEV+1)
!  PDISD5      PDISD         CONTRIBUTION BY DISTANT LAYERS    (KLON,KLEV+1)
!  PDISU5      PDISU         CONTRIBUTION BY DISTANT LAYERS    (KLON,KLEV+1)
!  PDWFSU5     PDWFSU        SPECTRAL DOWNWARD FLUX AT SURFACE (KLON,NSIL)

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

!     METHOD.
!     -------

!          1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
!     CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE

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

!          *LWTTMTL*

!     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     ,NTRA     ,NUA      ,NG1P1

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)    :: KTRAER 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(KLON,NIPD,2,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(KLON,NIPD,2,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU5(KLON,NUA,3*KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDBDT5(KLON,NSIL,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB5(KLON,KLEV+1,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDISD5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDISU5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDWFSU5(KLON,NSIL) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(KLON,NUA,3*KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDBDT(KLON,NSIL,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(KLON,KLEV+1,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDISD(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDISU(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDWFSU(KLON,NSIL)

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

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

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

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

REAL(KIND=JPRB) :: ZTT(KLON,NTRA), ZTTP(KLON,NTRA,KLEV+1)
REAL(KIND=JPRB) :: ZTT5(KLON,NTRA), ZTTP5(KLON,NTRA,KLEV+1)

REAL(KIND=JPRB) :: ZWW1, ZWW2, ZWW3, ZWW4, ZWW5, ZWW6
REAL(KIND=JPRB) :: ZWW15, ZWW25, ZWW35, ZWW45, ZWW55, ZWW65

INTEGER(KIND=JPIM) :: IJKL, IKD1, IKD2, IKJ, IKJP1, IKM1, IKN,&
 & IKP1, IKU1, IKU2, JA, JK, JKJ, JL, JLK 

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "lwttmtl.intfb.h"

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

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

!*         1.1     INITIALIZE LAYER CONTRIBUTIONS
!                  ------------------------------

IF (LHOOK) CALL DR_HOOK('LWVDTL',0,ZHOOK_HANDLE)
DO JK = 1, KLEV+1
  DO JL = KIDIA,KFDIA
    PDISD (JL,JK) = 0.0_JPRB
    PDISD5(JL,JK) = 0.0_JPRB
    PDISU (JL,JK) = 0.0_JPRB
    PDISU5(JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

!*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
!                  ---------------------------------

DO JA = 1, NTRA
  DO JL = KIDIA,KFDIA
    ZTT (JL,JA) = 0.0_JPRB
    ZTT5(JL,JA) = 1.0_JPRB
    ZTTP (JL,JA,:) = 0.0_JPRB
    ZTTP5(JL,JA,:) = 1.0_JPRB
  ENDDO
ENDDO

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

!*         2.      VERTICAL INTEGRATION
!                  --------------------

!*         2.2     CONTRIBUTION FROM DISTANT LAYERS
!                  ---------------------------------

!*         2.2.1   DISTANT AND ABOVE LAYERS
!                  ------------------------

!*         2.2.2   FIRST UPPER LEVEL
!                  -----------------

DO JK = 1 , KLEV-1
  IKP1=JK+1
  IKN=(JK-1)*NG1P1+1
  IKD1= JK  *NG1P1+1

  CALL LWTTMTL &
   & ( KIDIA        , KFDIA        , KLON,&
   & PGA(1,1,1,JK)  , PGB(1,1,1,JK),&
   & PABCU5(1,1,IKN), PABCU5(1,1,IKD1), ZTTP5(1,1,JK),&
   & PABCU (1,1,IKN), PABCU (1,1,IKD1), ZTTP (1,1,JK) )  

!*         2.2.3   HIGHER UP
!                  ---------

  DO JKJ=IKP1,KLEV
    IKJP1=JKJ+1
    IKD2= JKJ  *NG1P1+1

    CALL LWTTMTL &
     & ( KIDIA        , KFDIA         , KLON,&
     & PGA(1,1,1,JKJ) , PGB(1,1,1,JKJ),&
     & PABCU5(1,1,IKN), PABCU5(1,1,IKD2), ZTTP5(1,1,JKJ),&
     & PABCU (1,1,IKN), PABCU (1,1,IKD2), ZTTP (1,1,JKJ) )  

    DO JA = 1, KTRAER
      DO JL = KIDIA,KFDIA
        ZTT (JL,JA) = (ZTTP (JL,JA,JKJ-1)+ZTTP (JL,JA,JKJ))*0.5_JPRB
        ZTT5(JL,JA) = (ZTTP5(JL,JA,JKJ-1)+ZTTP5(JL,JA,JKJ))*0.5_JPRB
      ENDDO
    ENDDO

    DO JL = KIDIA,KFDIA
      ZWW1  = PDBDT5(JL,1,JKJ)*ZTT5(JL,1)*ZTT(JL,10) &
       &    + PDBDT5(JL,1,JKJ)*ZTT5(JL,10)*ZTT(JL,1) &
       &    + ZTT5(JL,1)*ZTT5(JL,10)*PDBDT(JL,1,JKJ)
      ZWW15 = PDBDT5(JL,1,JKJ)*ZTT5(JL,1)*ZTT5(JL,10)
      ZWW2  = PDBDT5(JL,2,JKJ)*ZTT5(JL,2)*ZTT5(JL,7)*ZTT(JL,11) &
       &    + PDBDT5(JL,2,JKJ)*ZTT5(JL,2)*ZTT5(JL,11)*ZTT(JL,7) &
       &    + PDBDT5(JL,2,JKJ)*ZTT5(JL,7)*ZTT5(JL,11)*ZTT(JL,2) &
       &    + ZTT5(JL,2)*ZTT5(JL,7)*ZTT5(JL,11)*PDBDT(JL,2,JKJ)
      ZWW25 = PDBDT5(JL,2,JKJ)*ZTT5(JL,2)*ZTT5(JL,7)*ZTT5(JL,11)
      ZWW3  = PDBDT5(JL,3,JKJ)*ZTT5(JL,4)*ZTT5(JL,8)*ZTT(JL,12) &
       &    + PDBDT5(JL,3,JKJ)*ZTT5(JL,4)*ZTT5(JL,12)*ZTT(JL,8) &
       &    + PDBDT5(JL,3,JKJ)*ZTT5(JL,8)*ZTT5(JL,12)*ZTT(JL,4) &
       &    + ZTT5(JL,4)*ZTT5(JL,8)*ZTT5(JL,12)*PDBDT(JL,3,JKJ)
      ZWW35 = PDBDT5(JL,3,JKJ)*ZTT5(JL,4)*ZTT5(JL,8)*ZTT5(JL,12)
      ZWW4  = PDBDT5(JL,4,JKJ)*ZTT5(JL,5)*ZTT5(JL,9)*ZTT(JL,13) &
       &    + PDBDT5(JL,4,JKJ)*ZTT5(JL,5)*ZTT5(JL,13)*ZTT(JL,9) &
       &    + PDBDT5(JL,4,JKJ)*ZTT5(JL,9)*ZTT5(JL,13)*ZTT(JL,5) &
       &    + ZTT5(JL,5)*ZTT5(JL,9)*ZTT5(JL,13)*PDBDT(JL,4,JKJ)
      ZWW45 = PDBDT5(JL,4,JKJ)*ZTT5(JL,5)*ZTT5(JL,9)*ZTT5(JL,13)
      ZWW5  = PDBDT5(JL,5,JKJ)*ZTT5(JL,3)*ZTT(JL,14) &
       &    + PDBDT5(JL,5,JKJ)*ZTT5(JL,14)*ZTT(JL,3) &
       &    + ZTT5(JL,3)*ZTT5(JL,14)*PDBDT(JL,5,JKJ)
      ZWW55 = PDBDT5(JL,5,JKJ)*ZTT5(JL,3)*ZTT5(JL,14)
      ZWW6  = PDBDT5(JL,6,JKJ)*ZTT5(JL,6)*ZTT(JL,15) &
       &    + PDBDT5(JL,6,JKJ)*ZTT5(JL,15)*ZTT(JL,6) &
       &    + ZTT5(JL,6)*ZTT5(JL,15)*PDBDT(JL,6,JKJ)
      ZWW65 = PDBDT5(JL,6,JKJ)*ZTT5(JL,6)*ZTT5(JL,15)
      PCNTRB (JL,JK,IKJP1) = ZWW1+ZWW2+ZWW3+ZWW4+ZWW5+ZWW6
      PCNTRB5(JL,JK,IKJP1) = ZWW15+ZWW25+ZWW35+ZWW45+ZWW55+ZWW65
      PDISD (JL,JK) = PDISD (JL,JK)+PCNTRB (JL,JK,IKJP1)
      PDISD5(JL,JK) = PDISD5(JL,JK)+PCNTRB5(JL,JK,IKJP1)
      IF (JK == 1) THEN
        PDWFSU (JL,1) = PDWFSU (JL,1)+ZWW1
        PDWFSU5(JL,1) = PDWFSU5(JL,1)+ZWW15
        PDWFSU (JL,2) = PDWFSU (JL,2)+ZWW2
        PDWFSU5(JL,2) = PDWFSU5(JL,2)+ZWW25
        PDWFSU (JL,3) = PDWFSU (JL,3)+ZWW3
        PDWFSU5(JL,3) = PDWFSU5(JL,3)+ZWW35
        PDWFSU (JL,4) = PDWFSU (JL,4)+ZWW4
        PDWFSU5(JL,4) = PDWFSU5(JL,4)+ZWW45
        PDWFSU (JL,5) = PDWFSU (JL,5)+ZWW5
        PDWFSU5(JL,5) = PDWFSU5(JL,5)+ZWW55
        PDWFSU (JL,6) = PDWFSU (JL,6)+ZWW6
        PDWFSU5(JL,6) = PDWFSU5(JL,6)+ZWW65
      ENDIF
    ENDDO

  ENDDO
ENDDO

!*         2.2.4   DISTANT AND BELOW LAYERS
!                  ------------------------

!*         2.2.5   FIRST LOWER LEVEL
!                  -----------------

DO JK=3,KLEV+1
  IKN=(JK-1)*NG1P1+1
  IKM1=JK-1
  IKJ=JK-2
  IKU1= IKJ  *NG1P1+1

  CALL LWTTMTL &
   & ( KIDIA          , KFDIA         , KLON,&
   & PGA(1,1,1,IKJ) , PGB(1,1,1,IKJ),&
   & PABCU5(1,1,IKU1), PABCU5(1,1,IKN), ZTTP5(1,1,1),&
   & PABCU (1,1,IKU1), PABCU (1,1,IKN), ZTTP (1,1,1) )  

!*         2.2.6   DOWN BELOW
!                  ----------

  DO JLK=1,IKJ
    IJKL=IKM1-JLK
    IKU2=(IJKL-1)*NG1P1+1

    CALL LWTTMTL &
     & ( KIDIA          , KFDIA          , KLON,&
     & PGA(1,1,1,IJKL), PGB(1,1,1,IJKL),&
     & PABCU5(1,1,IKU2), PABCU5(1,1,IKN) , ZTTP5(1,1,JLK+1),&
     & PABCU (1,1,IKU2), PABCU (1,1,IKN) , ZTTP (1,1,JLK+1) )  

    DO JA = 1, KTRAER
      DO JL = KIDIA,KFDIA
        ZTT (JL,JA) = (ZTTP (JL,JA,JLK)+ZTTP (JL,JA,JLK+1))*0.5_JPRB
        ZTT5(JL,JA) = (ZTTP5(JL,JA,JLK)+ZTTP5(JL,JA,JLK+1))*0.5_JPRB
      ENDDO
    ENDDO

    DO JL = KIDIA,KFDIA
      PCNTRB (JL,JK,IJKL) = PDBDT5(JL,1,IJKL)*ZTT5(JL,1)*ZTT(JL,10) &
       & + PDBDT5(JL,1,IJKL)*ZTT5(JL,10)*ZTT(JL,1) &
       & + ZTT5(JL,1)*ZTT5(JL,10)*PDBDT(JL,1,IJKL) &
       & + PDBDT5(JL,2,IJKL)*ZTT5(JL,2)*ZTT5(JL,7)*ZTT(JL,11) &
       & + PDBDT5(JL,2,IJKL)*ZTT5(JL,2)*ZTT5(JL,11)*ZTT(JL,7) &
       & + PDBDT5(JL,2,IJKL)*ZTT5(JL,7)*ZTT5(JL,11)*ZTT(JL,2) &
       & + ZTT5(JL,2)*ZTT5(JL,7)*ZTT5(JL,11)*PDBDT(JL,2,IJKL) &
       & + PDBDT5(JL,3,IJKL)*ZTT5(JL,4)*ZTT5(JL,8)*ZTT(JL,12) &
       & + PDBDT5(JL,3,IJKL)*ZTT5(JL,4)*ZTT5(JL,12)*ZTT(JL,8) &
       & + PDBDT5(JL,3,IJKL)*ZTT5(JL,8)*ZTT5(JL,12)*ZTT(JL,4) &
       & + ZTT5(JL,4)*ZTT5(JL,8)*ZTT5(JL,12)*PDBDT(JL,3,IJKL) &
       & + PDBDT5(JL,4,IJKL)*ZTT5(JL,5)*ZTT5(JL,9)*ZTT(JL,13) &
       & + PDBDT5(JL,4,IJKL)*ZTT5(JL,5)*ZTT5(JL,13)*ZTT(JL,9) &
       & + PDBDT5(JL,4,IJKL)*ZTT5(JL,9)*ZTT5(JL,13)*ZTT(JL,5) &
       & + ZTT5(JL,5)*ZTT5(JL,9)*ZTT5(JL,13)*PDBDT(JL,4,IJKL) &
       & + PDBDT5(JL,5,IJKL)*ZTT5(JL,3)*ZTT(JL,14) &
       & + PDBDT5(JL,5,IJKL)*ZTT5(JL,14)*ZTT(JL,3) &
       & + ZTT5(JL,3)*ZTT5(JL,14)*PDBDT(JL,5,IJKL) &
       & + PDBDT5(JL,6,IJKL)*ZTT5(JL,6)*ZTT(JL,15) &
       & + PDBDT5(JL,6,IJKL)*ZTT5(JL,15)*ZTT(JL,6) &
       & + ZTT5(JL,6)*ZTT5(JL,15)*PDBDT(JL,6,IJKL)
      PCNTRB5(JL,JK,IJKL) = PDBDT5(JL,1,IJKL)*ZTT5(JL,1)*ZTT5(JL,10)&
       & +PDBDT5(JL,2,IJKL)*ZTT5(JL,2)*ZTT5(JL,7)*ZTT5(JL,11)&
       & +PDBDT5(JL,3,IJKL)*ZTT5(JL,4)*ZTT5(JL,8)*ZTT5(JL,12)&
       & +PDBDT5(JL,4,IJKL)*ZTT5(JL,5)*ZTT5(JL,9)*ZTT5(JL,13)&
       & +PDBDT5(JL,5,IJKL)*ZTT5(JL,3)*ZTT5(JL,14)&
       & +PDBDT5(JL,6,IJKL)*ZTT5(JL,6)*ZTT5(JL,15)
      PDISU (JL,JK) = PDISU (JL,JK)+PCNTRB (JL,JK,IJKL)
      PDISU5(JL,JK) = PDISU5(JL,JK)+PCNTRB5(JL,JK,IJKL)
    ENDDO

  ENDDO
ENDDO

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

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