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

Annotation of /trunk/libf/phylmd/Radlwsw/lwttm.f

Parent Directory Parent Directory | Revision Log Revision Log

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

Removed variable "itaufinp1" in "leapfrog".
1 guez 24 SUBROUTINE LWTTM(PGA,PGB,PUU1,PUU2, 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 PGA(KDLON,8,2) ! PADE APPROXIMANTS
48     REAL*8 PGB(KDLON,8,2) ! PADE APPROXIMANTS
49     REAL*8 PUU1(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
50     REAL*8 PUU2(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
51     REAL*8 PTT(KDLON,NTRA) ! TRANSMISSION FUNCTIONS
52     C
53     C* LOCAL VARIABLES:
54     C
55     INTEGER ja, jl
56     REAL*8 zz, zxd, zxn
57     REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
58     REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
59     REAL*8 zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2
60     REAL*8 zxch4, zych4, zsqh41, zodh41
61     REAL*8 zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
62     REAL*8 zsqn22, zodn22, za11, zttf11, za12, zttf12
63     REAL*8 zuu11, zuu12
64     C ------------------------------------------------------------------
65     C
66     C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
67     C -----------------------------------------------
68     C
69     100 CONTINUE
70     C
71     C
72     DO 130 JA = 1 , 8
73     DO 120 JL = 1, KDLON
74     ZZ =SQRT(PUU1(JL,JA) - PUU2(JL,JA))
75     ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ )
76     ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) )
77     PTT(JL,JA)=ZXN /ZXD
78     120 CONTINUE
79     130 CONTINUE
80     C
81     C ------------------------------------------------------------------
82     C
83     C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
84     C ---------------------------------------------------
85     C
86     200 CONTINUE
87     C
88     DO 201 JL = 1, KDLON
89     PTT(JL, 9) = PTT(JL, 8)
90     C
91     C- CONTINUUM ABSORPTION: E- AND P-TYPE
92     C
93     ZPU = 0.002 * (PUU1(JL,10) - PUU2(JL,10))
94     ZPU10 = 112. * ZPU
95     ZPU11 = 6.25 * ZPU
96     ZPU12 = 5.00 * ZPU
97     ZPU13 = 80.0 * ZPU
98     ZEU = (PUU1(JL,11) - PUU2(JL,11))
99     ZEU10 = 12. * ZEU
100     ZEU11 = 6.25 * ZEU
101     ZEU12 = 5.00 * ZEU
102     ZEU13 = 80.0 * ZEU
103     C
104     C- OZONE ABSORPTION
105     C
106     ZX = (PUU1(JL,12) - PUU2(JL,12))
107     ZY = (PUU1(JL,13) - PUU2(JL,13))
108     ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)
109     ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.
110     ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.
111     ZVXY = RPIALF0 * ZY / (2. * ZX)
112     ZAERCN = (PUU1(JL,17) -PUU2(JL,17)) + ZEU12 + ZPU12
113     ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
114     ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
115     C
116     C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
117     C
118     C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
119     C
120     ZXCH4 = (PUU1(JL,19) - PUU2(JL,19))
121     ZYCH4 = (PUU1(JL,20) - PUU2(JL,20))
122     ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4)
123     ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.
124     ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)
125     ZODH41 = ZVXY * ZSQH41
126     C
127     C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
128     C
129     ZXN2O = (PUU1(JL,21) - PUU2(JL,21))
130     ZYN2O = (PUU1(JL,22) - PUU2(JL,22))
131     ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O)
132     ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.
133     ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)
134     ZODN21 = ZVXY * ZSQN21
135     C
136     C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
137     C
138     ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4)
139     ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.
140     ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)
141     ZODH42 = ZVXY * ZSQH42
142     C
143     C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
144     C
145     ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O)
146     ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.
147     ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)
148     ZODN22 = ZVXY * ZSQN22
149     C
150     C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
151     C
152     ZA11 = (PUU1(JL,23) - PUU2(JL,23)) * 4.404E+05
153     ZTTF11 = 1. - ZA11 * 0.003225
154     C
155     C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
156     C
157     ZA12 = (PUU1(JL,24) - PUU2(JL,24)) * 6.7435E+05
158     ZTTF12 = 1. - ZA12 * 0.003225
159     C
160     ZUU11 = - (PUU1(JL,15) - PUU2(JL,15)) - ZEU10 - ZPU10
161     ZUU12 = - (PUU1(JL,16) - PUU2(JL,16)) - ZEU11 - ZPU11 -
162     S ZODH41 - ZODN21
163     PTT(JL,10) = EXP( - (PUU1(JL,14)- PUU2(JL,14)) )
164     PTT(JL,11) = EXP( ZUU11 )
165     PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
166     PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2
167     PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
168     PTT(JL,15) = EXP ( - (PUU1(JL,14) - PUU2(JL,14)) - ZODH42-ZODN22 )
169     201 CONTINUE
170     C
171     RETURN
172     END
  ViewVC Help
Powered by ViewVC 1.1.21