*=*=*=*= SWTT.html =*=*=*=*
SUBROUTINE SWTT

SUBROUTINE SWTT


      SUBROUTINE SWTT (KDLON,KNU,KA,PU,PTR)
      IMPLICIT LOGICAL (L)
C
#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
C
C**** *SWTT* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS
C
C     PURPOSE.
C     --------
C           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
C     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
C     INTERVALS.
C
C**   INTERFACE.
C     ----------
C          *SWTT* IS CALLED FROM *SW*.
C
C     SUBROUTINE SWTT (KDLON,KNU,KA,PU,PTR)
C
C        EXPLICIT ARGUMENTS :
C        --------------------
C KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
C KA     :                     ; INDEX OF THE ABSORBER
C PU     : (KDLON)             ; ABSORBER AMOUNT
C     ==== OUTPUTS ===
C PTR    : (KDLON)             ; TRANSMISSION FUNCTION
C
C        IMPLICIT ARGUMENTS :   NONE
C        --------------------
C
C     METHOD.
C     -------
C
C          TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
C     AND HORNER'S ALGORITHM.
C
C     EXTERNALS.
C     ----------
C
C          NONE
C
C     REFERENCE.
C     ----------
C
C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IN CORE MODEL"
C
C     AUTHOR.
C     -------
C        JEAN-JACQUES MORCRETTE  *ECMWF*
C
C     MODIFICATIONS.
C     --------------
C        ORIGINAL : 88-12-15
C-----------------------------------------------------------------------
C
#include "yomsw.h"
C
C-----------------------------------------------------------------------
C
C*       0.1   ARGUMENTS
C              ---------
C
      REAL PU(NDLO2), PTR(NDLO2)
C
C-----------------------------------------------------------------------
C
C*       0.2   LOCAL ARRAYS
C              ------------
C
      REAL ZR1(NDLON), ZR2(NDLON)
C
C-----------------------------------------------------------------------
C
C*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
C
 100  CONTINUE
C
      DO 101 JL = 1 , KDLON
      ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL)
     S      * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL)
     S      * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL)
     S      * ( APAD(KNU,KA,7) ))))))
C
      ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL)
     S      * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL)
     S      * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL)
     S      * ( BPAD(KNU,KA,7) ))))))
 101  CONTINUE
C
C*         2.      ADD THE BACKGROUND TRANSMISSION
C
 200  CONTINUE
C
      DO 201 JL = 1 , KDLON
      PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1. - D(KNU,KA)) + D(KNU,KA)
 201  CONTINUE
C
      RETURN
      END