/[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 24 - (hide annotations)
Wed Mar 3 13:23:49 2010 UTC (14 years, 3 months ago) by guez
Original Path: trunk/libf/phylmd/Radlwsw/lwtt.f
File size: 5145 byte(s)
Created directory "phylmd/Radlwsw". Split "radlwsw.f" in files
containing a single procedure.

Removed variable "itaufinp1" in "leapfrog".

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     REAL*8 O1H, O2H
40     PARAMETER (O1H=2230.)
41     PARAMETER (O2H=100.)
42     REAL*8 RPIALF0
43     PARAMETER (RPIALF0=2.0)
44     C
45     C* ARGUMENTS:
46     C
47     REAL*8 PUU(KDLON,NUA)
48     REAL*8 PTT(KDLON,NTRA)
49     REAL*8 PGA(KDLON,8,2)
50     REAL*8 PGB(KDLON,8,2)
51     C
52     C* LOCAL VARIABLES:
53     C
54     REAL*8 zz, zxd, zxn
55     REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
56     REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
57     REAL*8 zx, zy, zsq1, zsq2, zvxy, zuxy
58     REAL*8 zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
59     REAL*8 zsqn21, zodn21, zsqh42, zodh42
60     REAL*8 zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
61     REAL*8 zuu11, zuu12, za11, za12
62     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