*=*=*=*= TAU.html =*=*=*=*
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