#ifdef RS6K
@PROCESS HOT
#endif
SUBROUTINE LWPAD &
 & ( KIDIA , KFDIA  , KLON  , KLEV ,&
 !- trajectory inputs
 & PCCO25, PCLDLD5, PCLDLU5, PCLFR5,&
 & PDP5  , PDT05,&
 & PPMB5 , POZON5 , PTL5,&
 & PTAVE5 , PQ5,&
 !- trajectory outputs
 & PEMIT5 , PFLUX5, PFLUC5,&
 !- perturbation inputs
 & PCLDLD , PCLDLU , PCLFR,&
 & PDT0   , PPMB  , PTL,&
 & PTAVE  , PQ,&
 !- perturbation outputs
 & PEMIT  , PFLUX , PFLUC &
 & )  

!**** *LWPAD*   - ORGANIZES THE LONGWAVE CALCULATIONS
!                -> ADJOINT <-

!     PURPOSE.
!     --------
!           COMPUTES LONGWAVE FLUXES

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

!        *LWPAD* IS CALLED FROM *RADLSWAD*

!        EXPLICIT ARGUMENTS :
!        --------------------
! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
! PCCO2  :                   ; CONCENTRATION IN CO2 (PA/PA)
! PCLDLD : (KLON,KLEV)       ; DOWNWARD EFFECTIVE CLOUD FRACTION
! PCLDLU : (KLON,KLEV)       ; UPWARD EFFECTIVE CLOUD FRACTION
! PCLFR  : (KLON,KLEV)       ; CLOUD FRACTIONAL COVER
! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS
! PDT0   : (KLON)            ; SURFACE TEMPERATURE DISCONTINUITY
! PPMB   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
! POZON  : (KLON,KLEV)       ; CONCENTRATION IN OZONE (PA/PA)
! PTAVE  : (KLON,KLEV)       ; TEMPERATURE
! PTL    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
! PVIEW  : (KLON)            ; COSECANT OF VIEWING ANGLE
! PQ     : (KLON,KLEV)       ; SPECIFIC HUMIDITY  (PA/PA)
!     ==== OUTPUTS ===
! PEMIT(KLON)                ; SURFACE TOTAL LW EMISSIVITY
! PFLUX(KLON,2,KLEV)         ; RADIATIVE FLUXES :
!                     1  ==>  UPWARD   FLUX TOTAL
!                     2  ==>  DOWNWARD FLUX TOTAL
! PFLUC(KLON,2,KLEV)         ; RADIATIVE FLUXES CLEAR SKY:
!                     1  ==>  UPWARD   FLUX TOTAL
!                     2  ==>  DOWNWARD FLUX TOTAL

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

!     METHOD.
!     -------

!          1. COMPUTES THE INITIAL TRAJECTORY USING NEUROFLUX
!          2. COMPUTES THE INCREMENTS WITH TANGENT LINEAR APPROXIMATION
!               (For temp and water vapour, uses a mean archived jacobian)

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

!          *LWAI*, *LWAIAD*, *LWNEUR*

!     AUTHOR.
!     -------
!        M. Janiskova

!     MODIFICATIONS.
!     --------------
!        ORIGINAL     : 2000-01
!        OPTIMISATION : 2003-04 (LERADFL2=F) John Hague and Deborah Salmond
!                     : 2003-05 (LERADFL2=T) M. Janiskova
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

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

USE YOENEUR  , ONLY : PDFSDX
USE YOPHNC   , ONLY : LERADFL2

IMPLICIT NONE

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

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

