!OPTIONS XOPT(NOEVAL)
SUBROUTINE LWVN15 ( KIDIA,KFDIA,KLON,KLEV,KUAER,KTRAER,&
 & PABCU,PDBSL,PGA,PGB,&
 & PADJD,PADJU,PCNTRB,PDBDT                              )  

!**** *LWVN15*   - L.W., VERTICAL INTEGRATION, NEARBY LAYERS
!****              FROZEN VERSION (CYCLE 15) OF LWVN

!     PURPOSE.
!     --------
!           CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
!           TO GIVE LONGWAVE FLUXES OR RADIANCES

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

!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===
! PABCU : (KLON,NUA15,3*KLEV+1); ABSORBER AMOUNTS
! PDBSL  : (KLON,KLEV*2)     ; SUB-LAYER PLANCK FUNCTION GRADIENT
! PGA, PGB                     ; PADE APPROXIMANTS
!     ==== OUTPUTS ===
! PADJ.. : (KLON,KLEV+1)     ; CONTRIBUTION OF ADJACENT LAYERS
! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
! PDBDT  : (KLON,NUA15,KLEV)   ; LAYER PLANCK FUNCTION GRADIENT

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

!     METHOD.
!     -------

!          1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
!     CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE

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

!          *LWTT15*

!     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 YOMLW15  , ONLY : NINT15   ,NTRA15   ,NUA15    ,NG115    ,NG1P115  ,WG115

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)    :: KUAER 
INTEGER(KIND=JPIM)               :: KTRAER ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(KLON,NUA15,3*KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDBSL(KLON,NINT15,KLEV*2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(KLON,8,2,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(KLON,8,2,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PADJD(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PADJU(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(KLON,KLEV+1,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDBDT(KLON,NINT15,KLEV) 
!-----------------------------------------------------------------------

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

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

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

REAL(KIND=JPRB) :: ZGLAYD(KLON),ZGLAYU(KLON)&
 & ,  ZTT(KLON,NTRA15), ZTT1(KLON,NTRA15), ZTT2(KLON,NTRA15)&
 & ,  ZUU(KLON,NUA15)  

INTEGER(KIND=JPIM) :: IBS, IDD, IM12, IMU, IND, INU, IXD, IXU,&
 & JA, JG, JK, JK1, JK2, JL, JNU  

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

#include "lwtt15.intfb.h"

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

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

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

IF (LHOOK) CALL DR_HOOK('LWVN15',0,ZHOOK_HANDLE)
DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    PADJD(JL,JK) = 0.0_JPRB
    PADJU(JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

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

DO JA = 1 , NTRA15
  DO JL = KIDIA,KFDIA
    ZTT (JL,JA) = 1.0_JPRB
    ZTT1(JL,JA) = 1.0_JPRB
    ZTT2(JL,JA) = 1.0_JPRB
  ENDDO
ENDDO

DO JA = 1 , NUA15
  DO JL = KIDIA,KFDIA
    ZUU(JL,JA) = 0.0_JPRB
  ENDDO
ENDDO

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

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

!*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
!                  ---------------------------------

DO JK = 1 , KLEV

!*         2.1.1   DOWNWARD LAYERS
!                  ---------------

  IM12 = 2 * (JK - 1)
  IND = (JK - 1) * NG1P115 + 1
  IXD = IND
  INU = JK * NG1P115 + 1
  IXU = IND

  DO JL = KIDIA,KFDIA
    ZGLAYD(JL) = 0.0_JPRB
    ZGLAYU(JL) = 0.0_JPRB
  ENDDO

  DO JG = 1 , NG115
    IBS = IM12 + JG
    IDD = IXD + JG
    DO JA = 1 , KUAER
      DO JL = KIDIA,KFDIA
        ZUU(JL,JA) = PABCU(JL,JA,IND) - PABCU(JL,JA,IDD)
      ENDDO
    ENDDO

    CALL LWTT15 ( KIDIA,KFDIA,KLON, PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT )

    DO JL = KIDIA,KFDIA
      ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)&
       & +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)&
       & +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)&
       & +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)&
       & +PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)&
       & +PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15)  
      ZGLAYD(JL)=ZGLAYD(JL)+ZWTR*WG115(JG)
    ENDDO

!*         2.1.2   DOWNWARD LAYERS
!                  ---------------

    IMU = IXU + JG
    DO JA = 1 , KUAER
      DO JL = KIDIA,KFDIA
        ZUU(JL,JA) = PABCU(JL,JA,IMU) - PABCU(JL,JA,INU)
      ENDDO
    ENDDO

    CALL LWTT15 ( KIDIA,KFDIA,KLON, PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT )

    DO JL = KIDIA,KFDIA
      ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)&
       & +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)&
       & +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)&
       & +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)&
       & +PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)&
       & +PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15)  
      ZGLAYU(JL)=ZGLAYU(JL)+ZWTR*WG115(JG)
    ENDDO

  ENDDO

  DO JL = KIDIA,KFDIA
    PADJD(JL,JK) = ZGLAYD(JL)
    PCNTRB(JL,JK,JK+1) = ZGLAYD(JL)
    PADJU(JL,JK+1) = ZGLAYU(JL)
    PCNTRB(JL,JK+1,JK) = ZGLAYU(JL)
    PCNTRB(JL,JK  ,JK) = 0.0_JPRB
  ENDDO

ENDDO

DO JK = 1 , KLEV
  JK2 = 2 * JK
  JK1 = JK2 - 1
  DO JNU = 1 , NINT15
    DO JL = KIDIA,KFDIA
      PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2)
    ENDDO
  ENDDO
ENDDO

IF (LHOOK) CALL DR_HOOK('LWVN15',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 LWVN15
