/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwtt.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/Radlwsw/lwtt.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Nov 15 18:45:49 2013 UTC (10 years, 7 months ago) by guez
Original Path: trunk/phylmd/Radlwsw/lwtt.f
File size: 5285 byte(s)
Moved everything out of libf.
1 guez 24 SUBROUTINE LWTT(PGA,PGB,PUU, PTT)
2     use dimens_m
3     use dimphy
4     use raddim
5     use raddimlw
6     IMPLICIT none
7     C
8     C-----------------------------------------------------------------------
9     C PURPOSE.
10     C --------
11     C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
12     C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
13     C INTERVALS.
14     C
15     C METHOD.
16     C -------
17     C
18     C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
19     C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
20     C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
21     C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
22     C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
23     C
24     C REFERENCE.
25     C ----------
26     C
27     C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
28     C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
29     C
30     C AUTHOR.
31     C -------
32     C JEAN-JACQUES MORCRETTE *ECMWF*
33     C
34     C MODIFICATIONS.
35     C --------------
36     C ORIGINAL : 88-12-15
37     C
38     C-----------------------------------------------------------------------
39 guez 71 DOUBLE PRECISION O1H, O2H
40 guez 24 PARAMETER (O1H=2230.)
41     PARAMETER (O2H=100.)
42 guez 71 DOUBLE PRECISION RPIALF0
43 guez 24 PARAMETER (RPIALF0=2.0)
44     C
45     C* ARGUMENTS:
46     C
47 guez 71 DOUBLE PRECISION PUU(KDLON,NUA)
48     DOUBLE PRECISION PTT(KDLON,NTRA)
49     DOUBLE PRECISION PGA(KDLON,8,2)
50     DOUBLE PRECISION PGB(KDLON,8,2)
51 guez 24 C
52     C* LOCAL VARIABLES:
53     C
54 guez 71 DOUBLE PRECISION zz, zxd, zxn
55     DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13
56     DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13
57     DOUBLE PRECISION zx, zy, zsq1, zsq2, zvxy, zuxy
58     DOUBLE PRECISION zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
59     DOUBLE PRECISION zsqn21, zodn21, zsqh42, zodh42
60     DOUBLE PRECISION zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
61     DOUBLE PRECISION zuu11, zuu12, za11, za12
62 guez 24 INTEGER jl, ja
63     C ------------------------------------------------------------------
64     C
65     C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
66     C -----------------------------------------------
67     C
68     100 CONTINUE
69     C
70     C
71     DO 130 JA = 1 , 8
72     DO 120 JL = 1, KDLON
73     ZZ =SQRT(PUU(JL,JA))
74     c ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
75     c ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
76     c PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
77     ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ )
78     ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) )
79     PTT(JL,JA)=ZXN /ZXD
80     120 CONTINUE
81     130 CONTINUE
82     C
83     C ------------------------------------------------------------------
84     C
85     C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
86     C ---------------------------------------------------
87     C
88     200 CONTINUE
89     C
90     DO 201 JL = 1, KDLON
91     PTT(JL, 9) = PTT(JL, 8)
92     C
93     C- CONTINUUM ABSORPTION: E- AND P-TYPE
94     C
95     ZPU = 0.002 * PUU(JL,10)
96     ZPU10 = 112. * ZPU
97     ZPU11 = 6.25 * ZPU
98     ZPU12 = 5.00 * ZPU
99     ZPU13 = 80.0 * ZPU
100     ZEU = PUU(JL,11)
101     ZEU10 = 12. * ZEU
102     ZEU11 = 6.25 * ZEU
103     ZEU12 = 5.00 * ZEU
104     ZEU13 = 80.0 * ZEU
105     C
106     C- OZONE ABSORPTION
107     C
108     ZX = PUU(JL,12)
109     ZY = PUU(JL,13)
110     ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)
111     ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.
112     ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.
113     ZVXY = RPIALF0 * ZY / (2. * ZX)
114     ZAERCN = PUU(JL,17) + ZEU12 + ZPU12
115     ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
116     ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
117     C
118     C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
119     C
120     C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
121     C
122     c NEXOTIC=1
123     c IF (NEXOTIC.EQ.1) THEN
124     ZXCH4 = PUU(JL,19)
125     ZYCH4 = PUU(JL,20)
126     ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4)
127     ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.
128     ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)
129     ZODH41 = ZVXY * ZSQH41
130     C
131     C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
132     C
133     ZXN2O = PUU(JL,21)
134     ZYN2O = PUU(JL,22)
135     ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O)
136     ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.
137     ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)
138     ZODN21 = ZVXY * ZSQN21
139     C
140     C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
141     C
142     ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4)
143     ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.
144     ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)
145     ZODH42 = ZVXY * ZSQH42
146     C
147     C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
148     C
149     ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O)
150     ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.
151     ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)
152     ZODN22 = ZVXY * ZSQN22
153     C
154     C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
155     C
156     ZA11 = 2. * PUU(JL,23) * 4.404E+05
157     ZTTF11 = 1. - ZA11 * 0.003225
158     C
159     C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
160     C
161     ZA12 = 2. * PUU(JL,24) * 6.7435E+05
162     ZTTF12 = 1. - ZA12 * 0.003225
163     C
164     ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10
165     ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21
166     PTT(JL,10) = EXP( - PUU(JL,14) )
167     PTT(JL,11) = EXP( ZUU11 )
168     PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
169     PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2
170     PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
171     PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 )
172     201 CONTINUE
173     C
174     RETURN
175     END

  ViewVC Help
Powered by ViewVC 1.1.21