!- Inputs Trajectory
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO25 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDLD5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDLU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDT05(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPMB5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POZON5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTL5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT5(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFLUX5(KLON,2,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC5(KLON,2,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLDLD(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLDLU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLFR(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDT0(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPMB(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTL(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTAVE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFLUX(KLON,2,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFLUC(KLON,2,KLEV+1) 
REAL(KIND=JPRB) :: Z_PGEMU(KLON),Z_PCLON(KLON),Z_PSLON(KLON)

!- Outputs Trajectory

!- Inputs Perturbations
!- Outputs Perturbations

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

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

INTEGER(KIND=JPIM) :: JL,IPERT,JK1,JK,IKL
REAL(KIND=JPRB) :: ZDX(KLON,2*KLEV+2)
REAL(KIND=JPRB) :: ZAI5(KLON,KLEV+1,KLEV+1,1)      , ZAI(KLON,KLEV+1,KLEV+1,1) 
REAL(KIND=JPRB) :: ZAIC5(KLON,KLEV+1)              , ZAIC(KLON,KLEV+1)
REAL(KIND=JPRB) :: ZUPF5(KLON,KLEV+1,KLEV+1)       
REAL(KIND=JPRB) :: ZDNF5(KLON,KLEV+1,KLEV+1)       
REAL(KIND=JPRB) :: ZEMIW5(KLON)
REAL(KIND=JPRB) :: ZTEMP1(KLON), ZTEMP2(KLON), ZTEMP3(KLON), ZTEMP4(KLON)
REAL(KIND=JPRB) :: Z_DF

LOGICAL :: LLLEFT,LLRIGHT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "lwai.intfb.h"
#include "lwaiad.intfb.h"
#include "lwneur.intfb.h"

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

!          1.   INITIAL TRAJECTORY

IF (LHOOK) CALL DR_HOOK('LWPAD',0,ZHOOK_HANDLE)
IF (LERADFL2) THEN
  LLLEFT  = .TRUE.
  LLRIGHT = .TRUE.
ELSE
  LLLEFT  = .FALSE.
  LLRIGHT = .TRUE.
ENDIF

! WARNING : dummy aerosols & surface emissivity variables
! to put correct aerosols, latitude and longitude should
! be passed as arguments

Z_PGEMU = 0.0_JPRB
Z_PCLON = 1.0_JPRB
Z_PSLON = 0.0_JPRB

! to put correct emissivity, the treatment of the surface upward
! flux should be adapted (would not fit the "ai.Fi" only approach)

ZEMIW5 = 0.99_JPRB

IF (LERADFL2) THEN
  ZUPF5 = 0.0_JPRB
  ZDNF5 = 0.0_JPRB
  CALL LWNEUR &
   & ( KIDIA , KFDIA , KLON  , KLEV ,&
   & PCCO25, PCLDLU5, PCLDLU,&
   & PDP5  , PDT05  , ZEMIW5,&
   & PPMB5 , POZON5 , PTL5,&
   & PTAVE5 , PQ5,&
   & Z_PGEMU , Z_PCLON  , Z_PSLON,&
   & ZUPF5 , ZDNF5 &
   & )  

  CALL LWAI( KIDIA , KFDIA, KLON  , KLEV,&
   & PCLDLD5, PCLDLU5, PCLFR5, ZAI5, ZAIC5)  

  DO JK = 1,KLEV+1
!upward cloudy sky
    DO JK1 = 1,JK 
      DO JL = KIDIA,KFDIA
        PFLUX5(JL,1,JK) = &
         & PFLUX5(JL,1,JK) + ZAI5(JL,JK1,JK,1) * ZUPF5(JL,JK1,JK)  
      ENDDO
    ENDDO
!downward clear contribution
    DO JL = KIDIA,KFDIA   
      PFLUX5(JL,2,JK) = ZAIC5(JL,JK) * ZDNF5(JL,1,JK)
    ENDDO
!downward cloudy contribution
    DO JK1 = JK+1,KLEV+1   
      DO JL = KIDIA,KFDIA
        PFLUX5(JL,2,JK) =&
         & PFLUX5(JL,2,JK) + ZAI5(JL,JK1,JK,1) * ZDNF5(JL,JK1,JK)  
      ENDDO
    ENDDO
  ENDDO

!clear sky
  DO JK = 1,KLEV+1   
    DO JL = KIDIA,KFDIA
      PFLUC5(JL,1,JK) = ZUPF5(JL,1,JK)
      PFLUC5(JL,2,JK) = ZDNF5(JL,1,JK)
    ENDDO
  ENDDO
ELSE
  CALL LWAI( KIDIA , KFDIA, KLON  , KLEV,&
   & PCLDLD5, PCLDLU5, PCLFR5, ZAI5, ZAIC5)  
ENDIF  

PEMIT5 = 1.0_JPRB

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

!                 ----- ADJOINT COMPUTATION ------

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

!*                        INITIALIZATIONS
!                         ---------------

ZDX(:,:) = 0.0_JPRB
IF(LERADFL2) THEN
  ZAI(:,:,:,:) = 0.0_JPRB 
  ZAIC(:,:) = 0.0_JPRB
ENDIF

!*                        BACKWARD COMPUTATION
!                         --------------------

PEMIT(:) = 0.0_JPRB

!          1.1   RIGHT MEMBER   ( ai * dFi )

IF (LLRIGHT) THEN

!loop on perturbations
!loop on levels
  DO JK = KLEV+1,1,-1    
!clear sky
    DO IPERT = 2*KLEV+2, 1, -1  
      DO JL = KIDIA,KFDIA 
        ZDX(JL,IPERT) = ZDX(JL,IPERT) &
         & + PDFSDX(IPERT,1,JK,2) * PFLUC(JL,2,JK)  
        ZDX(JL,IPERT) = ZDX(JL,IPERT) &
         & + PDFSDX(IPERT,1,JK,1) * PFLUC(JL,1,JK)  
      ENDDO
    ENDDO
!downward cloudy contribution      
! OPTIMISATION : UNROLLED BY 4
!   DO JK1 = KLEV+1,JK+1,-1
!     DO JL = KIDIA,KFDIA
!       ZTEMP1(JL) =  ZAI5(JL,JK1,JK,1) * PFLUX(JL,2,JK)
!     ENDDO
!     DO IPERT = 2*KLEV+2, 1, -1
!       DO JL = KIDIA,KFDIA
!         ZDX(JL,IPERT) = ZDX(JL,IPERT) + PDFSDX(IPERT,2,JK1,JK) * ZTEMP1(JL)
!       ENDDO
!     ENDDO
!   ENDDO
    DO JK1 = KLEV+1,JK+1+3,-4
      DO JL = KIDIA,KFDIA
        ZTEMP1(JL) = ZAI5(JL,JK1  ,JK,1) * PFLUX(JL,2,JK)
        ZTEMP2(JL) = ZAI5(JL,JK1-1,JK,1) * PFLUX(JL,2,JK)
        ZTEMP3(JL) = ZAI5(JL,JK1-2,JK,1) * PFLUX(JL,2,JK)
        ZTEMP4(JL) = ZAI5(JL,JK1-3,JK,1) * PFLUX(JL,2,JK)
      ENDDO
      DO IPERT = 2*KLEV+2, 1, -1  
        Z_DF=ABS(PDFSDX(IPERT  ,JK1,JK,2))  &
         & +ABS(PDFSDX(IPERT,JK1-1,JK,2)) &
         & +ABS(PDFSDX(IPERT,JK1-2,JK,2)) &
         & +ABS(PDFSDX(IPERT,JK1-3,JK,2))  
        IF(Z_DF /= 0.0_JPRB)THEN
          DO JL = KIDIA,KFDIA
            ZDX(JL,IPERT) = ZDX(JL,IPERT) + PDFSDX(IPERT,JK1  ,JK,2)*ZTEMP1(JL)&
             & + PDFSDX(IPERT,JK1-1,JK,2)*ZTEMP2(JL)&
             & + PDFSDX(IPERT,JK1-2,JK,2)*ZTEMP3(JL)&
             & + PDFSDX(IPERT,JK1-3,JK,2)*ZTEMP4(JL)  
          ENDDO
        ENDIF
      ENDDO
    ENDDO
    DO JK1=JK+MOD(KLEV-JK+1,4),JK+1,-1
      DO JL = KIDIA,KFDIA
        ZTEMP1(JL) =  ZAI5(JL,JK1,JK,1) * PFLUX(JL,2,JK)
      ENDDO
      DO IPERT = 2*KLEV+2, 1, -1  
        DO JL = KIDIA,KFDIA
          ZDX(JL,IPERT) = ZDX(JL,IPERT) + PDFSDX(IPERT,JK1,JK,2) * ZTEMP1(JL)
        ENDDO
      ENDDO
    ENDDO
!downward clear      
    DO JL = KIDIA,KFDIA
!     ZTEMP1(JL) =  ZAI5(JL,1,JK,1) * PFLUX(JL,2,JK)
      ZTEMP1(JL) =  ZAIC5(JL,JK) * PFLUX(JL,2,JK)
    ENDDO
    DO IPERT = 2*KLEV+2, 1, -1  
      DO JL = KIDIA,KFDIA  
        ZDX(JL,IPERT) = ZDX(JL,IPERT) + PDFSDX(IPERT,1,JK,2) * ZTEMP1(JL)
      ENDDO
    ENDDO
!upward cloudy sky      
! OPTIMISATION : UNROLLED BY 4
!   DO JK1 = JK,1,-1
!     DO JL = KIDIA,KFDIA
!       ZTEMP1(JL) =  ZAI5(JL,JK1,JK,1) * PFLUX(JL,1,JK)
!     ENDDO
!     DO IPERT = 2*KLEV+2, 1, -1
!       DO JL = KIDIA,KFDIA
!         ZDX(JL,IPERT) = ZDX(JL,IPERT) + PDFSDX(IPERT,1,JK1,JK) * ZTEMP1(JL)
!       ENDDO
!     ENDDO
!   ENDDO
    DO JK1 = JK,1+3,-4
      DO JL = KIDIA,KFDIA
        ZTEMP1(JL) =  ZAI5(JL,JK1  ,JK,1) * PFLUX(JL,1,JK)
        ZTEMP2(JL) =  ZAI5(JL,JK1-1,JK,1) * PFLUX(JL,1,JK)
        ZTEMP3(JL) =  ZAI5(JL,JK1-2,JK,1) * PFLUX(JL,1,JK)
        ZTEMP4(JL) =  ZAI5(JL,JK1-3,JK,1) * PFLUX(JL,1,JK)
      ENDDO
      DO IPERT = 2*KLEV+2, 1, -1  
        Z_DF=ABS(PDFSDX(IPERT  ,JK1,JK,1))  &
         & +ABS(PDFSDX(IPERT,JK1-1,JK,1)) &
         & +ABS(PDFSDX(IPERT,JK1-2,JK,1)) &
         & +ABS(PDFSDX(IPERT,JK1-3,JK,1))  
        IF(Z_DF /= 0.0_JPRB)THEN
          DO JL = KIDIA,KFDIA
            ZDX(JL,IPERT) = ZDX(JL,IPERT) + PDFSDX(IPERT,JK1  ,JK,1)*ZTEMP1(JL)&
             & + PDFSDX(IPERT,JK1-1,JK,1)*ZTEMP2(JL)&
             & + PDFSDX(IPERT,JK1-2,JK,1)*ZTEMP3(JL)&
             & + PDFSDX(IPERT,JK1-3,JK,1)*ZTEMP4(JL)  
          ENDDO
        ENDIF
      ENDDO
    ENDDO
    DO JK1=MOD(JK,4),1,-1
      DO JL = KIDIA,KFDIA
        ZTEMP1(JL) =  ZAI5(JL,JK1,JK,1) * PFLUX(JL,1,JK)
      ENDDO
      DO IPERT = 2*KLEV+2, 1, -1  
        DO JL = KIDIA,KFDIA
          ZDX(JL,IPERT) = ZDX(JL,IPERT) + PDFSDX(IPERT,JK1,JK,1) * ZTEMP1(JL)
        ENDDO
      ENDDO
    ENDDO

  ENDDO
  
  PTL(KIDIA:KFDIA,1) = PTL(KIDIA:KFDIA,1) + ZDX(KIDIA:KFDIA,2*KLEV+2)
  PDT0(KIDIA:KFDIA) = PDT0(KIDIA:KFDIA) + ZDX(KIDIA:KFDIA,2*KLEV+2)
  ZDX(KIDIA:KFDIA,2*KLEV+2) = 0.0_JPRB
  
  PPMB(KIDIA:KFDIA,1) = PPMB(KIDIA:KFDIA,1) &
   & + 100._JPRB*ZDX(KIDIA:KFDIA,2*KLEV+1)  
  ZDX(KIDIA:KFDIA,2*KLEV+1) = 0.0_JPRB
  
  PQ(KIDIA:KFDIA,1:KLEV) = PQ(KIDIA:KFDIA,1:KLEV) &
   & + ZDX(KIDIA:KFDIA,KLEV+1:2*KLEV)  
  ZDX(KIDIA:KFDIA,KLEV+1:2*KLEV) = 0.0_JPRB

! Fill in zdx array

  DO JK = KLEV,1,-1
    IKL = KLEV + 1 - JK
    DO JL = KIDIA,KFDIA  
      PTAVE(JL,IKL) = PTAVE(JL,IKL) + ZDX(JL,JK)
      ZDX(JL,JK) = 0.0_JPRB
    ENDDO
  ENDDO
  
ENDIF

!          2.   FLUX PERTURBATIONS

!          2.1   LEFT MEMBER    ( Fi * dai )

IF (LLLEFT) THEN

  DO JK = KLEV+1,1,-1
  
!downward cloudy contribution
    DO JK1 = KLEV+1,JK+1,-1 
      DO JL = KIDIA,KFDIA
        ZAI(JL,JK1,JK,1) = ZAI(JL,JK1,JK,1) &
         & + ZDNF5(JL,JK1,JK) * PFLUX(JL,2,JK)  
      ENDDO
    ENDDO
!downward clear contribution
    DO JL = KIDIA,KFDIA  
!     ZAI(JL,2,1,JK) = ZAI(JL,2,1,JK) &
!       & + ZDNF5(JL,1,JK) * PFLUX(JL,2,JK)
      ZAIC(JL,JK) = ZAIC(JL,JK) &
       & +   ZDNF5(JL,1,JK) * PFLUX(JL,2,JK)   
    ENDDO
!upward cloudy sky
    DO JK1 = JK,1,-1 
      DO JL = KIDIA,KFDIA
        ZAI(JL,JK1,JK,1) = ZAI(JL,JK1,JK,1) &
         & + ZUPF5(JL,JK1,JK) * PFLUX(JL,1,JK)  
      ENDDO
    ENDDO
  ENDDO
ENDIF

PFLUC(:,:,:) = 0.0_JPRB
PFLUX(:,:,:) = 0.0_JPRB

IF (LERADFL2) THEN    

  CALL LWAIAD( KIDIA , KFDIA, KLON  , KLEV,&
   & PCLDLD5, PCLDLU5, PCLFR5, ZAI5, ZAIC5,&
   & PCLDLD , PCLDLU , PCLFR , ZAI , ZAIC )  
ENDIF
      
! -------------------------------------------------------------

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