*=*=*=*= TAU.html =*=*=*=*
PROGRAM TAU

PROGRAM TAU


      PROGRAM TAU
      IMPLICIT NONE
C
C#include "dimensions.h"
C#include "dimphys.h"
C#include "dimradmars.h"
C#include "yomlw.h"
C
C**** *LWTT* - LONGWAVE 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 ALL SIX SPECTRAL
C     INTERVALS.
C
C**   INTERFACE.
C     ----------
C          *LWTT* IS CALLED FROM *LWV*.
C
C     SUBROUTINE LWTT (KDLON,KND,KT,PUU,PTT)
C
C        EXPLICIT ARGUMENTS :
C        --------------------
C     ==== INPUTS ===
C KND    :                     ; WEIGHTING INDEX
C KT     :                     ; TEMPERATURE INDEX
C PUU    : (KDLON,NUA)         ; ABSORBER AMOUNTS
C     ==== OUTPUTS ===
C PTT    : (KDLON,NTRA)        ; TRANSMISSION FUNCTIONS
C
C        IMPLICIT ARGUMENTS :   NONE
C        --------------------
C
C     METHOD.
C     -------
C
C          1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
C     COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
C          2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
C          3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
C     A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
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
C
C-----------------------------------------------------------------------
C
C
C*        0.1   ARGUMENTS
C               ---------
C
      INTEGER kdlon,NDLO2,nua,ntra,ndlon
      PARAMETER (NDLON=1)
      PARAMETER (NDLO2=1)
      PARAMETER (KDLON=1)
      PARAMETER (NUA=4)
      PARAMETER (NTRA=2)
      REAL PUU(NDLO2,NUA), PTT(NDLO2,NTRA)
      REAL PGA(NDLO2,3,2),PGB(NDLO2,3,2)

c   exemple des donnees pour la couche 1

      DATA pga /2.88231D-05, 1.70794D-02, -3.39714D-02,
     .          2.89299D-02, 1.90634,      3.84061      /
      DATA pgb /2.88231D-05, 1.45426D-02,  0.543812,
     .          2.89299D-02, 1.89485,      6.00363      /
      DATA puu /3.1714026112881D-02, 3.5476765992828D-03,
     .          6.1462002611172D-03, 4.2442367470639D-04  /

C
C     ------------------------------------------------------------------
C
C*        0.2   LOCAL ARRAYS
C               ------------
C
      INTEGER JA,JL,jabs
      REAL ZXN(NDLON),ZXD(NDLON),zueq(ndlon)
      REAL cst_voigt(2,2)
      DATA cst_voigt / 0.500E-02, 0.100E-01, 0.150E-01,0.100E+00/

C
c-----------------------------------------------------------------------
c   Transmission by the CO2 15 microns band:
c   ----------------------------------------

      DO  ja=1,2
       jabs=ja*2-1

c   equivalent absorber amount (Doppler effect):
c   --------------------------------------------

       DO jl=1,kdlon
          zueq(jl)=SQRT(puu(jl,jabs+1))
     s      +cst_voigt(1,ja)*puu(jl,jabs)**cst_voigt(2,ja)
       ENDDO

c   Horner's algorithm:
c   -------------------

         DO jl=1,kdlon
            zxn(jl) = pga(jl,1,ja) +
     1      zueq(jl)*(pga(jl,2,ja) + zueq(jl) * pga(jl,3,ja) )
            zxd(jl) = pgb(jl,1,ja) + zueq(jl)*(pgb(jl,2,ja) +
     1      zueq(jl) * ( pgb(jl,3,ja) + zueq(jl)  ))
            ptt(jl,ja) = zxn(jl) / zxd(jl)
         print*,'ptt pour ja = ',ja,ptt(jl,ja)
       ENDDO
      ENDDO

      END