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

Contents of /trunk/libf/phylmd/Radlwsw/lwtt.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 24 - (show annotations)
Wed Mar 3 13:23:49 2010 UTC (14 years, 3 months ago) by guez
File size: 5145 byte(s)
Created directory "phylmd/Radlwsw". Split "radlwsw.f" in files
containing a single procedure.

Removed variable "itaufinp1" in "leapfrog".

1 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