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

Contents of /trunk/Sources/phylmd/Radlwsw/lwttm.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 134 - (show annotations)
Wed Apr 29 15:47:56 2015 UTC (9 years, 1 month ago) by guez
File size: 4967 byte(s)
Sources inside, compilation outside.
1 SUBROUTINE lwttm(pga, pgb, puu1, puu2, ptt)
2 USE dimens_m
3 USE dimphy
4 USE raddim
5 USE raddimlw
6 IMPLICIT NONE
7
8 ! ------------------------------------------------------------------
9 ! PURPOSE.
10 ! --------
11 ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
12 ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
13 ! INTERVALS.
14
15 ! METHOD.
16 ! -------
17
18 ! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
19 ! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
20 ! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
21 ! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
22 ! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
23
24 ! REFERENCE.
25 ! ----------
26
27 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
28 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
29
30 ! AUTHOR.
31 ! -------
32 ! JEAN-JACQUES MORCRETTE *ECMWF*
33
34 ! MODIFICATIONS.
35 ! --------------
36 ! ORIGINAL : 88-12-15
37
38 ! -----------------------------------------------------------------------
39 DOUBLE PRECISION o1h, o2h
40 PARAMETER (o1h=2230.)
41 PARAMETER (o2h=100.)
42 DOUBLE PRECISION rpialf0
43 PARAMETER (rpialf0=2.0)
44
45 ! * ARGUMENTS:
46
47 DOUBLE PRECISION pga(kdlon, 8, 2) ! PADE APPROXIMANTS
48 DOUBLE PRECISION pgb(kdlon, 8, 2) ! PADE APPROXIMANTS
49 DOUBLE PRECISION puu1(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
50 DOUBLE PRECISION puu2(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
51 DOUBLE PRECISION ptt(kdlon, ntra) ! TRANSMISSION FUNCTIONS
52
53 ! * LOCAL VARIABLES:
54
55 INTEGER ja, jl
56 DOUBLE PRECISION zz, zxd, zxn
57 DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13
58 DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13
59 DOUBLE PRECISION zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1
60 DOUBLE PRECISION zto2
61 DOUBLE PRECISION zxch4, zych4, zsqh41, zodh41
62 DOUBLE PRECISION zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
63 DOUBLE PRECISION zsqn22, zodn22, za11, zttf11, za12, zttf12
64 DOUBLE PRECISION zuu11, zuu12
65 ! ------------------------------------------------------------------
66
67 ! * 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
68 ! -----------------------------------------------
69
70
71
72 DO ja = 1, 8
73 DO 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 END DO
79 END DO
80
81 ! ------------------------------------------------------------------
82
83 ! * 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
84 ! ---------------------------------------------------
85
86
87 DO jl = 1, kdlon
88 ptt(jl, 9) = ptt(jl, 8)
89
90 ! - CONTINUUM ABSORPTION: E- AND P-TYPE
91
92 zpu = 0.002*(puu1(jl,10)-puu2(jl,10))
93 zpu10 = 112.*zpu
94 zpu11 = 6.25*zpu
95 zpu12 = 5.00*zpu
96 zpu13 = 80.0*zpu
97 zeu = (puu1(jl,11)-puu2(jl,11))
98 zeu10 = 12.*zeu
99 zeu11 = 6.25*zeu
100 zeu12 = 5.00*zeu
101 zeu13 = 80.0*zeu
102
103 ! - OZONE ABSORPTION
104
105 zx = (puu1(jl,12)-puu2(jl,12))
106 zy = (puu1(jl,13)-puu2(jl,13))
107 zuxy = 4.*zx*zx/(rpialf0*zy)
108 zsq1 = sqrt(1.+o1h*zuxy) - 1.
109 zsq2 = sqrt(1.+o2h*zuxy) - 1.
110 zvxy = rpialf0*zy/(2.*zx)
111 zaercn = (puu1(jl,17)-puu2(jl,17)) + zeu12 + zpu12
112 zto1 = exp(-zvxy*zsq1-zaercn)
113 zto2 = exp(-zvxy*zsq2-zaercn)
114
115 ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
116
117 ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
118
119 zxch4 = (puu1(jl,19)-puu2(jl,19))
120 zych4 = (puu1(jl,20)-puu2(jl,20))
121 zuxy = 4.*zxch4*zxch4/(0.103*zych4)
122 zsqh41 = sqrt(1.+33.7*zuxy) - 1.
123 zvxy = 0.103*zych4/(2.*zxch4)
124 zodh41 = zvxy*zsqh41
125
126 ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
127
128 zxn2o = (puu1(jl,21)-puu2(jl,21))
129 zyn2o = (puu1(jl,22)-puu2(jl,22))
130 zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o)
131 zsqn21 = sqrt(1.+21.3*zuxy) - 1.
132 zvxy = 0.416*zyn2o/(2.*zxn2o)
133 zodn21 = zvxy*zsqn21
134
135 ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
136
137 zuxy = 4.*zxch4*zxch4/(0.113*zych4)
138 zsqh42 = sqrt(1.+400.*zuxy) - 1.
139 zvxy = 0.113*zych4/(2.*zxch4)
140 zodh42 = zvxy*zsqh42
141
142 ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
143
144 zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o)
145 zsqn22 = sqrt(1.+2000.*zuxy) - 1.
146 zvxy = 0.197*zyn2o/(2.*zxn2o)
147 zodn22 = zvxy*zsqn22
148
149 ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
150
151 za11 = (puu1(jl,23)-puu2(jl,23))*4.404E+05
152 zttf11 = 1. - za11*0.003225
153
154 ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
155
156 za12 = (puu1(jl,24)-puu2(jl,24))*6.7435E+05
157 zttf12 = 1. - za12*0.003225
158
159 zuu11 = -(puu1(jl,15)-puu2(jl,15)) - zeu10 - zpu10
160 zuu12 = -(puu1(jl,16)-puu2(jl,16)) - zeu11 - zpu11 - zodh41 - zodn21
161 ptt(jl, 10) = exp(-(puu1(jl,14)-puu2(jl,14)))
162 ptt(jl, 11) = exp(zuu11)
163 ptt(jl, 12) = exp(zuu12)*zttf11*zttf12
164 ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2
165 ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
166 ptt(jl, 15) = exp(-(puu1(jl,14)-puu2(jl,14))-zodh42-zodn22)
167 END DO
168
169 RETURN
170 END SUBROUTINE lwttm

  ViewVC Help
Powered by ViewVC 1.1.21