SUBROUTINE SWTTAD ( KIDIA, KFDIA, KLON, KNU, KA , PU5, PTR5, PU, PTR)

!**** *SWTTAD* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS
!                -> ADJOINT <-

!     PURPOSE.
!     --------
!           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
!     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
!     INTERVALS.

!**   INTERFACE.
!     ----------
!          *SWTTAD* IS CALLED FROM *SW1SAD*, *SWNIAD*.

!        EXPLICIT ARGUMENTS :
!        --------------------
! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
! KA     :                     ; INDEX OF THE ABSORBER
! PU     : (KLON)             ; ABSORBER AMOUNT
!     ==== OUTPUTS ===
! PTR    : (KLON)             ; TRANSMISSION FUNCTION

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

!     METHOD.
!     -------

!          TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
!     AND HORNER'S ALGORITHM.

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

!          NONE

!     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 : 96-10-17
!        M.Hamrud     01-Oct-2003 CY28 Cleaning
!        M.Janiskova  18-Mar-2008 code optimization

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

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

USE YOESW    , ONLY : APAD     ,BPAD     ,D

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNU 
INTEGER(KIND=JPIM),INTENT(IN)    :: KA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR5(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PU(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTR(KLON) 
!-----------------------------------------------------------------------

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

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

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

REAL(KIND=JPRB) :: ZR15(KLON), ZR25(KLON)
REAL(KIND=JPRB) :: ZR1 (KLON), ZR2 (KLON)
REAL(KIND=JPRB) :: ZDIV5

INTEGER(KIND=JPIM) :: JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION

! 100 CONTINUE

IF (LHOOK) CALL DR_HOOK('SWTTAD',0,ZHOOK_HANDLE)
DO JL = KIDIA,KFDIA
  ZR15(JL)= APAD(KNU,KA,1) + PU5(JL) * (APAD(KNU,KA,2) + PU5(JL)&
   & * ( APAD(KNU,KA,3) + PU5(JL) * (APAD(KNU,KA,4) + PU5(JL)&
   & * ( APAD(KNU,KA,5) + PU5(JL) * (APAD(KNU,KA,6) + PU5(JL)&
   & * ( APAD(KNU,KA,7) ))))))  

  ZR25(JL)= BPAD(KNU,KA,1) + PU5(JL) * (BPAD(KNU,KA,2) + PU5(JL)&
   & * ( BPAD(KNU,KA,3) + PU5(JL) * (BPAD(KNU,KA,4) + PU5(JL)&
   & * ( BPAD(KNU,KA,5) + PU5(JL) * (BPAD(KNU,KA,6) + PU5(JL)&
   & * ( BPAD(KNU,KA,7) ))))))  

!*         2.      ADD THE BACKGROUND TRANSMISSION

! 200 CONTINUE

  ZDIV5 = 1.0_JPRB/ZR25(JL)
  PTR5(JL) = (ZR15(JL)*ZDIV5) * (1.0_JPRB-D(KNU,KA)) + D(KNU,KA)

!     ==================================================================

!          10.     ADJOINT COMPUTATIONS
!                  -------------------- 

  ZR1(JL)=0.0_JPRB
  ZR2(JL)=0.0_JPRB

!*         2.      ADD THE BACKGROUND TRANSMISSION

  ZR1(JL) = ZR1(JL) + (1.0_JPRB-D(KNU,KA))*PTR(JL)*ZDIV5
  ZR2(JL) = ZR2(JL) - (1.0_JPRB-D(KNU,KA))*PTR(JL)*ZR15(JL)*ZDIV5**2
  PTR(JL) = 0.0_JPRB

!*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION

  PU(JL) = PU(JL) + ZR2(JL)           *( BPAD(KNU,KA,2) +&
   & PU5(JL)&
   & * ( 2*BPAD(KNU,KA,3) + PU5(JL)*( 3*BPAD(KNU,KA,4) + PU5(JL)&
   & * ( 4*BPAD(KNU,KA,5) + PU5(JL)*( 5*BPAD(KNU,KA,6) + PU5(JL)&
   & * ( 6*BPAD(KNU,KA,7) ))))))  
!  ZR2(JL) = 0.0_JPRB

  PU(JL) = PU(JL) + ZR1(JL)           *( APAD(KNU,KA,2) +&
   & PU5(JL)&
   & * ( 2*APAD(KNU,KA,3) + PU5(JL)*( 3*APAD(KNU,KA,4) + PU5(JL)&
   & * ( 4*APAD(KNU,KA,5) + PU5(JL)*( 5*APAD(KNU,KA,6) + PU5(JL)&
   & * ( 6*APAD(KNU,KA,7) ))))))  
!  ZR1(JL) = 0.0_JPRB

ENDDO

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

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