| blob | bf96d40c31ab02c22ecf04f6949598fd28e47f2b |
1 MODULE PARA_FILE
2 implicit none
3 !vertical layer parameters
4 integer, parameter :: &
5 ! & nv = 27, &
6 ! & nv1 = nv + 1, &
7 ! & ndfs = nv, &
8 ! & ndfs2 = ndfs * 2, &
9 ! & mdfs = nv + 1, &
10 ! & ndfs4 = 4 * ndfs, &
11 & nvx = 100, &
12 & nv1x = nvx + 1
14 !spectral band parameters
15 integer, parameter :: mbs = 6, &!number of sw bands
16 & mbir = 12, &!number of lw bands
17 & mb = 18, &!number of bands
18 & mbx = 18, &!number of bands
19 & mby = 10 !number of sub-bands in 0.2-0.7 um
21 !number of drop size distributions
22 integer, parameter :: nc = 8
24 !fractional cloud parameters
25 ! integer, parameter :: ngroup = 3, &!number of cloud groups
26 integer, save :: ngroup = 3, &!number of cloud groups
27 & nclouds , &!number of total cloud layers
28 & nsubcld !number of cloud layers in a group
29 ! & nclouds = 24, &!number of total cloud layers
30 ! & nsubcld = 8 !number of cloud layers in a group
31 ! & nclouds = nv, &!number of total cloud layers
32 ! & nsubcld = nclouds/ngroup !number of cloud layers in a group
34 !aerosol parameters
35 integer, parameter :: nrh = 8, &!number of relative humidities for optical properties
36 & naer = 18, &!max number of aerosol types
37 & mxat = 7, &!max number of wavelength dependent aerosol optical depths
38 & mxac = naer !max number of aerosol constituents
40 !parameter for AOT_ SPLINEFIT
41 integer, parameter :: nsub = 5 , &
42 & nfuo = 15 , &
43 & nwo = 75
45 integer, parameter :: icoln = 3
47 END module PARA_FILE
49 !---------------------- Controlling Parameters -------------------------
50 MODULE control_para
51 use PARA_FILE
52 implicit none
53 integer, save :: NFRACT = 0, & !add for fractional cloud:=1, fraction; =0, no
54 & NAERO = 0, & !add for aerosol: =0, no aerosol; = 1, aerosol uniform value included; =2, get data from file
55 & NINHO = 0 , & ! if =0, horizontal homogenious; = 1, inhomogeneous
56 & NINHO_VERT, &
57 & NPDE = 2, & !add for ice crystal size parameterization:
58 ! =4, para. via IWC & AOD using A-Tran satellite data;
59 ! =3, para. via IWC using satellite data;
60 ! =2, para. via IWC (Liou et al. 2008);
61 ! =1, parameterize interms of T & IWC (Gu & Liou, 2006);
62 ! =0, fixed value;
63 ! NPDE = 3 & 4 is still under testing ---- CCCC
64 & NGAS = 0, & !add for new gases: =0, no new gases; = 1, new gases included and takes longer computer time
65 & NOZONE = 1 , & ! if =0, no ozone; = 1, predescribed profiles; = 2, input from WRF
66 & NICE = 2 !add for cloud:
67 !nice=0, use old ones (FLIce93);
68 !nice=1, use new coefficients for ice by Feng;
69 !nice=2, use new coefficients by Qing Yue 2006;
70 !seperate tropics and midlatitute: nice = 3, tropics; nice = 4, midlat
71 integer, save :: itps(mxac) = 0 , & !aerosol type: itps(iac)=1 stands for existing aerosol type iac
72 & nfraca = 1 , & ! --if nfraca=0, use aerosol types and fractions passed from the driver
73 ! nfraca=1, use precribed total AOD, aerosol types and fractions;
74 ! nfraca=2, input total AOD, aerosol types and fractions from screen;
75 ! nfraca=3, input aerosol types and optical depths.
76 & ivd = 1 , & ! --if ivd=0, use Spinhirne Vertical tau distribution;
77 ! ivd=1, use aer_scale_hgt;
78 ! ivd=2, pass vertical tau from driver;
79 ! ivd=3, inpput vertical AOD profile for each aerosol type
80 & ifg = 0 , & !aerosol humidity dependence
81 & iaform = 3 , & !iaform: 1 for CERES; 2 for CAGEX; 3 for AOT_ SPLINEFIT
82 & n_atau = 1 !n_atau:# Aerosol Tau / Wavelengths
84 logical, save :: d4s = .true. , &
85 & d2s = .false., &
86 & d4ir = .false., &
87 & d2ir = .true. , &
88 & edding, quadra, hemisp
89 logical, save :: pderandom = .false.
92 real, save :: umco2 = 345.0 , &
93 & umch4 = 1.6 , &
94 & umn2o = 0.28 , &
95 & umco = 0.16 , &
96 & umo2 = 2.0948E+05, &
97 & umno = 0.0005 , &
98 & umso2 = 0.001 , &
99 & umno2 = 0.001 , &
100 & umch3cl= 0.5E-3 , &
101 & umCFC11= 0.22E-3 , &
102 & umCFC12= 0.375E-3
103 !-- if ngas = 0, use old gas; if ngas = 1, add new trace gases following ZF et al. (2006)
104 integer, save :: no2s = 1, &
105 & nco2s = 1, &
106 & nso2s = 1, &
107 & nch4s = 1, &
108 & nnol = 1, &
109 & nno2l = 1, &
110 & nso2l = 1, &
111 & nch3cll = 1, &
112 & ncos = 1, &
113 & nn2os = 1, &
114 & nh2ocs = 1, &
115 & nh2os = 1, &
116 & no3s = 1, &
117 & nh2ol = 1, &
118 & no3l = 1, &
119 & nco2l = 1, &
120 & nn2ol = 1, &
121 & nch4l = 1, &
122 & nh2ocl = 1, &
123 & nrayle = 1, &
124 & nCFC11l = 1, &
125 & nCFC12l =1
126 end module control_para
129 !---------------------- begin ozone data -------------------------------
130 module module_ozone
131 implicit none
132 integer, parameter :: np = 75
133 integer :: i
134 real :: pres(np,5), ozone(np,5)
135 !--------------------------------------------------------------------------------
136 ! data set 1
137 ! mid-latitude summer (75 levels) : p(mb) o3(g/g)
138 ! surface temp = 294.0
139 !
140 data (pres(i,1),i=1,np)/ &
141 0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
142 0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
143 0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
144 0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
145 0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
146 4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
147 31.5105, 44.2001, 62.0000, 85.7750, 109.5500, 133.3250, &
148 157.1000, 180.8750, 204.6500, 228.4250, 252.2000, 275.9750, &
149 299.7500, 323.5250, 347.3000, 371.0750, 394.8500, 418.6250, &
150 442.4000, 466.1750, 489.9500, 513.7250, 537.5000, 561.2750, &
151 585.0500, 608.8250, 632.6000, 656.3750, 680.1500, 703.9250, &
152 727.7000, 751.4750, 775.2500, 799.0250, 822.8000, 846.5750, &
153 870.3500, 894.1250, 917.9000, 941.6750, 965.4500, 989.2250, &
154 1013.0000/
155 !
156 data (ozone(i,1),i=1,np)/ &
157 0.1793E-06, 0.2228E-06, 0.2665E-06, 0.3104E-06, 0.3545E-06, &
158 0.3989E-06, 0.4435E-06, 0.4883E-06, 0.5333E-06, 0.5786E-06, &
159 0.6241E-06, 0.6698E-06, 0.7157E-06, 0.7622E-06, 0.8557E-06, &
160 0.1150E-05, 0.1462E-05, 0.1793E-05, 0.2143E-05, 0.2512E-05, &
161 0.2902E-05, 0.3313E-05, 0.4016E-05, 0.5193E-05, 0.6698E-05, &
162 0.8483E-05, 0.9378E-05, 0.9792E-05, 0.1002E-04, 0.1014E-04, &
163 0.9312E-05, 0.7834E-05, 0.6448E-05, 0.5159E-05, 0.3390E-05, &
164 0.1937E-05, 0.1205E-05, 0.8778E-06, 0.6935E-06, 0.5112E-06, &
165 0.3877E-06, 0.3262E-06, 0.2770E-06, 0.2266E-06, 0.2020E-06, &
166 0.1845E-06, 0.1679E-06, 0.1519E-06, 0.1415E-06, 0.1317E-06, &
167 0.1225E-06, 0.1137E-06, 0.1055E-06, 0.1001E-06, 0.9487E-07, &
168 0.9016E-07, 0.8641E-07, 0.8276E-07, 0.7930E-07, 0.7635E-07, &
169 0.7347E-07, 0.7065E-07, 0.6821E-07, 0.6593E-07, 0.6368E-07, &
170 0.6148E-07, 0.5998E-07, 0.5859E-07, 0.5720E-07, 0.5582E-07, &
171 0.5457E-07, 0.5339E-07, 0.5224E-07, 0.5110E-07, 0.4999E-07/
173 !--------------------------------------------------------------------------------
174 ! data set 2
175 ! mid-latitude winter (75 levels) : p(mb) o3(g/g)
176 ! surface temp = 272.2
177 !
178 data (pres(i,2),i=1,np)/ &
179 0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
180 0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
181 0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
182 0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
183 0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
184 4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
185 31.5105, 44.2001, 62.0000, 85.9000, 109.8000, 133.7000, &
186 157.6000, 181.5000, 205.4000, 229.3000, 253.2000, 277.1000, &
187 301.0000, 324.9000, 348.8000, 372.7000, 396.6000, 420.5000, &
188 444.4000, 468.3000, 492.2000, 516.1000, 540.0000, 563.9000, &
189 587.8000, 611.7000, 635.6000, 659.5000, 683.4000, 707.3000, &
190 731.2000, 755.1000, 779.0000, 802.9000, 826.8000, 850.7000, &
191 874.6000, 898.5000, 922.4000, 946.3000, 970.2000, 994.1000, &
192 1018.0000/
193 !
194 data (ozone(i,2),i=1,np)/ &
195 0.2353E-06, 0.3054E-06, 0.3771E-06, 0.4498E-06, 0.5236E-06, &
196 0.5984E-06, 0.6742E-06, 0.7511E-06, 0.8290E-06, 0.9080E-06, &
197 0.9881E-06, 0.1069E-05, 0.1152E-05, 0.1319E-05, 0.1725E-05, &
198 0.2145E-05, 0.2581E-05, 0.3031E-05, 0.3497E-05, 0.3980E-05, &
199 0.4478E-05, 0.5300E-05, 0.6725E-05, 0.8415E-05, 0.1035E-04, &
200 0.1141E-04, 0.1155E-04, 0.1143E-04, 0.1093E-04, 0.1060E-04, &
201 0.9720E-05, 0.8849E-05, 0.7424E-05, 0.6023E-05, 0.4310E-05, &
202 0.2820E-05, 0.1990E-05, 0.1518E-05, 0.1206E-05, 0.9370E-06, &
203 0.7177E-06, 0.5450E-06, 0.4131E-06, 0.3277E-06, 0.2563E-06, &
204 0.2120E-06, 0.1711E-06, 0.1524E-06, 0.1344E-06, 0.1199E-06, &
205 0.1066E-06, 0.9516E-07, 0.8858E-07, 0.8219E-07, 0.7598E-07, &
206 0.6992E-07, 0.6403E-07, 0.5887E-07, 0.5712E-07, 0.5540E-07, &
207 0.5370E-07, 0.5214E-07, 0.5069E-07, 0.4926E-07, 0.4785E-07, &
208 0.4713E-07, 0.4694E-07, 0.4676E-07, 0.4658E-07, 0.4641E-07, &
209 0.4634E-07, 0.4627E-07, 0.4619E-07, 0.4612E-07, 0.4605E-07/
212 !--------------------------------------------------------------------------------
213 ! data set 3
214 ! sub-arctic summer (75 levels) : p(mb) o3(g/g)
215 ! surface temp = 287.0
216 !
217 data (pres(i,3),i=1,np)/ &
218 0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
219 0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
220 0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
221 0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
222 0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
223 4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
224 31.5105, 44.2001, 62.0000, 85.7000, 109.4000, 133.1000, &
225 156.8000, 180.5000, 204.2000, 227.9000, 251.6000, 275.3000, &
226 299.0000, 322.7000, 346.4000, 370.1000, 393.8000, 417.5000, &
227 441.2000, 464.9000, 488.6000, 512.3000, 536.0000, 559.7000, &
228 583.4000, 607.1000, 630.8000, 654.5000, 678.2000, 701.9000, &
229 725.6000, 749.3000, 773.0000, 796.7000, 820.4000, 844.1000, &
230 867.8000, 891.5000, 915.2000, 938.9000, 962.6000, 986.3000, &
231 1010.0000/
232 !
233 data (ozone(i,3),i=1,np)/ &
234 0.1728E-06, 0.2131E-06, 0.2537E-06, 0.2944E-06, 0.3353E-06, &
235 0.3764E-06, 0.4176E-06, 0.4590E-06, 0.5006E-06, 0.5423E-06, &
236 0.5842E-06, 0.6263E-06, 0.6685E-06, 0.7112E-06, 0.7631E-06, &
237 0.1040E-05, 0.1340E-05, 0.1660E-05, 0.2001E-05, 0.2362E-05, &
238 0.2746E-05, 0.3153E-05, 0.3762E-05, 0.4988E-05, 0.6518E-05, &
239 0.8352E-05, 0.9328E-05, 0.9731E-05, 0.8985E-05, 0.7632E-05, &
240 0.6814E-05, 0.6384E-05, 0.5718E-05, 0.4728E-05, 0.4136E-05, &
241 0.3033E-05, 0.2000E-05, 0.1486E-05, 0.1121E-05, 0.8680E-06, &
242 0.6474E-06, 0.5164E-06, 0.3921E-06, 0.2996E-06, 0.2562E-06, &
243 0.2139E-06, 0.1723E-06, 0.1460E-06, 0.1360E-06, 0.1267E-06, &
244 0.1189E-06, 0.1114E-06, 0.1040E-06, 0.9678E-07, 0.8969E-07, &
245 0.8468E-07, 0.8025E-07, 0.7590E-07, 0.7250E-07, 0.6969E-07, &
246 0.6694E-07, 0.6429E-07, 0.6208E-07, 0.5991E-07, 0.5778E-07, &
247 0.5575E-07, 0.5403E-07, 0.5233E-07, 0.5067E-07, 0.4904E-07, &
248 0.4721E-07, 0.4535E-07, 0.4353E-07, 0.4173E-07, 0.3997E-07/
251 !--------------------------------------------------------------------------------
252 ! data set 4
253 ! sub-arctic winter (75 levels) : p(mb) o3(g/g)
254 ! surface temp = 257.1
255 !
256 data (pres(i,4),i=1,np)/ &
257 0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
258 0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
259 0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
260 0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
261 0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
262 4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
263 31.5105, 44.2001, 62.0000, 85.7750, 109.5500, 133.3250, &
264 157.1000, 180.8750, 204.6500, 228.4250, 252.2000, 275.9750, &
265 299.7500, 323.5250, 347.3000, 371.0750, 394.8500, 418.6250, &
266 442.4000, 466.1750, 489.9500, 513.7250, 537.5000, 561.2750, &
267 585.0500, 608.8250, 632.6000, 656.3750, 680.1500, 703.9250, &
268 727.7000, 751.4750, 775.2500, 799.0250, 822.8000, 846.5750, &
269 870.3500, 894.1250, 917.9000, 941.6750, 965.4500, 989.2250, &
270 1013.0000/
271 !
272 data (ozone(i,4),i=1,np)/ &
273 0.2683E-06, 0.3562E-06, 0.4464E-06, 0.5387E-06, 0.6333E-06, &
274 0.7301E-06, 0.8291E-06, 0.9306E-06, 0.1034E-05, 0.1140E-05, &
275 0.1249E-05, 0.1360E-05, 0.1474E-05, 0.1855E-05, 0.2357E-05, &
276 0.2866E-05, 0.3383E-05, 0.3906E-05, 0.4437E-05, 0.4975E-05, &
277 0.5513E-05, 0.6815E-05, 0.8157E-05, 0.1008E-04, 0.1200E-04, &
278 0.1242E-04, 0.1250E-04, 0.1157E-04, 0.1010E-04, 0.9063E-05, &
279 0.8836E-05, 0.8632E-05, 0.8391E-05, 0.7224E-05, 0.6054E-05, &
280 0.4503E-05, 0.3204E-05, 0.2278E-05, 0.1833E-05, 0.1433E-05, &
281 0.9996E-06, 0.7440E-06, 0.5471E-06, 0.3944E-06, 0.2852E-06, &
282 0.1977E-06, 0.1559E-06, 0.1333E-06, 0.1126E-06, 0.9441E-07, &
283 0.7678E-07, 0.7054E-07, 0.6684E-07, 0.6323E-07, 0.6028E-07, &
284 0.5746E-07, 0.5468E-07, 0.5227E-07, 0.5006E-07, 0.4789E-07, &
285 0.4576E-07, 0.4402E-07, 0.4230E-07, 0.4062E-07, 0.3897E-07, &
286 0.3793E-07, 0.3697E-07, 0.3602E-07, 0.3506E-07, 0.3413E-07, &
287 0.3326E-07, 0.3239E-07, 0.3153E-07, 0.3069E-07, 0.2987E-07/
289 !--------------------------------------------------------------------------------
290 ! data set 5
291 ! tropical (75 levels) : p(mb) o3(g/g)
292 ! surface temp = 300.0
293 !
294 data (pres(i,5),i=1,np)/ &
295 0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
296 0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
297 0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
298 0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
299 0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
300 4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
301 31.5105, 44.2001, 62.0000, 85.7750, 109.5500, 133.3250, &
302 157.1000, 180.8750, 204.6500, 228.4250, 252.2000, 275.9750, &
303 299.7500, 323.5250, 347.3000, 371.0750, 394.8500, 418.6250, &
304 442.4000, 466.1750, 489.9500, 513.7250, 537.5000, 561.2750, &
305 585.0500, 608.8250, 632.6000, 656.3750, 680.1500, 703.9250, &
306 727.7000, 751.4750, 775.2500, 799.0250, 822.8000, 846.5750, &
307 870.3500, 894.1250, 917.9000, 941.6750, 965.4500, 989.2250, &
308 1013.0000/
309 !
310 data (ozone(i,5),i=1,np)/ &
311 0.1993E-06, 0.2521E-06, 0.3051E-06, 0.3585E-06, 0.4121E-06, &
312 0.4661E-06, 0.5203E-06, 0.5748E-06, 0.6296E-06, 0.6847E-06, &
313 0.7402E-06, 0.7959E-06, 0.8519E-06, 0.9096E-06, 0.1125E-05, &
314 0.1450E-05, 0.1794E-05, 0.2156E-05, 0.2538E-05, 0.2939E-05, &
315 0.3362E-05, 0.3785E-05, 0.4753E-05, 0.6005E-05, 0.7804E-05, &
316 0.9635E-05, 0.1023E-04, 0.1067E-04, 0.1177E-04, 0.1290E-04, &
317 0.1134E-04, 0.9223E-05, 0.6667E-05, 0.3644E-05, 0.1545E-05, &
318 0.5355E-06, 0.2523E-06, 0.2062E-06, 0.1734E-06, 0.1548E-06, &
319 0.1360E-06, 0.1204E-06, 0.1074E-06, 0.9707E-07, 0.8960E-07, &
320 0.8419E-07, 0.7962E-07, 0.7542E-07, 0.7290E-07, 0.7109E-07, &
321 0.6940E-07, 0.6786E-07, 0.6635E-07, 0.6500E-07, 0.6370E-07, &
322 0.6244E-07, 0.6132E-07, 0.6022E-07, 0.5914E-07, 0.5884E-07, &
323 0.5855E-07, 0.5823E-07, 0.5772E-07, 0.5703E-07, 0.5635E-07, &
324 0.5570E-07, 0.5492E-07, 0.5412E-07, 0.5335E-07, 0.5260E-07, &
325 0.5167E-07, 0.5063E-07, 0.4961E-07, 0.4860E-07, 0.4761E-07/
327 end module module_ozone
329 !---------------------- begin ice block data ---------------------------
330 ! block data ice0
331 module ice0
332 !c *********************************************************************
333 !c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
334 !c calculate the extiction coefficient (1/m) and single scattering
335 !c albedo, cps and dps are empirical coefficients of Eq. (2.13) to
336 !c compute the expansion coefficients of the phase function (1, 2,
337 !c 3, 4) in the solar bands, cpir is the empirical coefficients of
338 !c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
339 !c and Liou, 1992). The units of mean effective size and ice water
340 !c content are um and g/m*m*m, respectively, in these equations.
341 !c *********************************************************************
342 !# include "para.file"
343 USE PARA_FILE
344 ! common /ic0/ ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
345 ! cpir(4,mbir)
346 implicit none
347 real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
348 & cpir(4,mbir)
349 data ap /-6.656e-3, 3.686, 0.00, &
350 & -6.656e-3, 3.686, 0.00, &
351 & -6.656e-3, 3.686, 0.00, &
352 & -6.656e-3, 3.686, 0.00, &
353 & -6.656e-3, 3.686, 0.00, &
354 & -6.656e-3, 3.686, 0.00, &
355 & -7.770e-3, 3.734, 11.85, &
356 & -8.088e-3, 3.717, 17.17, &
357 & -8.441e-3, 3.715, 19.48, &
358 & -9.061e-3, 3.741, 26.48, &
359 & -9.609e-3, 3.768, 34.11, &
360 & -1.153e-2, 4.109, 17.32, &
361 & -8.294e-3, 3.925, 1.315, &
362 & -1.026e-2, 4.105, 16.36, &
363 & -1.151e-2, 4.182, 31.13, &
364 & -1.704e-2, 4.830, 16.27, &
365 & -1.741e-2, 5.541, -58.42, &
366 & -7.752e-3, 4.624, -42.01 /
367 data bp /.10998E-05, -.26101E-07, .10896E-08, -.47387E-11, &
368 & .20208E-04, .96483E-05, .83009E-07, -.32217E-09, &
369 & .13590E-03, .73453E-03, .28281E-05, -.18272E-07, &
370 & -.16598E-02, .20933E-02, -.13977E-05, -.18703E-07, &
371 & .46180E+00, .24471E-03, -.27839E-05, .10379E-07, &
372 & .42362E-01, .86425E-02, -.75519E-04, .24056E-06, &
373 & .19960E+00, .37800E-02, -.14910E-04, .00000E+00, &
374 & .30140E+00, .26390E-02, -.11160E-04, .00000E+00, &
375 & .39080E+00, .12720E-02, -.55640E-05, .00000E+00, &
376 & .31050E+00, .26030E-02, -.11390E-04, .00000E+00, &
377 & .20370E+00, .42470E-02, -.18100E-04, .00000E+00, &
378 & .23070E+00, .38300E-02, -.16160E-04, .00000E+00, &
379 & .56310E+00, -.14340E-02, .62980E-05, .00000E+00, &
380 & .52070E+00, -.97780E-03, .37250E-05, .00000E+00, &
381 & .32540E+00, .34340E-02, -.30810E-04, .91430E-07, &
382 & .10280E+00, .50190E-02, -.20240E-04, .00000E+00, &
383 & .39640E+00, -.31550E-02, .64170E-04, -.29790E-06, &
384 & .80790E+00, -.70040E-02, .52090E-04, -.14250E-06 /
385 data cps / .22110E+01, -.10398E-02, .65199E-04, -.34498E-06, &
386 & .32201E+01, .94227E-03, .80947E-04, -.47428E-06, &
387 & .41610E+01, .74396E-03, .82690E-04, -.45251E-06, &
388 & .51379E+01, .51545E-02, .11881E-04, -.15556E-06, &
389 & .22151E+01, -.77982E-03, .63750E-04, -.34466E-06, &
390 & .31727E+01, .15597E-02, .82021E-04, -.49665E-06, &
391 & .40672E+01, .25800E-02, .71550E-04, -.43051E-06, &
392 & .49882E+01, .86489E-02, -.18318E-04, -.59275E-07, &
393 & .22376E+01, .10293E-02, .50842E-04, -.30135E-06, &
394 & .31549E+01, .47115E-02, .70684E-04, -.47622E-06, &
395 & .39917E+01, .82830E-02, .53927E-04, -.41778E-06, &
396 & .48496E+01, .15998E-01, -.39320E-04, -.43862E-07, &
397 & .23012E+01, .33854E-02, .23528E-04, -.20068E-06, &
398 & .31730E+01, .93439E-02, .36367E-04, -.38390E-06, &
399 & .39298E+01, .16424E-01, .10502E-04, -.35086E-06, &
400 & .47226E+01, .25872E-01, -.77542E-04, -.21999E-07, &
401 & .27975E+01, .29741E-02, -.32344E-04, .11636E-06, &
402 & .43532E+01, .11234E-01, -.12081E-03, .43435E-06, &
403 & .56835E+01, .24681E-01, -.26480E-03, .95314E-06, &
404 & .68271E+01, .42788E-01, -.45615E-03, .16368E-05, &
405 & .19655E+01, .20094E-01, -.17067E-03, .50806E-06, &
406 & .28803E+01, .36091E-01, -.28365E-03, .79656E-06, &
407 & .34613E+01, .58525E-01, -.46455E-03, .13444E-05, &
408 & .39568E+01, .81480E-01, -.64777E-03, .19022E-05 /
409 data dps / .12495E+00, -.43582E-03, .14092E-04, -.69565E-07,&
410 & .12363E+00, -.44419E-03, .14038E-04, -.68851E-07,&
411 & .12117E+00, -.48474E-03, .12495E-04, -.62411E-07,&
412 & .11581E+00, -.55031E-03, .98776E-05, -.50193E-07,&
413 & -.15968E-03, .10115E-04, -.12472E-06, .48667E-09,&
414 & .13830E+00, -.18921E-02, .12030E-04, -.31698E-07 /
415 data cpir / .79550, 2.524e-3, -1.022e-5, 0.000e+0,&
416 & .86010, 1.599e-3, -6.465e-6, 0.000e+0,&
417 & .89150, 1.060e-3, -4.171e-6, 0.000e+0,&
418 & .87650, 1.198e-3, -4.485e-6, 0.000e+0,&
419 & .88150, 9.858e-4, -3.116e-6, 0.000e+0,&
420 & .91670, 5.499e-4, -1.507e-6, 0.000e+0,&
421 & .90920, 9.295e-4, -3.877e-6, 0.000e+0,&
422 & .84540, 1.429e-3, -5.859e-6, 0.000e+0,&
423 & .76780, 2.571e-3, -1.041e-5, 0.000e+0,&
424 & .72900, 2.132e-3, -5.584e-6, 0.000e+0,&
425 & .70240, 4.581e-3, -3.054e-5, 6.684e-8,&
426 & .22920, 1.724e-2, -1.573e-4, 4.995e-7 /
427 ! end
428 end module ice0
430 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
431 !C---- new coefficients for ice parameterization by Feng Zhang
432 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
433 ! block data ice1
434 MODULE ice1
435 !c *********************************************************************
436 !c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
437 !c calculate the extiction coefficient (1/m) and single scattering
438 !c albedo, cps are empirical coefficients of Eq. (2.13) to
439 !c compute the expansion coefficients of the phase function (1, 2, &
440 !c 3, 4) in the solar bands, cpir is the empirical coefficients of
441 !c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
442 !c and Liou, 1992). The units of mean effective size and ice water
443 !c content are um and g/m*m*m, respectively, in these equations.
444 !c *********************************************************************
445 !# include "para.file"
446 USE PARA_FILE
447 !c changed by Z.F.
448 ! common /ic1/ ap(3,mb), bp(4,mb), cps(4,4,mbs),&
449 ! cpir(4,mbir)
450 !c changing over
451 implicit none
452 real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs),&
453 & cpir(4,mbir)
455 data ap / &
456 !c changed by Z.F.
457 & -0.67163E-03, 0.33056E+01,0.0,&
458 & 0.25307E-03, 0.32490E+01,0.0,&
459 & -0.75524E-03, 0.33083E+01,0.0,&
460 & -0.20332E-02, 0.33865E+01,0.0,&
461 & 0.40939E-02, 0.29870E+01,0.0,&
462 & -0.27583E-02, 0.34436E+01,0.0,&
463 !c changing over
464 & -7.770e-3, 3.734, 11.85,&
465 & -8.088e-3, 3.717, 17.17,&
466 & -8.441e-3, 3.715, 19.48,&
467 & -9.061e-3, 3.741, 26.48,&
468 !c-- changed by Z.F. for the windows domain in longwave spectral.^M
469 & 0.160239, 0.495375, -4.38738,&
470 & 0.165637, -0.438836, 1.54020,&
471 & 0.172217, -1.49513, 10.56623,&
472 !c changing over
473 !C-- old ones
474 !c 1 -9.609e-3, 3.768, 34.11, &
475 !c 1 -1.153e-2, 4.109, 17.32, &
476 !c 1 -8.294e-3, 3.925, 1.315, &
477 !c-- over
478 & -1.026e-2, 4.105, 16.36,&
479 & -1.151e-2, 4.182, 31.13,&
480 & -1.704e-2, 4.830, 16.27,&
481 & -1.741e-2, 5.541, -58.42,&
482 & -7.752e-3, 4.624, -42.01 /
483 data bp / &
484 !c changed by Z.F.
485 & -0.14661E-06, 0.79495E-07,-0.10422E-09, 0.40232E-12,&
486 & -0.15417E-05, 0.11489E-04,-0.77147E-08, 0.22160E-10,&
487 & -0.13287E-02, 0.91493E-03,-0.39410E-05, 0.12610E-07,&
488 & -0.21311E-02, 0.22827E-02,-0.13400E-04, 0.42169E-07,&
489 & 0.22764E+00, 0.21902E-02,-0.16743E-04, 0.53032E-07,&
490 & 0.59555E-01, 0.73777E-02,-0.66056E-04, 0.21750E-06,&
491 !c changing over
492 & .19960E+00, .37800E-02, -.14910E-04, .00000E+00,&
493 & .30140E+00, .26390E-02, -.11160E-04, .00000E+00,&
494 & .39080E+00, .12720E-02, -.55640E-05, .00000E+00,&
495 & .31050E+00, .26030E-02, -.11390E-04, .00000E+00,&
496 !c-- changed by Z.F. for the windows domain in longwave spectral.
497 & 0.236894, 2.10402E-03, -3.72955E-06, 0.0,&
498 & 0.315225, 9.38232E-04, 1.50649E-06, 0.0,&
499 & 0.605243, -3.92611E-03, 2.12776E-05, 0.0,&
500 !c-- changed over
502 !C-- old
503 !c 1 .20370E+00, .42470E-02, -.18100E-04, .00000E+00, &
504 !c 1 .23070E+00, .38300E-02, -.16160E-04, .00000E+00, &
505 !c 1 .56310E+00, -.14340E-02, .62980E-05, .00000E+00, &
506 !C-- over
507 & .52070E+00, -.97780E-03, .37250E-05, .00000E+00,&
508 & .32540E+00, .34340E-02, -.30810E-04, .91430E-07,&
509 & .10280E+00, .50190E-02, -.20240E-04, .00000E+00,&
510 & .39640E+00, -.31550E-02, .64170E-04, -.29790E-06,&
511 & .80790E+00, -.70040E-02, .52090E-04, -.14250E-06 /
512 data cps / &
513 !c changed by Z.F.
514 & 0.21669E+01, 0.60980E-02,-0.51311E-04, 0.16359E-06,&
515 & 0.31475E+01, 0.13021E-01,-0.11601E-03, 0.39174E-06,&
516 & 0.39659E+01, 0.19928E-01,-0.17921E-03, 0.61170E-06,&
517 & 0.47800E+01, 0.27383E-01,-0.25550E-03, 0.89151E-06,&
518 & 0.21239E+01, 0.77499E-02,-0.67918E-04, 0.22104E-06,&
519 & 0.29759E+01, 0.17892E-01,-0.16332E-03, 0.55093E-06,&
520 & 0.36695E+01, 0.28083E-01,-0.25791E-03, 0.87487E-06,&
521 & 0.43547E+01, 0.38785E-01,-0.36448E-03, 0.12530E-05,&
522 & 0.20993E+01, 0.96178E-02,-0.80757E-04, 0.26200E-06,&
523 & 0.28430E+01, 0.22690E-01,-0.19531E-03, 0.64687E-06,&
524 & 0.34225E+01, 0.36169E-01,-0.31196E-03, 0.10358E-05,&
525 & 0.39823E+01, 0.50008E-01,-0.43848E-03, 0.14699E-05,&
526 & 0.21425E+01, 0.11157E-01,-0.95207E-04, 0.31235E-06,&
527 & 0.28169E+01, 0.26990E-01,-0.22856E-03, 0.75086E-06,&
528 & 0.33128E+01, 0.43749E-01,-0.36819E-03, 0.12080E-05,&
529 & 0.37561E+01, 0.61160E-01,-0.51896E-03, 0.17125E-05,&
530 & 0.24200E+01, 0.10132E-01,-0.10016E-03, 0.34703E-06,&
531 & 0.33717E+01, 0.28367E-01,-0.27592E-03, 0.94834E-06,&
532 & 0.40569E+01, 0.50860E-01,-0.49069E-03, 0.16791E-05,&
533 & 0.45865E+01, 0.76301E-01,-0.73397E-03, 0.25063E-05,&
534 & 0.18487E+01, 0.21654E-01,-0.19873E-03, 0.65778E-06,&
535 & 0.24532E+01, 0.45341E-01,-0.40790E-03, 0.13452E-05,&
536 & 0.28329E+01, 0.71119E-01,-0.62733E-03, 0.20535E-05,&
537 & 0.31031E+01, 0.98340E-01,-0.86055E-03, 0.28151E-05/
538 !c changed over.
539 data cpir / .79550, 2.524e-3, -1.022e-5, 0.000e+0,&
540 & .86010, 1.599e-3, -6.465e-6, 0.000e+0,&
541 & .89150, 1.060e-3, -4.171e-6, 0.000e+0,&
542 & .87650, 1.198e-3, -4.485e-6, 0.000e+0,&
543 !c-- changed by Z.F. for the windows domain in longwave spectral.
544 & 0.884846, 7.52769E-05, 4.57733E-06, 0.0,&
545 & 0.901327, 2.03758E-04, 2.95010E-06, 0.0,&
546 & 0.873900, 1.45318E-03, -6.30462E-06, 0.0,&
547 !c-- changed over.
549 !C-- old
550 !c 1 .88150, 9.858e-4, -3.116e-6, 0.000e+0, &
551 !c 1 .91670, 5.499e-4, -1.507e-6, 0.000e+0, &
552 !c 1 .90920, 9.295e-4, -3.877e-6, 0.000e+0, &
553 !C--
554 & .84540, 1.429e-3, -5.859e-6, 0.000e+0,&
555 & .76780, 2.571e-3, -1.041e-5, 0.000e+0,&
556 & .72900, 2.132e-3, -5.584e-6, 0.000e+0,&
557 & .70240, 4.581e-3, -3.054e-5, 6.684e-8,&
558 & .22920, 1.724e-2, -1.573e-4, 4.995e-7 /
559 end module ice1
561 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
562 !C---- new coefficients for ice parameterization by Qing Yue
563 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
564 ! block data ice2
565 module ice2
566 !c *********************************************************************
567 !c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
568 !c calculate the extiction coefficient (1/m) and single scattering
569 !c albedo, cps are empirical coefficients of Eq. (2.13) to
570 !c compute the expansion coefficients of the phase function (1, 2, &
571 !c 3, 4) in the solar bands, cpir is the empirical coefficients of
572 !c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
573 !c and Liou, 1992). The units of mean effective size and ice water
574 !c content are um and g/m*m*m, respectively, in these equations.
575 !c *********************************************************************
576 !# include "para.file"
577 USE PARA_FILE
578 ! common /ic2/ ap(3,mb), bp(4,mb), cps(4,4,mbs), &
579 ! cpir(4,mbir)
580 implicit none
581 real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), &
582 & cpir(4,mbir)
583 data ap / &
584 !C--- solar bands
585 & -0.64677E-03, 0.33011E+01,0.0,&
586 & 0.23815E-03, 0.32478E+01,0.0,&
587 & -0.77298E-03, 0.33016E+01,0.0,&
588 & -0.19129E-02, 0.33670E+01,0.0,&
589 & 0.38836E-02, 0.29973E+01,0.0,&
590 & -0.25061E-02, 0.34079E+01,0.0,&
591 !c--- IR bands
592 & -0.72292E-02, 0.39678E+01,-0.46245E+01,&
593 & -0.67346E-02, 0.39617E+01,-0.79098E+01,&
594 & -0.47141E-02, 0.38009E+01,-0.81660E+01,&
595 & -0.56489E-02, 0.38568E+01,-0.10588E+02,&
596 & -0.33227E-02, 0.37198E+01,-0.13477E+02,&
597 & 0.19701E-02, 0.31871E+01,-0.14325E+02,&
598 & 0.37022E-02, 0.28155E+01,-0.79752E+01,&
599 & -0.35191E-02, 0.37224E+01,-0.83436E+01,&
600 & -0.34959E-02, 0.38216E+01,-0.13755E+02,&
601 & 0.20353E-02, 0.33879E+01,-0.18617E+02,&
602 & 0.16361E-01, 0.17992E+01,-0.11970E+02,&
603 & 0.14346E-01, 0.19940E+01,-0.10167E+02/
605 data bp / &
606 !c--- solar bands
607 & -0.15305E-06, 0.78389E-07,-0.93003E-10, 0.34497E-12,&
608 & -0.15038E-05, 0.11493E-04,-0.92019E-08, 0.29366E-10,&
609 & -0.10781E-02, 0.90739E-03,-0.41236E-05, 0.14202E-07,&
610 & -0.10333E-02, 0.22434E-02,-0.13639E-04, 0.45620E-07,&
611 & 0.22894E+00, 0.21857E-02,-0.17349E-04, 0.57582E-07,&
612 & 0.68828E-01, 0.69573E-02,-0.62363E-04, 0.20979E-06,&
613 !c--- IR bands
614 & 0.59839E-01, 0.75571E-02,-0.68839E-04, 0.23079E-06,&
615 & 0.13450E+00, 0.72025E-02,-0.68179E-04, 0.22822E-06,&
616 & 0.28174E+00, 0.42956E-02,-0.40260E-04, 0.12953E-06,&
617 & 0.24245E+00, 0.48477E-02,-0.43431E-04, 0.13681E-06,&
618 & 0.21341E+00, 0.46168E-02,-0.37410E-04, 0.11202E-06,&
619 & 0.32426E+00, 0.11704E-02, 0.24626E-05,-0.33332E-07,&
620 & 0.70501E+00,-0.66540E-02, 0.71716E-04,-0.25446E-06,&
621 & 0.55066E+00,-0.23799E-02, 0.23737E-04,-0.81566E-07,&
622 & 0.35188E+00, 0.18514E-02,-0.12929E-04, 0.30513E-07,&
623 & 0.21492E+00, 0.14011E-02, 0.29171E-05,-0.30313E-07,&
624 & 0.42357E+00,-0.49128E-02, 0.70966E-04,-0.27077E-06,&
625 & 0.87266E+00,-0.11806E-01, 0.12572E-03,-0.44277E-06/
627 data cps /&
628 !c-- solar bands
629 & 0.21950E+01, 0.64077E-02,-0.58201E-04, 0.19809E-06,&
630 & 0.31750E+01, 0.13464E-01,-0.12124E-03, 0.41560E-06,&
631 & 0.40066E+01, 0.20698E-01,-0.18702E-03, 0.64513E-06,&
632 & 0.48109E+01, 0.28022E-01,-0.25505E-03, 0.88452E-06,&
633 & 0.21409E+01, 0.83265E-02,-0.77257E-04, 0.26333E-06,&
634 & 0.29819E+01, 0.19038E-01,-0.17613E-03, 0.60173E-06,&
635 & 0.36742E+01, 0.29982E-01,-0.27781E-03, 0.95121E-06,&
636 & 0.43428E+01, 0.40884E-01,-0.38049E-03, 0.13067E-05,&
637 & 0.21134E+01, 0.10157E-01,-0.89914E-04, 0.30549E-06,&
638 & 0.28446E+01, 0.23970E-01,-0.21102E-03, 0.71452E-06,&
639 & 0.34206E+01, 0.38277E-01,-0.33655E-03, 0.11403E-05,&
640 & 0.39634E+01, 0.52522E-01,-0.46311E-03, 0.15716E-05,&
641 & 0.21606E+01, 0.11313E-01,-0.99848E-04, 0.34042E-06,&
642 & 0.28358E+01, 0.27652E-01,-0.23926E-03, 0.80881E-06,&
643 & 0.33357E+01, 0.44943E-01,-0.38565E-03, 0.13007E-05,&
644 & 0.37770E+01, 0.62525E-01,-0.53623E-03, 0.18096E-05,&
645 & 0.24414E+01, 0.96108E-02,-0.95027E-04, 0.33279E-06,&
646 & 0.34245E+01, 0.27146E-01,-0.26426E-03, 0.91883E-06,&
647 & 0.41454E+01, 0.48851E-01,-0.47192E-03, 0.16348E-05,&
648 & 0.47101E+01, 0.73455E-01,-0.70741E-03, 0.24459E-05,&
649 & 0.18737E+01, 0.20963E-01,-0.19401E-03, 0.65811E-06,&
650 & 0.24880E+01, 0.44265E-01,-0.40044E-03, 0.13519E-05,&
651 & 0.29039E+01, 0.69461E-01,-0.61988E-03, 0.20909E-05,&
652 & 0.32145E+01, 0.95849E-01,-0.84973E-03, 0.28707E-05/
654 !c--- IR bands
655 data cpir /&
656 & 0.79895E+00, 0.35846E-02,-0.31820E-04, 0.10048E-06,&
657 & 0.83578E+00, 0.33185E-02,-0.33102E-04, 0.11457E-06,&
658 & 0.84854E+00, 0.33870E-02,-0.34599E-04, 0.11851E-06,&
659 & 0.83022E+00, 0.35984E-02,-0.36656E-04, 0.12776E-06,&
660 & 0.82852E+00, 0.33183E-02,-0.31509E-04, 0.10367E-06,&
661 & 0.84345E+00, 0.35875E-02,-0.37050E-04, 0.12789E-06,&
662 & 0.79099E+00, 0.56487E-02,-0.64916E-04, 0.23789E-06,&
663 & 0.73544E+00, 0.60058E-02,-0.64662E-04, 0.22728E-06,&
664 & 0.68437E+00, 0.71137E-02,-0.73409E-04, 0.25328E-06,&
665 & 0.64675E+00, 0.70088E-02,-0.67836E-04, 0.22898E-06,&
666 & 0.60556E+00, 0.10268E-01,-0.11526E-03, 0.42515E-06,&
667 & 0.34014E+00, 0.18152E-01,-0.20230E-03, 0.72649E-06/
669 end module ice2
671 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
672 !C---- new coefficients for ice parameterization for tropics
673 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
674 ! block data ice3
675 module ice3
676 !c *********************************************************************
677 !c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
678 !c calculate the extiction coefficient (1/m) and single scattering
679 !c albedo, cps are empirical coefficients of Eq. (2.13) to
680 !c compute the expansion coefficients of the phase function (1, 2, &
681 !c 3, 4) in the solar bands, cpir is the empirical coefficients of
682 !c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
683 !c and Liou, 1992). The units of mean effective size and ice water
684 !c content are um and g/m*m*m, respectively, in these equations.
685 !c *********************************************************************
686 !# include "para.file"
687 USE PARA_FILE
688 ! common /ic3/ ap(3,mb), bp(4,mb), cps(4,4,mbs),&
689 ! cpir(4,mbir)
690 implicit none
691 real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs),&
692 & cpir(4,mbir)
693 data ap / &
694 !C--- solar bands
695 & -0.22016E-04, 0.32681E+01,0.0,&
696 & 0.12188E-03, 0.32550E+01,0.0,&
697 & -0.18585E-03, 0.32718E+01,0.0,&
698 & 0.73530E-03, 0.32308E+01,0.0,&
699 & 0.73767E-03, 0.31625E+01,0.0,&
700 & 0.12974E-02, 0.32103E+01,0.0,&
701 !c--- IR bands
702 & -0.12934E-02, 0.34613E+01, 0.40581E+01,&
703 & -0.13767E-02, 0.34660E+01, 0.15185E+01,&
704 & 0.33221E-02, 0.30377E+01, 0.55140E+01,&
705 & 0.29569E-02, 0.31035E+01, 0.34176E+01,&
706 & -0.20300E-03, 0.35017E+01,-0.68412E+01,&
707 & 0.44879E-02, 0.31449E+01,-0.94957E+01,&
708 & 0.39821E-03, 0.29640E+01,-0.63663E+01,&
709 & 0.29569E-02, 0.31035E+01, 0.34176E+01,&
710 & 0.56276E-02, 0.30863E+01, 0.99194E+00,&
711 & 0.67180E-02, 0.31267E+01,-0.99073E+01,&
712 & 0.16936E-02, 0.28752E+01,-0.23543E+02,&
713 & 0.54571E-02, 0.27078E+01,-0.17463E+02/
715 data bp / &
716 !c--- solar bands
717 & 0.16316E-06, 0.54817E-07, 0.36986E-09,-0.22368E-11,&
718 & -0.85219E-06, 0.11496E-04,-0.88702E-08, 0.21682E-10,&
719 & -0.34149E-03, 0.87766E-03,-0.33187E-05, 0.68249E-08,&
720 & 0.26483E-02, 0.21342E-02,-0.11387E-04, 0.25795E-07,&
721 & 0.22760E+00, 0.24953E-02,-0.23548E-04, 0.85937E-07,&
722 & 0.10340E+00, 0.59974E-02,-0.51220E-04, 0.14912E-06,&
723 !c--- IR bands
724 & 0.55175E-01, 0.89243E-02,-0.86399E-04, 0.28587E-06,&
725 & 0.13600E+00, 0.82607E-02,-0.84916E-04, 0.29040E-06,&
726 & 0.28989E+00, 0.47980E-02,-0.50181E-04, 0.17083E-06,&
727 & 0.25460E+00, 0.47274E-02,-0.40477E-04, 0.11072E-06,&
728 & 0.18254E+00, 0.72527E-02,-0.77454E-04, 0.27677E-06,&
729 & 0.25897E+00, 0.50864E-02,-0.55346E-04, 0.20977E-06,&
730 & 0.66416E+00,-0.54835E-02, 0.62850E-04,-0.23567E-06,&
731 & 0.51584E+00,-0.48797E-03,-0.17487E-05, 0.21836E-07,&
732 & 0.30470E+00, 0.50329E-02,-0.59993E-04, 0.23202E-06,&
733 & 0.14576E+00, 0.51099E-02,-0.46454E-04, 0.16438E-06,&
734 & 0.31106E+00, 0.76981E-04, 0.13539E-04,-0.67635E-07,&
735 & 0.82940E+00,-0.10849E-01, 0.12883E-03,-0.49980E-06/
737 data cps / &
738 !c-- solar bands
739 & 0.22527E+01, 0.41826E-02,-0.27863E-04, 0.51918E-07,&
740 & 0.33013E+01, 0.84364E-02,-0.50901E-04, 0.73560E-07,&
741 & 0.42027E+01, 0.12899E-01,-0.78291E-04, 0.12000E-06,&
742 & 0.50756E+01, 0.17483E-01,-0.10792E-03, 0.17462E-06,&
743 & 0.21646E+01, 0.84005E-02,-0.87726E-04, 0.32575E-06,&
744 & 0.30331E+01, 0.19327E-01,-0.20159E-03, 0.75104E-06,&
745 & 0.37486E+01, 0.30803E-01,-0.32426E-03, 0.12203E-05,&
746 & 0.44480E+01, 0.41734E-01,-0.43891E-03, 0.16490E-05,&
747 & 0.21446E+01, 0.95320E-02,-0.84259E-04, 0.26274E-06,&
748 & 0.29123E+01, 0.22681E-01,-0.19885E-03, 0.61148E-06,&
749 & 0.35209E+01, 0.36583E-01,-0.32255E-03, 0.10010E-05,&
750 & 0.41047E+01, 0.49951E-01,-0.43946E-03, 0.13583E-05,&
751 & 0.22211E+01, 0.93276E-02,-0.73117E-04, 0.19007E-06,&
752 & 0.29628E+01, 0.23702E-01,-0.18567E-03, 0.48482E-06,&
753 & 0.35287E+01, 0.39121E-01,-0.30633E-03, 0.80293E-06,&
754 & 0.40513E+01, 0.54047E-01,-0.41858E-03, 0.10766E-05,&
755 & 0.25291E+01, 0.64430E-02,-0.55084E-04, 0.15403E-06,&
756 & 0.36475E+01, 0.19350E-01,-0.16755E-03, 0.47994E-06,&
757 & 0.45208E+01, 0.36084E-01,-0.31598E-03, 0.92179E-06,&
758 & 0.52466E+01, 0.55654E-01,-0.49374E-03, 0.14669E-05,&
759 & 0.20079E+01, 0.16692E-01,-0.13662E-03, 0.33622E-06,&
760 & 0.27495E+01, 0.35998E-01,-0.28704E-03, 0.68874E-06,&
761 & 0.33031E+01, 0.56774E-01,-0.44330E-03, 0.10408E-05,&
762 & 0.37818E+01, 0.77181E-01,-0.58492E-03, 0.13077E-05/
764 !c--- IR bands
765 data cpir / &
766 & 0.78501E+00, 0.36642E-02,-0.32975E-04, 0.10320E-06, &
767 & 0.84318E+00, 0.32789E-02,-0.35798E-04, 0.13097E-06,&
768 & 0.85345E+00, 0.35780E-02,-0.39064E-04, 0.13795E-06,&
769 & 0.84642E+00, 0.29944E-02,-0.29113E-04, 0.94027E-07,&
770 & 0.84123E+00, 0.32419E-02,-0.34203E-04, 0.12155E-06,&
771 & 0.88427E+00, 0.20139E-02,-0.16185E-04, 0.39207E-07,&
772 & 0.84345E+00, 0.35780E-02,-0.39064E-04, 0.13795E-06,&
773 & 0.76728E+00, 0.54533E-02,-0.64807E-04, 0.24744E-06,&
774 & 0.73460E+00, 0.47274E-02,-0.40477E-04, 0.11072E-06,&
775 & 0.71306E+00, 0.37901E-02,-0.31358E-04, 0.98649E-07,&
776 & 0.68108E+00, 0.68342E-02,-0.77162E-04, 0.29712E-06,&
777 & 0.36188E+00, 0.18668E-01,-0.23332E-03, 0.93219E-06/
779 end module ice3
781 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
782 !C---- new coefficients for ice parameterization for midlatitude
783 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
784 ! block data ice4
785 module ice4
786 !c *********************************************************************
787 !c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
788 !c calculate the extiction coefficient (1/m) and single scattering
789 !c albedo, cps are empirical coefficients of Eq. (2.13) to
790 !c compute the expansion coefficients of the phase function (1, 2, &
791 !c 3, 4) in the solar bands, cpir is the empirical coefficients of
792 !c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
793 !c and Liou, 1992). The units of mean effective size and ice water
794 !c content are um and g/m*m*m, respectively, in these equations.
795 !c *********************************************************************
796 !# include "para.file"
797 USE PARA_FILE
798 ! common /ic4/ ap(3,mb), bp(4,mb), cps(4,4,mbs), &
799 ! cpir(4,mbir)
800 implicit none
801 real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), &
802 & cpir(4,mbir)
803 data ap / &
804 !C--- solar bands
805 & -6.94267E-04, 3.31172, 0.0, &
806 & 2.42688E-04, 3.24538, 0.0,&
807 & -8.22686E-04, 3.31108, 0.0,&
808 & -2.12999E-03, 3.41040, 0.0,&
809 & 4.12799E-03, 2.94434, 0.0,&
810 & -2.81017E-03, 3.47101, 0.0,&
811 !c--- IR bands
812 & -0.54779E-02, 0.38141E+01,-0.35115E+01,&
813 & -0.36198E-02, 0.37028E+01,-0.60244E+01,&
814 & -0.12878E-02, 0.35247E+01,-0.61794E+01,&
815 & -0.13401E-02, 0.34879E+01,-0.78947E+01,&
816 & 0.21520E-02, 0.32356E+01,-0.98746E+01,&
817 & 0.90323E-02, 0.25316E+01,-0.94046E+01,&
818 & 0.95264E-02, 0.23578E+01,-0.45991E+01,&
819 & 0.31740E-03, 0.34090E+01,-0.60680E+01,&
820 & 0.25572E-02, 0.32852E+01,-0.97985E+01,&
821 & 0.99831E-02, 0.26650E+01,-0.13217E+02,&
822 & 0.23221E-01, 0.12725E+01,-0.80370E+01,&
823 & 0.19658E-01, 0.15584E+01,-0.68965E+01/
825 data bp / &
826 !c--- solar bands
827 & -1.90654E-07, 7.99431E-08, -1.11983E-10, 4.15792E-13,&
828 & -1.80331E-06, 1.14576E-05, -8.31389E-09, 2.49253E-11,&
829 & -1.26043E-03, 8.91064E-04, -3.69938E-06, 1.20770E-08,&
830 & -2.89280E-03, 2.22542E-03, -1.25859E-05, 3.96889E-08,&
831 & 0.227105 , 2.15505E-03, -1.60964E-05, 5.08333E-08,&
832 & 4.57593E-02, 7.37355E-03, -6.32047E-05, 2.02681E-07,&
833 !c--- IR bands
834 & 0.54473E-01, 0.71064E-02,-0.60728E-04, 0.19806E-06,&
835 & 0.12661E+00, 0.69131E-02,-0.61519E-04, 0.19884E-06,&
836 & 0.27278E+00, 0.41893E-02,-0.36266E-04, 0.10986E-06,&
837 & 0.23686E+00, 0.47057E-02,-0.39838E-04, 0.12117E-06,&
838 & 0.21461E+00, 0.41148E-02,-0.29280E-04, 0.79693E-07,&
839 & 0.33820E+00, 0.50237E-03, 0.10415E-04,-0.60484E-07,&
840 & 0.72475E+00,-0.70319E-02, 0.72574E-04,-0.24826E-06,&
841 & 0.55964E+00,-0.27349E-02, 0.27096E-04,-0.90958E-07,&
842 & 0.35859E+00, 0.13519E-02,-0.65991E-05, 0.77184E-08,&
843 & 0.23389E+00, 0.64041E-03, 0.10444E-04,-0.51927E-07,&
844 & 0.46362E+00,-0.61419E-02, 0.80126E-04,-0.28778E-06,&
845 & 0.89760E+00,-0.12410E-01, 0.12780E-03,-0.43608E-06/
847 data cps / &
848 !c-- solar bands
849 & 2.16219, 7.20717E-03, -6.34955E-05, 2.06684E-07,&
850 & 3.10521, 1.51838E-02, -1.32897E-04, 4.35736E-07,&
851 & 3.89785, 2.33975E-02, -2.05648E-04, 6.78808E-07,&
852 & 4.66416, 3.16646E-02, -2.80302E-04, 9.30739E-07,&
853 & 2.11638, 8.73893E-03, -7.75891E-05, 2.53203E-07,&
854 & 2.92743, 1.99400E-02, -1.76613E-04, 5.78123E-07,&
855 & 3.59051, 3.13439E-02, -2.78084E-04, 9.12872E-07,&
856 & 4.22785, 4.27741E-02, -3.81332E-04, 1.25635E-06,&
857 & 2.09066, 1.04640E-02, -8.85004E-05, 2.87737E-07,&
858 & 2.79526, 2.45527E-02, -2.06207E-04, 6.67845E-07,&
859 & 3.34547, 3.90920E-02, -3.27779E-04, 1.06251E-06,&
860 & 3.85962, 5.36759E-02, -4.51564E-04, 1.46690E-06,&
861 & 2.12392, 1.19818E-02, -1.01064E-04, 3.27937E-07,&
862 & 2.75806, 2.89005E-02, -2.38183E-04, 7.64875E-07,&
863 & 3.21670, 4.67146E-02, -3.81077E-04, 1.21969E-06,&
864 & 3.60999, 6.50332E-02, -5.30308E-04, 1.69843E-06,&
865 & 2.38854, 1.09261E-02, -1.04240E-04, 3.50074E-07,&
866 & 3.28763, 3.04339E-02, -2.85683E-04, 9.52203E-07,&
867 & 3.91175, 5.43371E-02, -5.05866E-04, 1.67954E-06,&
868 & 4.37193, 8.12484E-02, -7.53536E-04, 2.49656E-06,&
869 & 1.79111, 2.24369E-02, -1.96602E-04, 6.30520E-07,&
870 & 2.32802, 4.69355E-02, -4.01338E-04, 1.27852E-06,&
871 & 2.66199, 7.33749E-02, -6.18366E-04, 1.96580E-06,&
872 & 2.87716, 1.01409E-01, -8.49488E-04, 2.70447E-06/
874 !c--- IR bands
875 data cpir / &
876 & 0.80828E+00, 0.35457E-02,-0.32593E-04, 0.10616E-06,&
877 & 0.83099E+00, 0.33684E-02,-0.32271E-04, 0.10833E-06,&
878 & 0.84393E+00, 0.33526E-02,-0.32787E-04, 0.10919E-06,&
879 & 0.82449E+00, 0.36684E-02,-0.36170E-04, 0.12336E-06,&
880 & 0.82025E+00, 0.33894E-02,-0.30349E-04, 0.94896E-07,&
881 & 0.82851E+00, 0.38298E-02,-0.37428E-04, 0.12370E-06,&
882 & 0.77099E+00, 0.60819E-02,-0.67227E-04, 0.23893E-06,&
883 & 0.71680E+00, 0.62920E-02,-0.64410E-04, 0.21714E-06,&
884 & 0.66987E+00, 0.74566E-02,-0.75205E-04, 0.25469E-06,&
885 & 0.62566E+00, 0.77781E-02,-0.73834E-04, 0.24131E-06,&
886 & 0.57878E+00, 0.11177E-01,-0.12254E-03, 0.44038E-06,&
887 & 0.31494E+00, 0.18856E-01,-0.20582E-03, 0.72328E-06/
889 end module ice4
891 !**************************************
892 !c Fu 07-08-98
893 ! block data ice5
894 module ice5
895 !c *********************************************************************
896 !c Following Fu (1996; J. Climate) and Fu et al. (1998; J. Climate), &
897 !c ap is the empirical coefficients of Eq. (3.9a) of Fu (1996) and
898 !c Eq. (3.1) of Fu et al. (1998) to calculate the extiction coefficient
899 !c (1/m). bps is for the single scattering albedo in the solar bands
900 !c (3.9b in Fu) and bpir is for the absorption coefficient (1/m) in the
901 !c IR bands (3.2 in Fu et al.). cp is the empirical coefficients of
902 !c Eq. (3.9c) in Fu or Eq. (3.3) in Fu et al. to compute the asymmetry
903 !c factor of the phase function. dps is the empirical coefficients of
904 !c Eq. (3.9d) of Fu to calculate the forward delta-fraction in the
905 !c solar bands. The units of generalized effective size and ice water
906 !c content are um and g/m**3, respectively, in these equations.
907 !c *********************************************************************
908 !# include "para.file"
909 USE PARA_FILE
910 !c## include 'rad_0698.h'
911 ! common /ic5/ ap(3,mb), bps(4,mbs), bpir(4, mbir), &
912 ! cp(4,mb), dps(4,mbs)
913 implicit none
914 real, save :: ap(3,mb), bps(4,mbs), bpir(4, mbir), &
915 & cp(4,mb), dps(4,mbs)
916 data ap / &
917 & -2.9172062e-05, 2.5192544e+00, 0.0,&
918 & -2.2948980e-05, 2.5212550e+00, 0.0,&
919 & -2.9772840e-04, 2.5400320e+00, 0.0,&
920 & 4.2668223e-04, 2.4933372e+00, 0.0,&
921 & 4.3226531e-04, 2.4642946e+00, 0.0,&
922 & 9.5918990e-05, 2.5232218e+00, 0.0,&
923 & -2.308881e-03, 2.814002e+00, 1.072211e+00,&
924 & -2.465236e-03, 2.833187e+00,-4.227573e-01,&
925 & -3.034573e-03, 2.900043e+00,-1.849911e+00,&
926 & -4.936610e-03, 3.087764e+00,-3.884262e+00,&
927 & -8.178608e-03, 3.401245e+00,-8.812820e+00,&
928 & -8.372696e-03, 3.455018e+00,-1.516692e+01,&
929 & -1.691632e-03, 2.765756e+00,-8.331033e+00,&
930 & -4.159424e-03, 3.047325e+00,-5.061568e+00,&
931 & -9.524174e-03, 3.587742e+00,-1.068895e+01,&
932 & -1.334860e-02, 4.043808e+00,-2.171029e+01,&
933 & 3.325756e-03, 2.601360e+00,-1.909602e+01,&
934 & 4.919685e-03, 2.327741e+00,-1.390858e+01 /
936 data bps / &
937 & 1.3540265e-07, 9.9282217e-08, -7.3843168e-11, 3.3111862e-13,&
938 & -2.1458450e-06, 2.1984010e-05, -4.4225520e-09, 1.0711940e-11,&
939 & 1.4027890e-04, 1.3919010e-03, -5.1005610e-06, 1.4032930e-08,&
940 & 5.7801650e-03, 2.4420420e-03, -1.1985030e-05, 3.3878720e-08,&
941 & 2.7122737e-01, 1.9809794e-03, -1.5071269e-05, 5.0103900e-08,&
942 & 1.6215025e-01, 6.3734393e-03, -5.7740959e-05, 1.9109300e-07 /
944 data bpir / &
945 & 4.346482e-01, 1.721457e-02,-1.623227e-04, 5.561523e-07,&
946 & 7.428957e-01, 1.279601e-02,-1.391803e-04, 5.180104e-07,&
947 & 8.862434e-01, 1.226538e-02,-1.523076e-04, 6.000892e-07,&
948 & 7.152274e-01, 1.621734e-02,-1.868544e-04, 7.078738e-07,&
949 & 5.874323e-01, 1.876628e-02,-2.045834e-04, 7.510080e-07,&
950 & 5.409536e-01, 1.949649e-02,-2.050908e-04, 7.364680e-07,&
951 & 1.195515e+00, 3.350616e-03,-5.266996e-05, 2.233377e-07,&
952 & 1.466481e+00,-2.129226e-03,-1.361630e-05, 1.193649e-07,&
953 & 9.551440e-01, 1.309792e-02,-1.793694e-04, 7.313392e-07,&
954 & 3.003701e-01, 2.051529e-02,-1.931684e-04, 6.583031e-07,&
955 & 2.005578e-01, 2.132614e-02,-1.751052e-04, 5.355885e-07,&
956 & 8.869787e-01, 2.118409e-02,-2.781429e-04, 1.094562e-06 /
958 data cp / &
959 & 7.4812728e-01, 9.5684492e-04, -1.1151708e-06, -8.1557303e-09,&
960 & 7.5212480e-01, 1.1045100e-03, -2.9157100e-06, -1.3429900e-09,&
961 & 7.5320460e-01, 1.8845180e-03, -9.7571460e-06, 2.2428270e-08,&
962 & 7.7381780e-01, 2.2260760e-03, -1.4052790e-05, 3.7896870e-08,&
963 & 8.7020490e-01, 1.6645530e-03, -1.4886030e-05, 4.9867270e-08,&
964 & 7.4212060e-01, 5.2621900e-03, -5.0877550e-05, 1.7307870e-07,&
965 & 7.962716e-01, 3.003488e-03,-2.082376e-05, 5.366545e-08,&
966 & 8.472918e-01, 2.559953e-03,-2.182660e-05, 6.879977e-08,&
967 & 8.741665e-01, 2.455409e-03,-2.456935e-05, 8.641223e-08,&
968 & 8.522816e-01, 2.523627e-03,-2.149196e-05, 6.685067e-08,&
969 & 8.609604e-01, 2.200445e-03,-1.748105e-05, 5.176616e-08,&
970 & 8.906280e-01, 1.903269e-03,-1.733552e-05, 5.855071e-08,&
971 & 8.663385e-01, 2.797934e-03,-3.187011e-05, 1.217209e-07,&
972 & 7.984021e-01, 3.977117e-03,-4.471984e-05, 1.694919e-07,&
973 & 7.363466e-01, 4.798266e-03,-4.513292e-05, 1.525774e-07,&
974 & 7.260484e-01, 2.664334e-03,-1.251136e-05, 2.243377e-08,&
975 & 6.891414e-01, 6.192281e-03,-6.459514e-05, 2.436963e-07,&
976 & 4.949276e-01, 1.186174e-02,-1.267629e-04, 4.603574e-07 /
978 data dps / &
979 & 1.1572963e-01, 2.5648064e-04, 1.9131293e-06, -1.2460341e-08,&
980 & 1.1360752e-01, 2.4156171e-04, 2.0185942e-06, -1.2876106e-08,&
981 & 1.1241170e-01, -1.7635186e-07, 2.1499248e-06, -1.2949304e-08,&
982 & 1.0855775e-01, -3.2496217e-04, 3.4207304e-06, -1.6247759e-08,&
983 & 5.7783360e-02, -4.1158260e-04, 4.2361240e-06, -1.7204950e-08,&
984 & 1.1367129e-01, -1.9711061e-03, 1.6078010e-05, -5.1736898e-08 /
985 !c *********************************************************************
986 end module ice5
988 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
989 !C---- new coefficients for single ice habit parameterization by Feng Zhang
990 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
991 ! block data ice6
992 module ice6
993 !c *********************************************************************
994 !c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
995 !c calculate the extiction coefficient (1/m) and single scattering
996 !c albedo, cps and dps are empirical coefficients of Eq. (2.13) to
997 !c compute the expansion coefficients of the phase function (1, 2, &
998 !c 3, 4) in the solar bands, cpir is the empirical coefficients of
999 !c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
1000 !c and Liou, 1992). The units of mean effective size and ice water
1001 !c content are um and g/m*m*m, respectively, in these equations.
1002 !c for a single habit calculated from Yang's 2000 datasets.
1003 !c *********************************************************************
1004 !# include "para.file"
1005 USE PARA_FILE
1006 ! common /ic6/ ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
1007 ! cpir(4,mbir)
1008 implicit none
1009 real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
1010 & cpir(4,mbir)
1011 data ap / &
1012 & -0.38746E-03, 0.32973E+01,0.0,&
1013 & -0.50694E-03, 0.32985E+01,0.0,&
1014 & 0.71712E-03, 0.32223E+01,0.0,&
1015 & -0.98125E-03, 0.33230E+01,0.0,&
1016 & 0.87834E-03, 0.31841E+01,0.0,&
1017 & -0.34512E-03, 0.32746E+01,0.0,&
1018 & -7.770e-3, 3.734, 11.85,&
1019 & -8.088e-3, 3.717, 17.17,&
1020 & -8.441e-3, 3.715, 19.48,&
1021 & -9.061e-3, 3.741, 26.48,&
1022 & -9.609e-3, 3.768, 34.11,&
1023 & -1.153e-2, 4.109, 17.32,&
1024 & -8.294e-3, 3.925, 1.315,&
1025 & -1.026e-2, 4.105, 16.36,&
1026 & -1.151e-2, 4.182, 31.13,&
1027 & -1.704e-2, 4.830, 16.27,&
1028 & -1.741e-2, 5.541, -58.42,&
1029 & -7.752e-3, 4.624, -42.01 /
1031 data bp / &
1032 & 0.38590E-07, 0.72370E-07, 0.31022E-10,-0.14691E-12,&
1033 & 0.17300E-05, 0.11233E-04, 0.17393E-08,-0.12202E-10,&
1034 & 0.18169E-02, 0.72681E-03,-0.26276E-06,-0.27928E-08,&
1035 & 0.78700E-02, 0.17288E-02,-0.28655E-05,-0.20102E-08,&
1036 & 0.23621E+00, 0.16462E-02,-0.78390E-05, 0.16004E-07,&
1037 & 0.11644E+00, 0.52256E-02,-0.31336E-04, 0.69178E-07,&
1038 & .19960E+00, .37800E-02, -.14910E-04, .00000E+00,&
1039 & .30140E+00, .26390E-02, -.11160E-04, .00000E+00,&
1040 & .39080E+00, .12720E-02, -.55640E-05, .00000E+00,&
1041 & .31050E+00, .26030E-02, -.11390E-04, .00000E+00,&
1042 & .20370E+00, .42470E-02, -.18100E-04, .00000E+00,&
1043 & .23070E+00, .38300E-02, -.16160E-04, .00000E+00,&
1044 & .56310E+00, -.14340E-02, .62980E-05, .00000E+00,&
1045 & .52070E+00, -.97780E-03, .37250E-05, .00000E+00,&
1046 & .32540E+00, .34340E-02, -.30810E-04, .91430E-07,&
1047 & .10280E+00, .50190E-02, -.20240E-04, .00000E+00,&
1048 & .39640E+00, -.31550E-02, .64170E-04, -.29790E-06,&
1049 & .80790E+00, -.70040E-02, .52090E-04, -.14250E-06 /
1051 data cps / &
1052 & 0.21659E+01, 0.22216E-02,-0.59640E-05, 0.16482E-07,&
1053 & 0.31725E+01, 0.52862E-02,-0.23595E-04, 0.68774E-07,&
1054 & 0.39577E+01, 0.91975E-02,-0.59064E-04, 0.18597E-06,&
1055 & 0.48731E+01, 0.13409E-01,-0.10001E-03, 0.29756E-06,&
1056 & 0.21148E+01, 0.35792E-02,-0.14387E-04, 0.33916E-07,&
1057 & 0.29802E+01, 0.86827E-02,-0.43013E-04, 0.10745E-06,&
1058 & 0.36496E+01, 0.14548E-01,-0.88220E-04, 0.24029E-06,&
1059 & 0.44246E+01, 0.21138E-01,-0.14383E-03, 0.38506E-06,&
1060 & 0.21080E+01, 0.45474E-02,-0.12614E-04, 0.13394E-07,&
1061 & 0.28827E+01, 0.10920E-01,-0.38268E-04, 0.62198E-07,&
1062 & 0.34763E+01, 0.18024E-01,-0.76309E-04, 0.15170E-06,&
1063 & 0.41410E+01, 0.26250E-01,-0.13345E-03, 0.29134E-06,&
1064 & 0.21644E+01, 0.60657E-02,-0.23328E-04, 0.37156E-07,&
1065 & 0.28683E+01, 0.14231E-01,-0.52725E-04, 0.81739E-07,&
1066 & 0.34205E+01, 0.22708E-01,-0.86359E-04, 0.13936E-06,&
1067 & 0.39875E+01, 0.32511E-01,-0.14175E-03, 0.26516E-06,&
1068 & 0.24762E+01, 0.57563E-02,-0.37849E-04, 0.95587E-07,&
1069 & 0.34989E+01, 0.16372E-01,-0.10394E-03, 0.25605E-06,&
1070 & 0.42810E+01, 0.29538E-01,-0.18603E-03, 0.45460E-06,&
1071 & 0.49398E+01, 0.44821E-01,-0.28585E-03, 0.70220E-06,&
1072 & 0.19379E+01, 0.14271E-01,-0.83150E-04, 0.17824E-06,&
1073 & 0.26709E+01, 0.29022E-01,-0.15863E-03, 0.32130E-06,&
1074 & 0.31501E+01, 0.45697E-01,-0.23729E-03, 0.45482E-06,&
1075 & 0.35520E+01, 0.63575E-01,-0.32729E-03, 0.62582E-06/
1077 data cpir / .79550, 2.524e-3, -1.022e-5, 0.000e+0,&
1078 & .86010, 1.599e-3, -6.465e-6, 0.000e+0,&
1079 & .89150, 1.060e-3, -4.171e-6, 0.000e+0,&
1080 & .87650, 1.198e-3, -4.485e-6, 0.000e+0,&
1081 & .88150, 9.858e-4, -3.116e-6, 0.000e+0,&
1082 & .91670, 5.499e-4, -1.507e-6, 0.000e+0,&
1083 & .90920, 9.295e-4, -3.877e-6, 0.000e+0,&
1084 & .84540, 1.429e-3, -5.859e-6, 0.000e+0,&
1085 & .76780, 2.571e-3, -1.041e-5, 0.000e+0,&
1086 & .72900, 2.132e-3, -5.584e-6, 0.000e+0,&
1087 & .70240, 4.581e-3, -3.054e-5, 6.684e-8,&
1088 & .22920, 1.724e-2, -1.573e-4, 4.995e-7 /
1090 end module ice6
1092 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
1093 !C---- new coefficients for single habit ice parameterization
1094 !C-----by Qing Yue, 2007. Solar from Yang 2000, IR from Yang 2005
1095 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
1096 ! block data ice7
1097 module ice7
1098 !# include "para.file"
1099 USE PARA_FILE
1100 ! common /ic7/ ap(3,mb), bp(4,mb), cps(4,4,mbs), &
1101 ! cpir(4,mbir)
1102 implicit none
1103 real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), &
1104 & cpir(4,mbir)
1105 data ap / &
1106 !C--- solar bands
1107 & -0.38746E-03, 0.32973E+01,0.0,&
1108 & -0.50694E-03, 0.32985E+01,0.0,&
1109 & 0.71712E-03, 0.32223E+01,0.0,&
1110 & -0.98125E-03, 0.33230E+01,0.0,&
1111 & 0.87834E-03, 0.31841E+01,0.0,&
1112 & -0.34512E-03, 0.32746E+01,0.0,&
1113 !c--- IR bands
1114 & -0.50589E-03, 0.33265E+01, 0.38436E+01,&
1115 & -0.38765E-02, 0.37526E+01,-0.21254E+01,&
1116 & -0.48168E-02, 0.38393E+01,-0.41956E+01,&
1117 & -0.80184E-02, 0.42143E+01,-0.94178E+01,&
1118 & -0.84545E-02, 0.42523E+01,-0.14044E+02,&
1119 & -0.78583E-02, 0.43559E+01,-0.23802E+02,&
1120 & 0.16759E-03, 0.32759E+01,-0.10914E+02,&
1121 & -0.56504E-02, 0.40831E+01,-0.85350E+01,&
1122 & -0.11870E-01, 0.48843E+01,-0.19757E+02,&
1123 & -0.11976E-01, 0.49646E+01,-0.32042E+02,&
1124 & 0.43393E-02, 0.30397E+01,-0.25740E+02,&
1125 & 0.50587E-02, 0.29157E+01,-0.20003E+02/
1127 data bp / &
1128 !c--- solar bands
1129 & 0.38590E-07, 0.72370E-07, 0.31022E-10,-0.14691E-12,&
1130 & 0.17300E-05, 0.11233E-04, 0.17393E-08,-0.12202E-10,&
1131 & 0.18169E-02, 0.72681E-03,-0.26276E-06,-0.27928E-08,&
1132 & 0.78700E-02, 0.17288E-02,-0.28655E-05,-0.20102E-08,&
1133 & 0.23621E+00, 0.16462E-02,-0.78390E-05, 0.16004E-07,&
1134 & 0.11644E+00, 0.52256E-02,-0.31336E-04, 0.69178E-07,&
1135 !c---IR bands
1136 & 0.11837E+00, 0.59707E-02,-0.37381E-04, 0.82247E-07,&
1137 & 0.18890E+00, 0.56695E-02,-0.39054E-04, 0.92022E-07,&
1138 & 0.32556E+00, 0.35682E-02,-0.27697E-04, 0.70817E-07,&
1139 & 0.26624E+00, 0.44710E-02,-0.32194E-04, 0.77848E-07,&
1140 & 0.20286E+00, 0.52926E-02,-0.33796E-04, 0.73155E-07,&
1141 & 0.26761E+00, 0.33641E-02,-0.16682E-04, 0.24691E-07,&
1142 & 0.63681E+00,-0.32014E-02, 0.23511E-04,-0.59634E-07,&
1143 & 0.53407E+00,-0.93014E-03, 0.46540E-05,-0.99015E-08,&
1144 & 0.33019E+00, 0.30715E-02,-0.21409E-04, 0.47927E-07,&
1145 & 0.15758E+00, 0.34101E-02,-0.11554E-04, 0.77336E-08,&
1146 & 0.32540E+00,-0.24775E-03, 0.19549E-04,-0.79449E-07,&
1147 & 0.81081E+00,-0.73585E-02, 0.60735E-04,-0.16801E-06/
1149 data cps / &
1150 !c-- solar bands
1151 & 0.21659E+01, 0.22216E-02,-0.59640E-05, 0.16482E-07,&
1152 & 0.31725E+01, 0.52862E-02,-0.23595E-04, 0.68774E-07,&
1153 & 0.39577E+01, 0.91975E-02,-0.59064E-04, 0.18597E-06,&
1154 & 0.48731E+01, 0.13409E-01,-0.10001E-03, 0.29756E-06,&
1155 & 0.21148E+01, 0.35792E-02,-0.14387E-04, 0.33916E-07,&
1156 & 0.29802E+01, 0.86827E-02,-0.43013E-04, 0.10745E-06,&
1157 & 0.36496E+01, 0.14548E-01,-0.88220E-04, 0.24029E-06,&
1158 & 0.44246E+01, 0.21138E-01,-0.14383E-03, 0.38506E-06,&
1159 & 0.21080E+01, 0.45474E-02,-0.12614E-04, 0.13394E-07,&
1160 & 0.28827E+01, 0.10920E-01,-0.38268E-04, 0.62198E-07,&
1161 & 0.34763E+01, 0.18024E-01,-0.76309E-04, 0.15170E-06,&
1162 & 0.41410E+01, 0.26250E-01,-0.13345E-03, 0.29134E-06,&
1163 & 0.21644E+01, 0.60657E-02,-0.23328E-04, 0.37156E-07,&
1164 & 0.28683E+01, 0.14231E-01,-0.52725E-04, 0.81739E-07,&
1165 & 0.34205E+01, 0.22708E-01,-0.86359E-04, 0.13936E-06,&
1166 & 0.39875E+01, 0.32511E-01,-0.14175E-03, 0.26516E-06,&
1167 & 0.24762E+01, 0.57563E-02,-0.37849E-04, 0.95587E-07,&
1168 & 0.34989E+01, 0.16372E-01,-0.10394E-03, 0.25605E-06,&
1169 & 0.42810E+01, 0.29538E-01,-0.18603E-03, 0.45460E-06,&
1170 & 0.49398E+01, 0.44821E-01,-0.28585E-03, 0.70220E-06,&
1171 & 0.19379E+01, 0.14271E-01,-0.83150E-04, 0.17824E-06,&
1172 & 0.26709E+01, 0.29022E-01,-0.15863E-03, 0.32130E-06,&
1173 & 0.31501E+01, 0.45697E-01,-0.23729E-03, 0.45482E-06,&
1174 & 0.35520E+01, 0.63575E-01,-0.32729E-03, 0.62582E-06/
1176 !c--- IR bands
1177 data cpir / &
1178 & 0.81089E+00, 0.16243E-02,-0.31561E-05,-0.79532E-08,&
1179 & 0.86014E+00, 0.17674E-02,-0.94067E-05, 0.17704E-07,&
1180 & 0.86338E+00, 0.21946E-02,-0.15417E-04, 0.37614E-07,&
1181 & 0.85780E+00, 0.17558E-02,-0.86896E-05, 0.13392E-07,&
1182 & 0.86534E+00, 0.15068E-02,-0.65455E-05, 0.78494E-08,&
1183 & 0.88588E+00, 0.18314E-02,-0.13509E-04, 0.34430E-07,&
1184 & 0.83432E+00, 0.32058E-02,-0.26575E-04, 0.72447E-07,&
1185 & 0.76777E+00, 0.37283E-02,-0.28309E-04, 0.72651E-07,&
1186 & 0.73123E+00, 0.33814E-02,-0.19619E-04, 0.40249E-07,&
1187 & 0.69978E+00, 0.29035E-02,-0.15833E-04, 0.35895E-07,&
1188 & 0.65075E+00, 0.58411E-02,-0.46674E-04, 0.12976E-06,&
1189 & 0.36707E+00, 0.12097E-01,-0.97415E-04, 0.26174E-06/
1191 end module ice7
1194 !CCCCCC---- end of ice block data------------------C
1195 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
1197 ! block data water1
1198 module water1
1199 !c *********************************************************************
1200 !c bz, wz and gz are the extinction coefficient(1/km), single scattering
1201 !c albedo and asymmetry factor for the water clouds (St II, Sc I, St I, &
1202 !c As, Ns, Sc II, Cu, and Cb) in different bands. re is the effective
1203 !c radius and fl is the liquid water content (LWC). See Tables 4.2-4.4
1204 !c of Fu (1991).
1205 !c *********************************************************************
1206 !# include "para.file"
1207 USE PARA_FILE
1208 ! common /wat1/ re(nc), fl(nc), bz(nc,mb), wz(nc,mb), gz(nc,mb)
1209 implicit none
1210 real, save :: re(nc), fl(nc), bz(nc,mb), wz(nc,mb), gz(nc,mb)
1211 data re / 4.18, 5.36, 5.89, 6.16, &
1212 & 9.27, 9.84, 12.10, 31.23 /
1213 data fl / 0.05, 0.14, 0.22, 0.28, &
1214 & 0.50, 0.47, 1.00, 2.50 /
1215 data bz / 15.11, 40.25, 59.81, 72.43,&
1216 & 83.69, 73.99, 128.17, 120.91,&
1217 & 15.74, 41.70, 61.52, 74.47,&
1218 & 85.78, 75.59, 130.46, 121.84,&
1219 & 16.38, 43.52, 64.84, 77.97,&
1220 & 87.31, 77.36, 134.30, 124.06,&
1221 & 17.57, 45.78, 66.44, 80.15,&
1222 & 90.49, 79.90, 137.56, 125.92,&
1223 & 18.19, 46.63, 69.39, 82.20,&
1224 & 91.46, 79.99, 138.21, 126.08,&
1225 & 21.30, 51.88, 77.77, 87.02,&
1226 & 94.91, 83.55, 143.46, 128.45,&
1227 & 22.44, 57.35, 84.41, 103.50,&
1228 & 103.49, 84.17, 152.77, 132.07,&
1229 & 18.32, 52.69, 76.67, 100.31,&
1230 & 105.46, 92.86, 157.82, 133.03,&
1231 & 17.27, 50.44, 74.18, 96.76,&
1232 & 105.32, 95.25, 158.07, 134.48,&
1233 & 13.73, 44.90, 67.70, 90.85,&
1234 & 109.16, 105.48, 163.11, 136.21,&
1235 & 10.30, 36.28, 57.23, 76.43,&
1236 & 106.45, 104.90, 161.73, 136.62,&
1237 & 7.16, 26.40, 43.51, 57.24,&
1238 & 92.55, 90.55, 149.10, 135.13,&
1239 & 6.39, 21.00, 33.81, 43.36,&
1240 & 66.90, 63.58, 113.83, 125.65,&
1241 & 10.33, 30.87, 47.63, 60.33,&
1242 & 79.54, 73.92, 127.46, 128.21,&
1243 & 11.86, 35.64, 54.81, 69.85,&
1244 & 90.39, 84.16, 142.49, 135.25,&
1245 & 10.27, 33.08, 51.81, 67.26,&
1246 & 93.24, 88.60, 148.71, 140.42,&
1247 & 6.72, 24.09, 39.42, 51.68,&
1248 & 83.34, 80.72, 140.14, 143.57,&
1249 & 3.92, 14.76, 25.32, 32.63,&
1250 & 60.85, 58.81, 112.30, 145.62 /
1251 data wz / .999999, .999999, .999999, .999999,&
1252 & .999998, .999999, .999998, .999997,&
1253 & .999753, .999700, .999667, .999646,&
1254 & .999492, .999470, .999344, .998667,&
1255 & .995914, .994967, .994379, .993842,&
1256 & .991385, .990753, .988908, .974831,&
1257 & .983761, .978981, .976568, .974700,&
1258 & .963466, .959934, .953865, .897690,&
1259 & .702949, .683241, .679723, .669045,&
1260 & .642616, .632996, .629776, .588820,&
1261 & .947343, .929619, .924806, .914557,&
1262 & .877169, .867047, .853661, .737426,&
1263 & .919356, .896274, .885924, .881097,&
1264 & .812772, .781637, .775418, .637341,&
1265 & .874717, .861122, .847850, .851677,&
1266 & .787171, .772952, .753143, .618656,&
1267 & .764750, .752410, .736529, .743435,&
1268 & .671272, .659392, .639492, .549941,&
1269 & .807536, .808700, .795994, .805489,&
1270 & .750577, .755524, .709472, .571989,&
1271 & .753346, .772026, .767273, .777079,&
1272 & .751264, .760973, .712536, .568286,&
1273 & .632722, .676332, .684631, .693552,&
1274 & .707986, .717724, .682430, .552867,&
1275 & .288885, .348489, .371653, .380367,&
1276 & .454540, .465769, .475409, .493881,&
1277 & .261827, .306283, .321340, .333051,&
1278 & .392917, .406876, .417450, .484593,&
1279 & .295804, .339929, .352494, .365502,&
1280 & .416229, .430369, .435267, .491356,&
1281 & .301214, .354746, .369346, .381906,&
1282 & .433602, .447397, .447406, .486968,&
1283 & .243714, .318761, .344642, .352770,&
1284 & .427906, .438979, .445972, .477264,&
1285 & .109012, .187230, .226849, .224976,&
1286 & .331382, .335917, .374882, .457067 /
1287 data gz / .838, .839, .844, .847,&
1288 & .849, .860, .853, .859,&
1289 & .809, .810, .819, .823,&
1290 & .823, .849, .833, .843,&
1291 & .774, .787, .781, .792,&
1292 & .812, .836, .815, .833,&
1293 & .801, .802, .793, .793,&
1294 & .814, .829, .818, .832,&
1295 & .877, .873, .879, .880,&
1296 & .885, .899, .891, .908,&
1297 & .783, .769, .777, .756,&
1298 & .764, .776, .770, .797,&
1299 & .818, .805, .824, .830,&
1300 & .815, .801, .820, .845,&
1301 & .810, .802, .826, .840,&
1302 & .829, .853, .840, .868,&
1303 & .774, .766, .799, .818,&
1304 & .815, .869, .834, .869,&
1305 & .734, .728, .767, .797,&
1306 & .796, .871, .818, .854,&
1307 & .693, .688, .736, .772,&
1308 & .780, .880, .808, .846,&
1309 & .643, .646, .698, .741,&
1310 & .759, .882, .793, .839,&
1311 & .564, .582, .637, .690,&
1312 & .719, .871, .764, .819,&
1313 & .466, .494, .546, .609,&
1314 & .651, .823, .701, .766,&
1315 & .375, .410, .455, .525,&
1316 & .583, .773, .637, .710,&
1317 & .262, .301, .334, .406,&
1318 & .485, .695, .545, .631,&
1319 & .144, .181, .200, .256,&
1320 & .352, .562, .413, .517,&
1321 & .060, .077, .088, .112,&
1322 & .181, .310, .222, .327 /
1323 end module water1
1326 ! block data rayle1
1327 module rayle1
1328 !c *********************************************************************
1329 !c ri is the coefficient in Eq.(4.8) of Fu (1991) to compute the optical
1330 !c depth due to Rayleigh scattering in the solar bands.
1331 !c *********************************************************************
1332 !# include "para.file"
1333 USE PARA_FILE
1334 ! common /ray1/ ri(mbs)
1335 implicit none
1336 real, save :: ri(mbs)
1337 data ri / 0.9022e-5, 0.5282e-6, 0.5722e-7, &
1338 & 0.1433e-7, 0.4526e-8, 0.1529e-8 /
1339 end module rayle1
1342 ! block data rain1
1343 module rain1
1344 !c *********************************************************************
1345 !c brn, wrnf and grn are the extinction coefficient (1/km), single
1346 !c scattering albedo and asymmetry factor for the rain. The size
1347 !c distribution of rain is in the form of a truncated constant-slope
1348 !c gamma function (Manton and Cotton, 1977) where rmin = 60 um, rmax =
1349 !c 1800 um, rc = 162 um, density of water = 1 g/cm**3, and rain water
1350 !c content (rwc) = 0.5 g/m**3.
1351 !c Jan. 19, 1993
1352 !c *********************************************************************
1353 !# include "para.file"
1354 USE PARA_FILE
1355 ! common /rai1/ rwc, brn(mb), wrnf(mb), grn(mb)
1356 implicit none
1357 real, save :: rwc, brn(mb), wrnf(mb), grn(mb)
1358 data rwc / 0.5 /
1359 data brn / 1.5377, 1.5377, 1.5379, 1.5385, 1.5396, 1.5417,&
1360 & 1.5454, 1.5478, 1.5512, 1.5559, 1.5600, 1.5642,&
1361 & 1.5647, 1.5741, 1.5862, 1.5993, 1.6149, 1.6765 /
1362 data wrnf /.999932, .97096, .74627, .56719, .53023, .53815,&
1363 & .53233, .52884, .53192, .52969, .52716, .52321,&
1364 & .51904, .53859, .55169, .55488, .55334, .55218 /
1365 data grn / .88323, .89067, .92835, .96626, .97553, .96626,&
1366 & .97226, .97663, .97216, .97467, .97745, .98156,&
1367 & .98584, .96374, .94218, .93266, .92990, .90729 /
1368 end module rain1
1371 ! block data graup1
1372 module graup1
1373 !c *********************************************************************
1374 !c The single-scattering properties of graupel here are replaced by
1375 !c those of aesosols (rural model of Shettle and Fenn, 1979 with 50%
1376 !c relative humidity). The extinction coefficients are normalized to
1377 !c a number of density of 1.5e10 particles/m**3.
1378 !c June 23, 1994
1379 !c
1380 !C For graupel
1381 !c bg, wgf and gg are the extinction coefficient (1/km), single
1382 !c scattering albedo and asymmetry factor for the graupel. The size
1383 !c distribution of graupel is in the form of a truncated constant-slope
1384 !c gamma function (Manton and Cotton, 1977) where rmin = 60 um, rmax =
1385 !c 5000 um, rc = 500 um, density of graupel = 0.6 g/cm**3, and graupel
1386 !c water content (gwc) = 0.5 g/m**3.
1387 !c Jan. 19, 1993
1388 !c *********************************************************************
1389 !# include "para.file"
1390 USE PARA_FILE
1391 ! common /gra1/ gwc, bg(mb), wgf(mb), gg(mb)
1392 implicit none
1393 real, save :: gwc, bg(mb), wgf(mb), gg(mb)
1394 !c--- for aerosol in orig Fu-Liou
1395 !c
1396 ! data gwc / 1.5e10 /
1397 ! data bg / 1.514e-01,6.361e-02,3.653e-02,2.024e-02,1.824e-02,&
1398 ! 1.520e-02,1.343e-02,1.196e-02,1.103e-02,9.383e-03,&
1399 ! 1.254e-02,1.658e-02,1.082e-02,8.567e-03,9.362e-03,&
1400 ! 9.319e-03,7.062e-03,6.603e-03 /
1401 ! data wgf / 0.9427,0.8653,0.7978,0.8492,0.6459,0.9137,&
1402 ! 0.8418,0.7947,0.6686,0.4676,0.2786,0.4632,&
1403 ! 0.6415,0.5105,0.4492,0.4094,0.2794,0.2137 /
1404 ! data gg / 0.6534,0.6220,0.6365,0.7277,0.7759,0.7311,&
1405 ! 0.7498,0.7685,0.7810,0.8104,0.7322,0.6162,&
1406 ! 0.6441,0.6802,0.6200,0.5404,0.5178,0.4399 /
1407 !C
1409 !C For graupel
1410 data gwc / 0.5 /
1411 data bg / 0.83939,0.83940,0.83940,0.83941,0.83946,0.83951, &
1412 & 0.83967,0.83979,0.83995,0.84029,0.84058,0.84097, &
1413 & 0.84143,0.84286,0.84418,0.84825,0.85421,0.87477 /
1414 data wgf / 0.999911,0.97115,0.56192,0.53156,0.52579,0.53846, &
1415 & 0.53296,0.53017,0.53182,0.53180,0.52959,0.52446, &
1416 & 0.52342,0.54914,0.55258,0.54307,0.53160,0.55474 /
1417 data gg / 0.89218,0.89940,0.96820,0.97816,0.98141,0.96373, &
1418 & 0.97173,0.97559,0.97330,0.97327,0.97626,0.98274, &
1419 & 0.98396,0.94673,0.94213,0.95539,0.97097,0.93183 /
1420 end module graup1
1423 module numericals
1424 !c **********************************************************************
1425 !c Double-Gauss quadratures and weights (Sykes, 1951).
1426 !c **********************************************************************
1427 ! block data
1428 ! common /dis/ a(4)
1429 ! common /point/ u(4)
1430 implicit none
1431 real, dimension(4) :: a, u, p0d, p1d, p2d, p3d
1432 real, dimension(4,4) :: p11d, p22d, p33d
1434 data a / 0.5, 0.5, 0.5, 0.5 /
1435 data u / -0.7886752, -0.2113247, 0.2113247, 0.7886752 /
1436 ! end
1438 !c *********************************************************************
1439 !c p0, p1, p2 and p3 are Legendre polynomials for l = 1, 2, 3.
1440 !c *********************************************************************
1441 !c function p0 ( x )
1442 !c p0 = 1.0
1443 !c return
1444 !c end
1445 !c function p1 ( x )
1446 !c p1 = x
1447 !c return
1448 !c end
1449 !c function p2 ( x )
1450 !c p2 = 1.5 * x * x - 0.5
1451 !c return
1452 !c end
1453 !c function p3 ( x )
1454 !c p3 = ( 2.5 * x * x - 1.5 ) * x
1455 !c return
1456 !c end
1458 !c **********************************************************************
1459 !c p0d(4), p1d(4), p2d(4), and p3d(4) are Legendre polynomials p0(x),
1460 !c p1(x), p2(x), and p3(x) when x = u(1), u(2), u(3), and u(4).
1461 !c **********************************************************************
1462 ! block data legend
1463 ! common /legen/ p0d(4), p1d(4), p2d(4), p3d(4)
1464 data p0d / .100000E+01, .100000E+01, .100000E+01, .100000E+01 /
1465 data p1d / -.788675E+00, -.211325E+00, .211325E+00, .788675E+00 /
1466 data p2d / .433013E+00, -.433013E+00, -.433013E+00, .433013E+00 /
1467 data p3d / -.433940E-01, .293394E+00, -.293394E+00, .433940E-01 /
1468 ! end
1470 !c *********************************************************************
1471 !c p11d(4,4), p22d(4,4), and p33d(4,4) are defined as 0.5*p1d(i)*p1d(j), &
1472 !c 0.5*p2d(i)*p2d(j), and 0.5*p3d(i)*p3d(j), respectively.
1473 !c *********************************************************************
1474 ! block data legenf
1475 ! common /legen1/ p11d(4,4), p22d(4,4), p33d(4,4)
1476 data p11d / .311004E+00, .833334E-01,-.833334E-01,-.311004E+00,&
1477 & .833334E-01, .223291E-01,-.223291E-01,-.833334E-01,&
1478 & -.833334E-01,-.223291E-01, .223291E-01, .833334E-01,&
1479 & -.311004E+00,-.833334E-01, .833334E-01, .311004E+00 /
1480 data p22d / .937501E-01,-.937501E-01,-.937501E-01, .937501E-01,&
1481 & -.937501E-01, .937501E-01, .937501E-01,-.937501E-01,&
1482 & -.937501E-01, .937501E-01, .937501E-01,-.937501E-01,&
1483 & .937501E-01,-.937501E-01,-.937501E-01, .937501E-01 /
1484 data p33d / .941520E-03,-.636577E-02, .636577E-02,-.941520E-03,&
1485 & -.636577E-02, .430400E-01,-.430400E-01, .636577E-02,&
1486 & .636577E-02,-.430400E-01, .430400E-01,-.636577E-02,&
1487 & -.941520E-03, .636577E-02,-.636577E-02, .941520E-03 /
1488 end module numericals
1491 module band
1492 implicit none
1493 integer, private :: i, j, k
1494 ! block data ckd1
1495 !c *********************************************************************
1496 !c hk is the interval in the g (cumulative probability) space from 0 to
1497 !c one. fko3 is the corresponding ozone absorption coefficient in units
1498 !c of (cm-atm)**-1 (Fu, 1991). The spectral region is from 50000 cm**-1
1499 !c to 14500 cm**-1.
1500 !c *********************************************************************
1501 real, save :: hk_1(10), fko3_1(10), &
1502 & hk_2(8), coeh2o_2(3,11,8), &
1503 & hk_3(12), coeh2o_3(3,11,12), &
1504 & hk_4(7), coeh2o_4(3,11,7), &
1505 & hk_5(12), coeh2o_5(3,11,12), &
1506 & hk_6(5), coeh2o_6(3,11,5), &
1507 & hk_7(2), coeh2o_7(3,19,2), &
1508 & hk_8(3), coeh2o_8(3,19,3), &
1509 & hk_9(4), coeh2o_9(3,19,4), &
1510 & hk_10(4), coeh2o_10(3,19,4), &
1511 & coech4_10(3,19), coen2o_10(3,19), &
1512 & hk_11(3), coeh2o_11(3,19,3), &
1513 & coech4_11(3,19), coen2o_11(3,19), &
1514 & hk_12(5), coeo3_12(3,19,5), coeh2o_12(3,19), &
1515 & hk_13(2), coeh2o_13(3,19,2), &
1516 & hk_14(10), coehca_14(3,19,10), coehcb_14(3,19,10), &
1517 & hk_15(12), coehca_15(3,19,12), coehcb_15(3,19,12), &
1518 & hk_16(7), coeh2o_16(3,19,7), &
1519 & hk_17(7), coeh2o_17(3,19,7), &
1520 & hk_18(8), coeh2o_18(3,19,8)
1522 ! common /band1/ hk(10), fko3(10)
1523 data hk_1 / .24, .16, .24, .28, .03,&
1524 & .016, .01, .008, .008, .008 /
1525 data fko3_1 / .2204e-08,.1207e-01,.4537e-01,.1032e+00,.1740e+00,&
1526 & .1210e+01,.7367e+01,.2050e+02,.8100e+02,.2410e+03 /
1529 ! block data ckd2
1530 !c *********************************************************************
1531 !c hk is the interval in the g (cumulative probability) space from 0
1532 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1533 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
1534 !c pressures, and eight cumulative probabilities ( Fu, 1991 ). The
1535 !c spectral region is from 14500 to 7700 cm**-1.
1536 !c *********************************************************************
1537 ! common /band2/ hk(8), coeh2o(3,11,8)
1538 data hk_2 / .71, .11, .06, .06, .04, .016, .0034, .0006 /
1539 !c .343849E+03 .532724E+02 .290577E+02 .290577E+02 .193718E+02
1540 !c .774872E+01 .164660E+01 .290577E+00
1541 data ( ( ( coeh2o_2(k,j,i), i = 1, 8 ), j = 1, 11 ), k = 1, 3 ) / &
1542 & -.1735E+02,-.1407E+02,-.1268E+02,-.1131E+02,-.9261E+01,-.6666E+01,&
1543 & -.3937E+01,-.5448E+00,-.1690E+02,-.1365E+02,-.1232E+02,-.1101E+02,&
1544 & -.9058E+01,-.6574E+01,-.3914E+01,-.5529E+00,-.1643E+02,-.1323E+02,&
1545 & -.1195E+02,-.1068E+02,-.8840E+01,-.6475E+01,-.3889E+01,-.6143E+00,&
1546 & -.1598E+02,-.1282E+02,-.1157E+02,-.1035E+02,-.8598E+01,-.6339E+01,&
1547 & -.3848E+01,-.6636E+00,-.1551E+02,-.1241E+02,-.1119E+02,-.1001E+02,&
1548 & -.8342E+01,-.6178E+01,-.3788E+01,-.8181E+00,-.1506E+02,-.1201E+02,&
1549 & -.1082E+02,-.9692E+01,-.8073E+01,-.6017E+01,-.3703E+01,-.9003E+00,&
1550 & -.1446E+02,-.1154E+02,-.1042E+02,-.9332E+01,-.7810E+01,-.5846E+01,&
1551 & -.3576E+01,-.1083E+01,-.1394E+02,-.1112E+02,-.1005E+02,-.8992E+01,&
1552 & -.7548E+01,-.5674E+01,-.3477E+01,-.1266E+01,-.1351E+02,-.1076E+02,&
1553 & -.9722E+01,-.8702E+01,-.7334E+01,-.5531E+01,-.3401E+01,-.1524E+01,&
1554 & -.1311E+02,-.1044E+02,-.9422E+01,-.8423E+01,-.7117E+01,-.5383E+01,&
1555 & -.3410E+01,-.1785E+01,-.1274E+02,-.1015E+02,-.9162E+01,-.8190E+01,&
1556 & -.6949E+01,-.5236E+01,-.3477E+01,-.2082E+01, .2407E-02, .2847E-02,&
1557 & .3768E-02, .4626E-02, .5631E-02, .4542E-02, .3475E-02,-.3085E-02,&
1558 & .2428E-02, .2805E-02, .3412E-02, .3893E-02, .4773E-02, .3998E-02,&
1559 & .2742E-02,-.2556E-02, .2428E-02, .2721E-02, .3077E-02, .3161E-02,&
1560 & .4019E-02, .3224E-02, .2512E-02,-.1884E-02, .2449E-02, .2617E-02,&
1561 & .2763E-02, .2658E-02, .3286E-02, .2617E-02, .1989E-02,-.1740E-02,&
1562 & .2512E-02, .2470E-02, .2470E-02, .2282E-02, .2512E-02, .1926E-02,&
1563 & .1465E-02,-.2612E-02, .2554E-02, .2303E-02, .2303E-02, .1842E-02,&
1564 & .2030E-02, .1340E-02, .1068E-02,-.1413E-02, .2449E-02, .2198E-02,&
1565 & .2030E-02, .1465E-02, .1528E-02, .9838E-03, .1005E-02,-.1099E-02,&
1566 & .2868E-02, .2198E-02, .1968E-02, .1382E-02, .1172E-02, .5652E-03,&
1567 & .6070E-03,-.1662E-02, .3077E-02, .2219E-02, .1800E-02, .1277E-02,&
1568 & .1005E-02, .3349E-03, .2512E-03,-.1195E-02, .3182E-02, .2219E-02,&
1569 & .1758E-02, .1172E-02, .7326E-03, .4815E-03, .6280E-04,-.1880E-02,&
1570 & .3265E-02, .2114E-02, .1696E-02, .1298E-02, .4187E-03, .4187E-03,&
1571 & -.3768E-03,-.1467E-02,-.1180E-04,-.1294E-04,-.1142E-04,-.7232E-05,&
1572 & -.8754E-05,-.1484E-04,-.8373E-05, .1028E-04,-.1218E-04,-.1142E-04,&
1573 & -.9515E-05,-.1522E-05,-.9134E-05,-.1484E-04,-.3425E-05, .1142E-06,&
1574 & -.1294E-04,-.9895E-05,-.7231E-05,-.4187E-05,-.7612E-05,-.3806E-05,&
1575 & .1522E-05,-.3882E-05,-.1256E-04,-.8754E-05,-.7612E-05,-.6470E-05,&
1576 & -.4948E-05,-.3425E-05, .4948E-05,-.1054E-04,-.1370E-04,-.6089E-05,&
1577 & -.8373E-05,-.5709E-05,-.3045E-05,-.3806E-05, .5328E-05, .8678E-05,&
1578 & -.1370E-04,-.6851E-05,-.8373E-05,-.1522E-05,-.3425E-05, .0000E+00,&
1579 & .1256E-04,-.1572E-04,-.1484E-04,-.7231E-05,-.7992E-05,-.4567E-05,&
1580 & -.2664E-05,-.3807E-06,-.1522E-05, .2169E-05,-.1713E-04,-.9515E-05,&
1581 & -.6089E-05,-.6851E-05,-.3045E-05,-.1142E-05, .1903E-05, .9363E-05,&
1582 & -.1560E-04,-.9134E-05,-.5328E-05,-.4948E-05, .0000E+00, .7611E-06,&
1583 & -.6851E-05, .1252E-04,-.1522E-04,-.8373E-05,-.6089E-05,-.6089E-05,&
1584 & -.3805E-06,-.1142E-05,-.3807E-06, .2512E-05,-.1599E-04,-.7231E-05,&
1585 & -.5709E-05,-.4567E-05, .1522E-05,-.2284E-05,-.3941E-10, .5290E-05/
1588 ! block data ckd3
1589 !c *********************************************************************
1590 !c hk is the interval in the g (cumulative probability) space from 0
1591 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1592 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
1593 !c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
1594 !c spectral region is from 7700 to 5250 cm**-1.
1595 !c *********************************************************************
1596 ! common /band3/ hk(12), coeh2o(3,11,12)
1597 data hk_3 / .34, .11, .1, .09, .12, .1, &
1598 & .06, .04, .026, .01, .0035, .0005 /
1599 !c .509474E+02 .164830E+02 .149845E+02 .134861E+02 .179814E+02
1600 !c .149845E+02 .899071E+01 .599381E+01 .389597E+01 .149845E+01
1601 !c .524458E+00 .749226E-01
1602 data ( ( ( coeh2o_3(k,j,i), i = 1, 12 ), j = 1, 11 ), k = 1, 3 ) / &
1603 & -.1900E+02,-.1515E+02,-.1344E+02,-.1224E+02,-.1081E+02,-.9337E+01,&
1604 & -.7965E+01,-.6585E+01,-.4578E+01,-.2247E+01, .1747E+00, .3083E+01,&
1605 & -.1854E+02,-.1471E+02,-.1300E+02,-.1181E+02,-.1039E+02,-.8927E+01,&
1606 & -.7576E+01,-.6238E+01,-.4317E+01,-.2119E+01, .1888E+00, .3033E+01,&
1607 & -.1808E+02,-.1426E+02,-.1257E+02,-.1137E+02,-.9966E+01,-.8513E+01,&
1608 & -.7177E+01,-.5885E+01,-.4053E+01,-.1977E+01, .2245E+00, .3005E+01,&
1609 & -.1763E+02,-.1381E+02,-.1213E+02,-.1094E+02,-.9542E+01,-.8094E+01,&
1610 & -.6779E+01,-.5524E+01,-.3788E+01,-.1796E+01, .2961E+00, .2828E+01,&
1611 & -.1716E+02,-.1337E+02,-.1170E+02,-.1051E+02,-.9116E+01,-.7677E+01,&
1612 & -.6381E+01,-.5153E+01,-.3493E+01,-.1607E+01, .3850E+00, .2660E+01,&
1613 & -.1670E+02,-.1295E+02,-.1127E+02,-.1008E+02,-.8690E+01,-.7265E+01,&
1614 & -.5991E+01,-.4799E+01,-.3212E+01,-.1438E+01, .4582E+00, .2588E+01,&
1615 & -.1596E+02,-.1231E+02,-.1067E+02,-.9501E+01,-.8151E+01,-.6793E+01,&
1616 & -.5588E+01,-.4458E+01,-.2940E+01,-.1257E+01, .4888E+00, .2260E+01,&
1617 & -.1530E+02,-.1184E+02,-.1017E+02,-.8992E+01,-.7661E+01,-.6369E+01,&
1618 & -.5213E+01,-.4145E+01,-.2701E+01,-.1108E+01, .4239E+00, .1974E+01,&
1619 & -.1481E+02,-.1144E+02,-.9756E+01,-.8573E+01,-.7255E+01,-.5994E+01,&
1620 & -.4868E+01,-.3829E+01,-.2485E+01,-.9738E+00, .3343E+00, .1667E+01,&
1621 & -.1439E+02,-.1108E+02,-.9360E+01,-.8183E+01,-.6885E+01,-.5646E+01,&
1622 & -.4559E+01,-.3555E+01,-.2314E+01,-.8904E+00, .2169E+00, .1289E+01,&
1623 & -.1402E+02,-.1073E+02,-.8987E+01,-.7817E+01,-.6551E+01,-.5335E+01,&
1624 & -.4278E+01,-.3316E+01,-.2147E+01,-.8695E+00, .1587E-01, .8658E+00,&
1625 & .1132E-01, .8855E-02, .6698E-02, .5296E-02, .4396E-02, .3370E-02,&
1626 & .3245E-02, .4145E-02, .4731E-02, .4756E-02, .3116E-02,-.2763E-02,&
1627 & .1135E-01, .8917E-02, .6657E-02, .5170E-02, .4207E-02, .3056E-02,&
1628 & .2868E-02, .3433E-02, .3726E-02, .4109E-02, .2836E-02,-.3119E-02,&
1629 & .1135E-01, .8980E-02, .6615E-02, .5045E-02, .4061E-02, .2847E-02,&
1630 & .2491E-02, .2847E-02, .2910E-02, .2671E-02, .2396E-02,-.3245E-02,&
1631 & .1135E-01, .9043E-02, .6594E-02, .4940E-02, .3914E-02, .2638E-02,&
1632 & .2156E-02, .2261E-02, .2051E-02, .1978E-02, .1566E-02,-.3203E-02,&
1633 & .1139E-01, .9085E-02, .6531E-02, .4835E-02, .3768E-02, .2428E-02,&
1634 & .1842E-02, .1612E-02, .1591E-02, .1279E-02, .7201E-03,-.2763E-02,&
1635 & .1143E-01, .9085E-02, .6447E-02, .4752E-02, .3684E-02, .2261E-02,&
1636 & .1570E-02, .1235E-02, .1151E-02, .7243E-03, .6489E-04,-.2240E-02,&
1637 & .1135E-01, .9001E-02, .5694E-02, .4438E-02, .3412E-02, .1968E-02,&
1638 & .1235E-02, .9420E-03, .8792E-03, .5045E-03,-.1821E-03,-.1936E-02,&
1639 & .1174E-01, .9273E-02, .5882E-02, .4689E-02, .3454E-02, .1947E-02,&
1640 & .1151E-02, .6070E-03, .6698E-03, .9420E-04,-.6740E-03,-.2707E-02,&
1641 & .1218E-01, .9336E-02, .6050E-02, .4731E-02, .3475E-02, .1863E-02,&
1642 & .1151E-02, .4605E-03, .3768E-03,-.1214E-03,-.4396E-03,-.1903E-02,&
1643 & .1235E-01, .9294E-02, .6029E-02, .4584E-02, .3370E-02, .1800E-02,&
1644 & .1068E-02, .2303E-03, .1675E-03,-.4501E-03,-.7571E-03,-.1149E-02,&
1645 & .1233E-01, .9315E-02, .6029E-02, .4438E-02, .3203E-02, .1842E-02,&
1646 & .9629E-03, .0000E+00,-.2198E-03,-.5338E-03,-.9721E-03,-.7661E-03,&
1647 & -.3692E-04,-.3844E-04,-.2588E-04,-.1180E-04,-.1066E-04,-.3426E-05,&
1648 & -.2664E-05, .7611E-06, .6089E-05,-.4568E-06,-.2077E-04,-.1142E-04,&
1649 & -.3730E-04,-.3806E-04,-.2360E-04,-.1256E-04,-.1180E-04,-.4567E-05,&
1650 & -.3425E-05,-.2284E-05,-.1522E-05,-.4225E-05,-.9940E-05,-.4187E-05,&
1651 & -.3501E-04,-.3844E-04,-.2131E-04,-.1256E-04,-.9896E-05,-.3806E-05,&
1652 & -.4186E-05, .7612E-06,-.1903E-05, .4110E-05, .1789E-05,-.2169E-04,&
1653 & -.3425E-04,-.3882E-04,-.1941E-04,-.1294E-04,-.9515E-05,-.4567E-05,&
1654 & -.4186E-05, .1522E-05,-.4187E-10, .4605E-05,-.2588E-05, .6470E-05,&
1655 & -.3501E-04,-.3730E-04,-.1751E-04,-.1332E-04,-.1066E-04,-.3806E-05,&
1656 & -.4567E-05,-.1142E-05,-.3045E-05, .1104E-05,-.1058E-04, .2816E-04,&
1657 & -.3578E-04,-.3501E-04,-.1751E-04,-.1332E-04,-.1218E-04,-.3806E-05,&
1658 & -.3425E-05,-.3806E-06,-.4187E-05,-.6090E-06,-.6965E-05,-.3463E-04,&
1659 & -.3578E-04,-.3349E-04,-.1675E-04,-.9895E-05,-.9515E-05,-.6090E-05,&
1660 & -.6470E-05,-.3807E-06,-.5328E-05,-.4186E-06,-.3996E-05, .2074E-04,&
1661 & -.3540E-04,-.3083E-04,-.1789E-04,-.9896E-05,-.1104E-04,-.6470E-05,&
1662 & -.5709E-05, .3425E-05,-.4567E-05, .3463E-05, .5633E-05,-.3159E-05,&
1663 & -.3730E-04,-.2740E-04,-.1484E-04,-.1066E-04,-.1142E-04,-.6470E-05,&
1664 & -.6470E-05, .1522E-05,-.1522E-05,-.3045E-05, .3197E-05,-.1039E-04,&
1665 & -.3425E-04,-.2284E-04,-.1370E-04,-.1028E-04,-.1104E-04,-.8373E-05,&
1666 & -.4948E-05, .1903E-05,-.7612E-06,-.1104E-05, .2455E-05,-.3805E-07,&
1667 & -.3235E-04,-.2093E-04,-.1294E-04,-.1142E-04,-.1180E-04,-.6851E-05,&
1668 & -.3045E-05,-.7611E-06, .1256E-05,-.7231E-06, .9924E-05, .3578E-05/
1671 ! block data ckd4
1672 !c *********************************************************************
1673 !c hk is the interval in the g (cumulative probability) space from 0
1674 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1675 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
1676 !c pressures, and seven cumulative probabilities ( Fu, 1991 ). The
1677 !c spectral region is from 5250 to 4000 cm**-1.
1678 !c *********************************************************************
1679 ! common /band4/ hk(7), coeh2o(3,11,7)
1680 data hk_4 / .52, .21, .11, .1, .04, .015, .005 /
1681 !c .253397E+02 .102333E+02 .536032E+01 .487302E+01 .194921E+01
1682 !c .730953E+00 .243651E+00
1683 data ( ( ( coeh2o_4(k,j,i), i = 1, 7 ), j = 1, 11 ), k = 1, 3 ) / &
1684 & -.1722E+02,-.1402E+02,-.1202E+02,-.1001E+02,-.7702E+01,-.5273E+01, &
1685 & -.6530E+00,-.1677E+02,-.1359E+02,-.1164E+02,-.9662E+01,-.7419E+01, &
1686 & -.5001E+01,-.6040E+00,-.1630E+02,-.1316E+02,-.1125E+02,-.9303E+01, &
1687 & -.7092E+01,-.4750E+01,-.5715E+00,-.1584E+02,-.1274E+02,-.1086E+02, &
1688 & -.8939E+01,-.6751E+01,-.4458E+01,-.4928E+00,-.1538E+02,-.1232E+02, &
1689 & -.1048E+02,-.8579E+01,-.6399E+01,-.4191E+01,-.4683E+00,-.1493E+02, &
1690 & -.1192E+02,-.1011E+02,-.8241E+01,-.6065E+01,-.3910E+01,-.4310E+00, &
1691 & -.1440E+02,-.1145E+02,-.9643E+01,-.7873E+01,-.5710E+01,-.3668E+01, &
1692 & -.3304E+00,-.1391E+02,-.1104E+02,-.9238E+01,-.7479E+01,-.5367E+01, &
1693 & -.3387E+01,-.3604E+00,-.1348E+02,-.1069E+02,-.8918E+01,-.7122E+01, &
1694 & -.5086E+01,-.3152E+01,-.3030E+00,-.1310E+02,-.1037E+02,-.8626E+01, &
1695 & -.6790E+01,-.4815E+01,-.2945E+01,-.4789E+00,-.1275E+02,-.1011E+02, &
1696 & -.8347E+01,-.6484E+01,-.4584E+01,-.2788E+01,-.5807E+00, .7934E-02, &
1697 & .9231E-02, .1005E-01, .9043E-02, .8164E-02, .8980E-02, .6403E-02, &
1698 & .7954E-02, .9169E-02, .9797E-02, .8687E-02, .7724E-02, .7954E-02, &
1699 & .6652E-02, .7954E-02, .9043E-02, .9608E-02, .8499E-02, .7347E-02, &
1700 & .7473E-02, .6382E-02, .7996E-02, .8980E-02, .9378E-02, .8289E-02, &
1701 & .7264E-02, .6594E-02, .6674E-02, .8059E-02, .8938E-02, .9294E-02, &
1702 & .8227E-02, .7201E-02, .6678E-02, .7032E-02, .8122E-02, .8896E-02, &
1703 & .9189E-02, .8038E-02, .7033E-02, .5987E-02, .5475E-02, .8268E-02, &
1704 & .9064E-02, .8792E-02, .7975E-02, .6573E-02, .5087E-02, .4657E-02, &
1705 & .8541E-02, .8980E-02, .9085E-02, .7996E-02, .6133E-02, .4501E-02, &
1706 & .3860E-02, .8813E-02, .9043E-02, .9294E-02, .8122E-02, .5861E-02, &
1707 & .4354E-02, .3964E-02, .8875E-02, .8834E-02, .9797E-02, .8164E-02, &
1708 & .5463E-02, .4417E-02, .3270E-02, .8938E-02, .8771E-02, .1005E-01, &
1709 & .8247E-02, .5589E-02, .4835E-02, .3033E-02,-.1484E-04,-.2169E-04, &
1710 & -.2436E-04,-.2588E-04,-.1142E-04,-.1142E-05,-.1519E-04,-.1522E-04, &
1711 & -.2055E-04,-.2131E-04,-.2398E-04,-.4948E-05,-.1675E-04,-.3593E-04, &
1712 & -.1522E-04,-.2055E-04,-.1865E-04,-.2207E-04,-.4948E-05,-.1180E-04, &
1713 & -.1237E-04,-.1598E-04,-.2017E-04,-.1903E-04,-.2284E-04,-.1028E-04, &
1714 & -.1865E-04,-.2381E-04,-.1713E-04,-.2017E-04,-.1827E-04,-.2169E-04, &
1715 & -.1218E-04,-.9515E-05,-.2415E-04,-.1827E-04,-.2093E-04,-.1637E-04, &
1716 & -.1827E-04,-.9134E-05,-.8373E-05,-.1243E-04,-.1560E-04,-.1865E-04, &
1717 & -.1599E-04,-.1256E-04,-.1066E-04,-.1142E-05,-.2181E-04,-.1675E-04, &
1718 & -.1560E-04,-.1522E-04,-.1675E-04,-.1865E-04,-.1865E-04,-.9522E-05, &
1719 & -.1332E-04,-.1370E-04,-.1446E-04,-.2055E-04,-.1142E-04,-.2512E-04, &
1720 & -.3343E-04,-.1294E-04,-.1294E-04,-.1751E-04,-.2512E-04,-.1560E-04, &
1721 & -.2854E-04,-.7003E-05,-.8753E-05,-.1028E-04,-.1751E-04,-.2512E-04, &
1722 & -.1713E-04,-.1713E-04,-.1245E-04 /
1725 ! block data ckd5
1726 !c *********************************************************************
1727 !c hk is the interval in the g (cumulative probability) space from 0
1728 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1729 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
1730 !c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
1731 !c spectral region is from 4000 to 2850 cm**-1.
1732 !c *********************************************************************
1733 ! common /band5/ hk(12), coeh2o(3,11,12)
1734 data hk_5 / .13, .14, .13, .16, .18, .14, &
1735 & .07, .02, .016, .008, .004, .002 /
1736 !c .411549E+01 .443207E+01 .411549E+01 .506522E+01 .569837E+01
1737 !c .443207E+01 .221603E+01 .633153E+00 .506522E+00 .253261E+00
1738 !c .126631E+00 .633153E-01
1739 data ( ( ( coeh2o_5(k,j,i), i = 1, 12 ), j = 1, 11 ), k = 1, 3 ) / &
1740 & -.1499E+02,-.1267E+02,-.1118E+02,-.9696E+01,-.7992E+01,-.6323E+01, &
1741 & -.4414E+01,-.2961E+01,-.1715E+01,-.1406E+00, .1612E+01, .3689E+01, &
1742 & -.1454E+02,-.1223E+02,-.1075E+02,-.9277E+01,-.7576E+01,-.5915E+01, &
1743 & -.4043E+01,-.2630E+01,-.1449E+01, .2314E-01, .1708E+01, .3744E+01, &
1744 & -.1408E+02,-.1178E+02,-.1031E+02,-.8851E+01,-.7154E+01,-.5503E+01, &
1745 & -.3666E+01,-.2288E+01,-.1141E+01, .2772E+00, .1819E+01, .3788E+01, &
1746 & -.1363E+02,-.1134E+02,-.9876E+01,-.8423E+01,-.6733E+01,-.5091E+01, &
1747 & -.3286E+01,-.1938E+01,-.8649E+00, .5349E+00, .1969E+01, .3795E+01, &
1748 & -.1318E+02,-.1091E+02,-.9452E+01,-.8004E+01,-.6309E+01,-.4677E+01, &
1749 & -.2904E+01,-.1595E+01,-.5641E+00, .7592E+00, .2109E+01, .3783E+01, &
1750 & -.1275E+02,-.1048E+02,-.9028E+01,-.7585E+01,-.5892E+01,-.4267E+01, &
1751 & -.2524E+01,-.1274E+01,-.2782E+00, .9376E+00, .2257E+01, .3714E+01, &
1752 & -.1180E+02,-.9887E+01,-.8492E+01,-.7014E+01,-.5390E+01,-.3834E+01, &
1753 & -.2156E+01,-.9775E+00,-.3129E-01, .1151E+01, .2330E+01, .3592E+01, &
1754 & -.1114E+02,-.9367E+01,-.8002E+01,-.6514E+01,-.4928E+01,-.3435E+01, &
1755 & -.1835E+01,-.7064E+00, .2153E+00, .1309E+01, .2422E+01, .3488E+01, &
1756 & -.1074E+02,-.8941E+01,-.7582E+01,-.6116E+01,-.4536E+01,-.3072E+01, &
1757 & -.1521E+01,-.4651E+00, .4053E+00, .1465E+01, .2374E+01, .3260E+01, &
1758 & -.1041E+02,-.8545E+01,-.7180E+01,-.5745E+01,-.4177E+01,-.2735E+01, &
1759 & -.1245E+01,-.2356E+00, .5786E+00, .1516E+01, .2263E+01, .3074E+01, &
1760 & -.1008E+02,-.8149E+01,-.6804E+01,-.5409E+01,-.3855E+01,-.2427E+01, &
1761 & -.9857E+00,-.4939E-01, .7060E+00, .1483E+01, .2159E+01, .2745E+01, &
1762 & .9985E-02, .8373E-02, .7431E-02, .6866E-02, .4584E-02, .2952E-02, &
1763 & .3098E-02, .3768E-02, .4013E-02, .3960E-02, .3228E-02, .3203E-02, &
1764 & .1007E-01, .8436E-02, .7368E-02, .6657E-02, .4375E-02, .2617E-02, &
1765 & .2742E-02, .3286E-02, .3192E-02, .2992E-02, .2612E-02, .1968E-02, &
1766 & .1019E-01, .8457E-02, .7264E-02, .6426E-02, .4187E-02, .2365E-02, &
1767 & .2324E-02, .2614E-02, .2736E-02, .2068E-02, .2085E-02, .1005E-02, &
1768 & .1028E-01, .8478E-02, .7138E-02, .6259E-02, .3998E-02, .2156E-02, &
1769 & .1926E-02, .1953E-02, .2250E-02, .1844E-02, .1869E-02,-.6489E-03, &
1770 & .1030E-01, .8478E-02, .7033E-02, .6112E-02, .3852E-02, .1989E-02, &
1771 & .1716E-02, .1763E-02, .1432E-02, .1193E-02, .1306E-02,-.5861E-03, &
1772 & .1042E-01, .8499E-02, .6887E-02, .5987E-02, .3768E-02, .1800E-02, &
1773 & .1549E-02, .1712E-02, .1287E-02, .7389E-03, .7222E-03,-.1130E-02, &
1774 & .8227E-02, .7201E-02, .6866E-02, .5903E-02, .3412E-02, .1591E-02, &
1775 & .1402E-02, .1346E-02, .1041E-02, .8185E-03, .3349E-03,-.4815E-03, &
1776 & .8268E-02, .6992E-02, .7159E-02, .6384E-02, .3286E-02, .1591E-02, &
1777 & .1271E-02, .1202E-02, .9187E-03, .6531E-03,-.4187E-03,-.7954E-03, &
1778 & .8478E-02, .7159E-02, .7117E-02, .6447E-02, .3349E-02, .1528E-02, &
1779 & .9964E-03, .9210E-03, .6112E-03, .6259E-03,-.3768E-03,-.1298E-02, &
1780 & .8520E-02, .7075E-02, .7096E-02, .6405E-02, .3245E-02, .1528E-02, &
1781 & .1011E-02, .7877E-03, .7536E-03, .9001E-04,-.6719E-03,-.1026E-02, &
1782 & .8561E-02, .6950E-02, .7033E-02, .6280E-02, .2993E-02, .1528E-02, &
1783 & .6698E-03, .5847E-03, .2847E-03,-.6280E-04,-.9420E-03,-.1444E-02, &
1784 & -.1408E-04,-.2664E-04,-.1180E-04,-.1903E-04,-.9515E-05, .3806E-06, &
1785 & -.6851E-05,-.3806E-05,-.4834E-05,-.3239E-05,-.2284E-05,-.1028E-04, &
1786 & -.1484E-04,-.2550E-04,-.1142E-04,-.1827E-04,-.9515E-05, .3805E-06, &
1787 & -.4948E-05, .3806E-06,-.2664E-06, .1058E-04,-.1012E-04,-.1142E-04, &
1788 & -.1560E-04,-.2512E-04,-.1256E-04,-.1865E-04,-.9134E-05, .1142E-05, &
1789 & -.3425E-05, .2474E-05,-.9781E-05,-.1519E-05,-.7916E-05,-.1294E-04, &
1790 & -.1560E-04,-.2474E-04,-.1180E-04,-.2017E-04,-.7992E-05, .3805E-06, &
1791 & -.2283E-05,-.4453E-05,-.1180E-05,-.5138E-05,-.4453E-05,-.3425E-05, &
1792 & -.1522E-04,-.2550E-04,-.9896E-05,-.1903E-04,-.9134E-05,-.1142E-05, &
1793 & -.7611E-06,-.5252E-05,-.4567E-06,-.4643E-05,-.4567E-06,-.4567E-05, &
1794 & -.1294E-04,-.2512E-04,-.1028E-04,-.2055E-04,-.9896E-05,-.4567E-05, &
1795 & -.2284E-05,-.5100E-05,-.4339E-06,-.9515E-06,-.1252E-04,-.7612E-06, &
1796 & -.2246E-04,-.1370E-04,-.1066E-04,-.1598E-04,-.8754E-05,-.5328E-05, &
1797 & -.6622E-05,-.5138E-05,-.8754E-07,-.9515E-06, .6090E-05, .4187E-05, &
1798 & -.3463E-04,-.1599E-04,-.1218E-04,-.2093E-04,-.9515E-05,-.4567E-05, &
1799 & -.1104E-05,-.1903E-05,-.1488E-05,-.3730E-05,-.4567E-05, .3045E-05, &
1800 & -.3463E-04,-.1675E-04,-.1294E-04,-.1979E-04,-.1066E-04,-.4187E-05, &
1801 & -.4034E-05,-.2893E-05,-.2588E-05,-.9401E-05, .2284E-05, .3045E-05, &
1802 & -.2778E-04,-.1522E-04,-.1560E-04,-.1751E-04,-.1256E-04,-.5709E-05, &
1803 & -.2474E-05,-.2577E-05,-.2284E-05,-.4187E-06, .7650E-05,-.3425E-05, &
1804 & -.3083E-04,-.1827E-04,-.1370E-04,-.1751E-04,-.1104E-04,-.9515E-05, &
1805 & -.6318E-05,-.4358E-05,-.7613E-07, .4643E-05, .4415E-05, .1028E-04/
1808 ! block data ckd6
1809 !c *********************************************************************
1810 !c hk is the interval in the g (cumulative probability) space from 0
1811 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1812 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
1813 !c pressures, and five cumulative probabilities ( Fu, 1991 ). The
1814 !c spectral region is from 2850 to 2500 cm**-1.
1815 !c *********************************************************************
1816 ! common /band6/ hk(5), coeh2o(3,11,5)
1817 data hk_6 / .3, .2, .2, .2, .1 /
1818 !c .173978E+01 .115985E+01 .115985E+01 .115985E+01 .579927E+00
1819 data ( ( ( coeh2o_6(k,j,i), i = 1, 5 ), j = 1, 11 ), k = 1, 3 ) / &
1820 & -.1905E+02,-.1602E+02,-.1472E+02,-.1307E+02,-.1024E+02,-.1823E+02, &
1821 & -.1555E+02,-.1427E+02,-.1266E+02,-.9938E+01,-.1749E+02,-.1508E+02, &
1822 & -.1381E+02,-.1225E+02,-.9641E+01,-.1684E+02,-.1462E+02,-.1337E+02, &
1823 & -.1185E+02,-.9367E+01,-.1630E+02,-.1417E+02,-.1294E+02,-.1145E+02, &
1824 & -.9123E+01,-.1578E+02,-.1373E+02,-.1251E+02,-.1108E+02,-.8881E+01, &
1825 & -.1517E+02,-.1327E+02,-.1209E+02,-.1072E+02,-.8653E+01,-.1463E+02, &
1826 & -.1284E+02,-.1169E+02,-.1040E+02,-.8453E+01,-.1421E+02,-.1244E+02, &
1827 & -.1133E+02,-.1014E+02,-.8312E+01,-.1382E+02,-.1207E+02,-.1100E+02, &
1828 & -.9887E+01,-.8220E+01,-.1348E+02,-.1173E+02,-.1071E+02,-.9685E+01, &
1829 & -.8220E+01, .1024E-01, .1842E-02, .6908E-03, .1737E-02, .3517E-02, &
1830 & .8394E-02, .2072E-02, .8164E-03, .1716E-02, .2805E-02, .8143E-02, &
1831 & .2240E-02, .9001E-03, .1570E-02, .1800E-02, .8227E-02, .2386E-02, &
1832 & .9420E-03, .1486E-02, .1068E-02, .8373E-02, .2533E-02, .9210E-03, &
1833 & .1319E-02, .9420E-03, .8394E-02, .2700E-02, .9629E-03, .1026E-02, &
1834 & .5233E-03, .8917E-02, .2575E-02, .8792E-03, .7536E-03, .4187E-03, &
1835 & .9378E-02, .2617E-02, .7955E-03, .6070E-03, .4815E-03, .9797E-02, &
1836 & .2638E-02, .6908E-03, .5233E-03, .6280E-03, .1009E-01, .2638E-02, &
1837 & .4815E-03, .2931E-03, .4815E-03, .1036E-01, .2428E-02, .3140E-03, &
1838 & .3977E-03, .2093E-03,-.5366E-04,-.1522E-04,-.5709E-05,-.2664E-05, &
1839 & .3806E-05,-.4301E-04,-.1484E-04,-.4948E-05,-.7610E-06, .7610E-06, &
1840 & -.3920E-04,-.1484E-04,-.4948E-05, .3804E-06,-.3806E-05,-.3920E-04, &
1841 & -.1522E-04,-.4948E-05, .3425E-05, .1903E-05,-.3806E-04,-.1484E-04, &
1842 & -.3045E-05, .2664E-05, .7993E-05,-.4148E-04,-.1408E-04,-.3806E-05, &
1843 & .4187E-05, .7993E-05,-.5481E-04,-.1180E-04,-.3045E-05, .3045E-05, &
1844 & .2284E-05,-.5709E-04,-.1104E-04,-.2283E-05,-.2664E-05,-.1142E-05, &
1845 & -.6090E-04,-.1218E-04,-.2664E-05, .3804E-06, .3045E-05,-.6698E-04, &
1846 & -.1218E-04,-.2664E-05, .1523E-05,-.1142E-05,-.6508E-04,-.1218E-04, &
1847 & -.3425E-05, .1903E-05, .7612E-06 /
1850 ! block data ckd7
1851 !c *********************************************************************
1852 !c hk is the interval in the g (cumulative probability) space from 0
1853 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1854 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
1855 !c teen pressures, and two cumulative probabilities ( Fu, 1991 ).
1856 !c The spectral region is from 2200 to 1900 cm**-1.
1857 !c *********************************************************************
1858 ! common /band7/ hk(2), coeh2o(3,19,2)
1859 data hk_7 / 0.7, 0.3 /
1860 data ( ( ( coeh2o_7(k,j,i), i = 1, 2 ), j = 1, 19 ), k = 1, 3 ) / &
1861 & -.2008E+02,-.1467E+02,-.2004E+02,-.1426E+02,-.2001E+02,-.1386E+02, &
1862 & -.1998E+02,-.1345E+02,-.1995E+02,-.1304E+02,-.1992E+02,-.1263E+02, &
1863 & -.1989E+02,-.1223E+02,-.1986E+02,-.1183E+02,-.1984E+02,-.1143E+02, &
1864 & -.1758E+02,-.1038E+02,-.1602E+02,-.9480E+01,-.1469E+02,-.8752E+01, &
1865 & -.1349E+02,-.8218E+01,-.1255E+02,-.7677E+01,-.1174E+02,-.7184E+01, &
1866 & -.1110E+02,-.6735E+01,-.1056E+02,-.6332E+01,-.1019E+02,-.5975E+01, &
1867 & -.9874E+01,-.5644E+01, .2533E-02, .2269E-01, .2575E-02, .2263E-01, &
1868 & .2554E-02, .2267E-01, .2491E-02, .2250E-01, .2449E-02, .2244E-01, &
1869 & .2344E-02, .2234E-01, .2219E-02, .2208E-01, .5694E-02, .2190E-01, &
1870 & .9650E-02, .2162E-01, .3286E-01, .1848E-01, .2987E-01, .1578E-01, &
1871 & .2527E-01, .1465E-01, .2175E-01, .1386E-01, .2056E-01, .1235E-01, &
1872 & .1963E-01, .1116E-01, .1926E-01, .1040E-01, .2014E-01, .1040E-01, &
1873 & .2024E-01, .1042E-01, .1972E-01, .1080E-01,-.8754E-05,-.6698E-04, &
1874 & -.1104E-04,-.6432E-04,-.1142E-04,-.6051E-04,-.1180E-04,-.6128E-04, &
1875 & -.1180E-04,-.6242E-04,-.1218E-04,-.6280E-04,-.1218E-04,-.6204E-04, &
1876 & .5328E-04,-.5709E-04, .1275E-03,-.5214E-04,-.1370E-03,-.4148E-04, &
1877 & -.1100E-03,-.3045E-04,-.9248E-04,-.3197E-04,-.7346E-04,-.2436E-04, &
1878 & -.5100E-04,-.2131E-04,-.5861E-04,-.2550E-04,-.5328E-04,-.3311E-04, &
1879 & -.6090E-04,-.4225E-04,-.5443E-04,-.4415E-04,-.4034E-04,-.4339E-04/
1882 ! block data ckd8
1883 !c *********************************************************************
1884 !c hk is the interval in the g (cumulative probability) space from 0
1885 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1886 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
1887 !c teen pressures, and three cumulative probabilities ( Fu, 1991 ).
1888 !c The spectral region is from 1900 to 1700 cm**-1.
1889 !c *********************************************************************
1890 ! common /band8/ hk(3), coeh2o(3,19,3)
1891 data hk_8 / 0.2, 0.7, 0.1 /
1892 data ( ( ( coeh2o_8(k,j,i), i = 1, 3 ), j = 1, 19 ), k = 1, 3 ) / &
1893 & -.2283E+02,-.1639E+02,-.6155E+01,-.2237E+02,-.1595E+02,-.5775E+01, &
1894 & -.2191E+02,-.1551E+02,-.5381E+01,-.2145E+02,-.1507E+02,-.5004E+01, &
1895 & -.2099E+02,-.1463E+02,-.4617E+01,-.2053E+02,-.1419E+02,-.4218E+01, &
1896 & -.2025E+02,-.1375E+02,-.3806E+01,-.2021E+02,-.1330E+02,-.3403E+01, &
1897 & -.2018E+02,-.1287E+02,-.2993E+01,-.1998E+02,-.1091E+02,-.2586E+01, &
1898 & -.1744E+02,-.9171E+01,-.2162E+01,-.1490E+02,-.7642E+01,-.1763E+01, &
1899 & -.1303E+02,-.6526E+01,-.1373E+01,-.1113E+02,-.5846E+01,-.9699E+00, &
1900 & -.9814E+01,-.5280E+01,-.5955E+00,-.8582E+01,-.4787E+01,-.2510E+00, &
1901 & -.8020E+01,-.4350E+01, .2770E-01,-.7571E+01,-.3942E+01, .2406E+00, &
1902 & -.7140E+01,-.3537E+01, .3567E+00, .3722E-01, .1505E-01, .6615E-02, &
1903 & .3722E-01, .1518E-01, .5840E-02, .3720E-01, .1526E-01, .5170E-02, &
1904 & .3399E-01, .1530E-01, .4773E-02, .3012E-01, .1551E-01, .4333E-02, &
1905 & .2625E-01, .1553E-01, .3956E-02, .2240E-01, .1562E-01, .3454E-02, &
1906 & .1846E-01, .1574E-01, .3161E-02, .1446E-01, .1572E-01, .3098E-02, &
1907 & .5924E-02, .8875E-02, .2658E-02, .2204E-01, .7096E-02, .2504E-02, &
1908 & .1591E-01, .5233E-02, .2292E-02, .8855E-02, .4249E-02, .2190E-02, &
1909 & .5422E-02, .3496E-02, .2041E-02, .4919E-02, .3621E-02, .2200E-02, &
1910 & .6657E-02, .3663E-02, .2248E-02, .8645E-02, .3852E-02, .2118E-02, &
1911 & .8771E-02, .3873E-02, .2176E-02, .9043E-02, .3747E-02, .2079E-02, &
1912 & -.1568E-03,-.4681E-04, .4567E-05,-.1568E-03,-.4605E-04,-.3425E-05, &
1913 & -.1572E-03,-.4605E-04,-.1104E-04,-.2154E-03,-.4453E-04,-.6851E-05, &
1914 & -.2843E-03,-.4225E-04,-.7231E-05,-.3562E-03,-.4110E-04,-.7231E-05, &
1915 & -.3692E-03,-.4110E-04,-.1028E-04,-.3007E-03,-.4263E-04,-.6470E-05, &
1916 & -.2325E-03,-.3996E-04,-.8373E-05,-.5290E-04,-.7612E-05,-.4948E-05, &
1917 & -.7422E-04,-.1256E-04,-.8449E-05,-.3501E-04,-.1446E-04,-.4834E-05, &
1918 & .4529E-04,-.2246E-04,-.2893E-05, .6470E-05,-.1789E-04,-.7498E-05, &
1919 & -.4948E-05,-.1713E-04,-.8183E-05,-.5481E-04,-.1713E-04,-.1447E-04, &
1920 & -.4986E-04,-.1903E-04,-.1353E-04,-.5138E-04,-.1484E-04,-.1147E-04, &
1921 & -.5328E-04,-.1560E-04,-.6588E-05/
1924 ! block data ckd9
1925 !c *********************************************************************
1926 !c hk is the interval in the g (cumulative probability) space from 0
1927 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1928 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
1929 !c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
1930 !c The spectral region is from 1700 to 1400 cm**-1.
1931 !c *********************************************************************
1932 ! common /band9/ hk(4), coeh2o(3,19,4)
1933 data hk_9 / 0.22, 0.51, 0.22, 0.05 /
1934 data ( ( ( coeh2o_9(k,j,i), i = 1, 4 ), j = 1, 19 ), k = 1, 3 ) / &
1935 & -.2066E+02,-.1464E+02,-.8301E+01,-.3548E+01,-.2025E+02,-.1419E+02, &
1936 & -.7905E+01,-.3260E+01,-.2019E+02,-.1374E+02,-.7495E+01,-.2927E+01, &
1937 & -.2013E+02,-.1329E+02,-.7078E+01,-.2584E+01,-.2007E+02,-.1284E+02, &
1938 & -.6675E+01,-.2247E+01,-.2001E+02,-.1239E+02,-.6268E+01,-.1890E+01, &
1939 & -.1996E+02,-.1194E+02,-.5853E+01,-.1530E+01,-.1991E+02,-.1150E+02, &
1940 & -.5441E+01,-.1133E+01,-.1987E+02,-.1105E+02,-.5022E+01,-.7447E+00, &
1941 & -.1575E+02,-.9657E+01,-.4191E+01,-.3728E+00,-.1329E+02,-.8133E+01, &
1942 & -.3638E+01, .1616E-01,-.1181E+02,-.6675E+01,-.3178E+01, .4083E+00, &
1943 & -.1036E+02,-.5655E+01,-.2731E+01, .7953E+00,-.8628E+01,-.4990E+01, &
1944 & -.2303E+01, .1153E+01,-.7223E+01,-.4453E+01,-.1877E+01, .1454E+01, &
1945 & -.6567E+01,-.3974E+01,-.1461E+01, .1663E+01,-.6077E+01,-.3551E+01, &
1946 & -.1071E+01, .1800E+01,-.5651E+01,-.3136E+01,-.7005E+00, .1809E+01, &
1947 & -.5241E+01,-.2726E+01,-.3859E+00, .1781E+01, .1315E-01, .4542E-02, &
1948 & .3496E-02, .4877E-02, .9650E-02, .4542E-02, .3098E-02, .3956E-02, &
1949 & .6154E-02, .4626E-02, .2763E-02, .3077E-02, .2658E-02, .4626E-02, &
1950 & .2512E-02, .2261E-02, .2658E-02, .4689E-02, .2219E-02, .1405E-02, &
1951 & .2700E-02, .4752E-02, .1926E-02, .7473E-03, .2658E-02, .4773E-02, &
1952 & .1737E-02, .5066E-03, .4668E-02, .4815E-02, .1507E-02, .1842E-03, &
1953 & .8541E-02, .4794E-02, .1382E-02,-.2156E-03, .1022E-01, .2198E-02, &
1954 & .3977E-03,-.2910E-03, .5484E-02, .6698E-03, .0000E+00,-.2339E-03, &
1955 & .3349E-02, .1068E-02,-.2512E-03,-.4228E-03, .1884E-02, .2093E-03, &
1956 & -.3977E-03,-.6405E-03,-.8373E-04,-.5233E-03,-.4124E-03,-.5945E-03, &
1957 & .7536E-03,-.6698E-03,-.4919E-03,-.4794E-03, .3600E-02,-.4605E-03, &
1958 & -.4375E-03,-.3517E-03, .3873E-02,-.5861E-03,-.3203E-03,-.4689E-03, &
1959 & .3935E-02,-.7326E-03,-.2072E-03,-.4228E-03, .4124E-02,-.8582E-03, &
1960 & -.4187E-04,-.5945E-03,-.8525E-04, .1865E-04,-.1142E-05, .2664E-05, &
1961 & -.1313E-03, .1865E-04, .0000E+00, .1256E-04,-.6470E-04, .1865E-04, &
1962 & -.3045E-05, .8754E-05, .3805E-06, .1789E-04,-.6851E-05, .5328E-05, &
1963 & .1142E-05, .1827E-04,-.6090E-05, .4148E-05, .1142E-05, .1865E-04, &
1964 & -.3806E-05,-.3768E-05,-.1903E-05, .1751E-04,-.4948E-05, .3121E-05, &
1965 & .3159E-04, .1979E-04,-.3045E-05,-.9896E-06, .1005E-03, .1789E-04, &
1966 & -.6089E-05,-.1865E-05,-.2207E-04, .1941E-04, .1903E-05, .2322E-05, &
1967 & -.1675E-04, .6090E-05,-.7611E-06, .4397E-05, .3425E-04, .3806E-06, &
1968 & .1522E-05, .3806E-05, .4796E-04, .1522E-05,-.3806E-06, .3654E-05, &
1969 & -.6851E-05, .2664E-05,-.3920E-05,-.6850E-06,-.1370E-04, .5328E-05, &
1970 & -.6584E-05,-.8716E-05,-.8374E-10, .1522E-05,-.6356E-05, .1294E-05, &
1971 & -.9515E-05, .7612E-06,-.3235E-05,-.1066E-05,-.7612E-05, .1142E-05, &
1972 & -.4529E-05, .3730E-05,-.2664E-05,-.3806E-06,-.3501E-05,-.5328E-06/
1975 ! block data ckd10
1976 !c *********************************************************************
1977 !c hk is the interval in the g (cumulative probability) space from 0
1978 !c to one. coeh2o is the coefficient to calculate the H2O absorption
1979 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
1980 !c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
1981 !c The spectral region is from 1400 to 1250 cm**-1. coech4 and coen2o
1982 !c are the coefficients to calculate the CH4 and N2O absorption coe-
1983 !c fficients in units of (cm-atm)**-1 at three temperature, nineteen
1984 !c pressures, and one cumulative probability (Fu, 1991), respectively.
1985 !c *********************************************************************
1986 ! common /band10/hk(4), coeh2o(3,19,4), coech4(3,19), coen2o(3,19)
1987 data hk_10 / 0.28, 0.42, 0.25, 0.05 /
1988 data ( ( ( coeh2o_10(k,j,i), i = 1, 4 ), j = 1, 19 ), k = 1, 3 ) / &
1989 & -.2023E+02,-.1641E+02,-.1171E+02,-.6090E+01,-.2016E+02,-.1595E+02, &
1990 & -.1133E+02,-.5867E+01,-.2011E+02,-.1550E+02,-.1095E+02,-.5660E+01, &
1991 & -.2005E+02,-.1504E+02,-.1055E+02,-.5407E+01,-.2001E+02,-.1459E+02, &
1992 & -.1015E+02,-.5137E+01,-.1997E+02,-.1413E+02,-.9749E+01,-.4852E+01, &
1993 & -.1993E+02,-.1367E+02,-.9337E+01,-.4534E+01,-.1990E+02,-.1321E+02, &
1994 & -.8920E+01,-.4211E+01,-.1987E+02,-.1276E+02,-.8506E+01,-.3889E+01, &
1995 & -.1645E+02,-.1179E+02,-.7711E+01,-.3613E+01,-.1442E+02,-.1081E+02, &
1996 & -.6942E+01,-.3316E+01,-.1308E+02,-.9950E+01,-.6344E+01,-.2950E+01, &
1997 & -.1212E+02,-.9217E+01,-.5904E+01,-.2577E+01,-.1131E+02,-.8559E+01, &
1998 & -.5519E+01,-.2256E+01,-.1064E+02,-.7962E+01,-.5183E+01,-.1929E+01, &
1999 & -.1013E+02,-.7447E+01,-.4833E+01,-.1643E+01,-.9712E+01,-.7071E+01, &
2000 & -.4485E+01,-.1410E+01,-.9305E+01,-.6760E+01,-.4145E+01,-.1249E+01, &
2001 & -.8966E+01,-.6477E+01,-.3820E+01,-.1114E+01, .7913E-02, .8206E-02, &
2002 & .1509E-01, .1869E-01, .4228E-02, .8247E-02, .1467E-01, .1783E-01, &
2003 & .2010E-02, .8227E-02, .1442E-01, .1687E-01, .1947E-02, .8289E-02, &
2004 & .1394E-01, .1568E-01, .1863E-02, .8289E-02, .1346E-01, .1484E-01, &
2005 & .1842E-02, .8415E-02, .1310E-01, .1400E-01, .1800E-02, .8457E-02, &
2006 & .1275E-01, .1377E-01, .1696E-02, .8478E-02, .1220E-01, .1321E-01, &
2007 & .1842E-02, .8478E-02, .1189E-01, .1250E-01, .1409E-01, .8624E-02, &
2008 & .1254E-01, .1214E-01, .9043E-02, .1045E-01, .1225E-01, .1260E-01, &
2009 & .8561E-02, .1202E-01, .1181E-01, .1296E-01, .1114E-01, .1235E-01, &
2010 & .1191E-01, .1330E-01, .1199E-01, .1271E-01, .1195E-01, .1371E-01, &
2011 & .1415E-01, .1315E-01, .1218E-01, .1361E-01, .1478E-01, .1338E-01, &
2012 & .1296E-01, .1306E-01, .1518E-01, .1375E-01, .1365E-01, .1334E-01, &
2013 & .1530E-01, .1411E-01, .1392E-01, .1327E-01, .1547E-01, .1507E-01, &
2014 & .1390E-01, .1264E-01,-.1089E-03,-.2740E-04,-.2017E-04,-.5519E-04, &
2015 & -.4491E-04,-.2740E-04,-.1408E-04,-.5937E-04,-.6090E-05,-.2702E-04, &
2016 & -.6470E-05,-.4719E-04,-.7232E-05,-.2740E-04,-.6089E-05,-.4910E-04, &
2017 & -.7231E-05,-.2969E-04,-.4186E-05,-.5366E-04,-.6090E-05,-.3045E-04, &
2018 & -.2284E-05,-.4986E-04,-.4568E-05,-.3121E-04,-.4948E-05,-.5100E-04, &
2019 & -.3426E-05,-.3007E-04,-.7993E-05,-.4910E-04, .1522E-05,-.2931E-04, &
2020 & -.9896E-05,-.5366E-04,-.5823E-04,-.1599E-04,-.1713E-04,-.4110E-04, &
2021 & -.3121E-04,-.1713E-04,-.3159E-04,-.3578E-04,-.3996E-04,-.1598E-04, &
2022 & -.3958E-04,-.4605E-04,-.3349E-04,-.1751E-04,-.3844E-04,-.5576E-04, &
2023 & -.2626E-04,-.2474E-04,-.3920E-04,-.4464E-04,-.1979E-04,-.3045E-04, &
2024 & -.3958E-04,-.5336E-04,-.2893E-04,-.3616E-04,-.3996E-04,-.4754E-04, &
2025 & -.2398E-04,-.3083E-04,-.4415E-04,-.5119E-04,-.2702E-04,-.2664E-04, &
2026 & -.4605E-04,-.4038E-04,-.2398E-04,-.2360E-04,-.4948E-04,-.5149E-04/
2027 data ( ( coech4_10(k,j), j = 1, 19 ), k = 1, 3 ) / &
2028 & -.8909E+01,-.8464E+01,-.8018E+01,-.7573E+01,-.7133E+01,-.6687E+01, &
2029 & -.6240E+01,-.5803E+01,-.5377E+01,-.4534E+01,-.3983E+01,-.3502E+01, &
2030 & -.3062E+01,-.2648E+01,-.2265E+01,-.1896E+01,-.1568E+01,-.1234E+01, &
2031 & -.9298E+00, .9629E-03, .9838E-03, .1088E-02, .1172E-02, .1256E-02, &
2032 & .1402E-02, .1528E-02, .1633E-02, .1716E-02, .4815E-03,-.3977E-03, &
2033 & -.5652E-03,-.5024E-03,-.4605E-03,-.4563E-03,-.4438E-03,-.4521E-03, &
2034 & -.4312E-03,-.3789E-03,-.1294E-04,-.1408E-04,-.1522E-04,-.1675E-04, &
2035 & -.1751E-04,-.1941E-04,-.2246E-04,-.2207E-04,-.1827E-04,-.1256E-04, &
2036 & -.9515E-05,-.6470E-05,-.3045E-05,-.3806E-05,-.2055E-05,-.3730E-05, &
2037 & -.7612E-06,-.3806E-05, .1256E-05/
2038 data ( ( coen2o_10(k,j), j = 1, 19 ), k = 1, 3 ) / &
2039 & -.7863E+01,-.7412E+01,-.6963E+01,-.6514E+01,-.6065E+01,-.5611E+01, &
2040 & -.5167E+01,-.4720E+01,-.4283E+01,-.3454E+01,-.2858E+01,-.2404E+01, &
2041 & -.1922E+01,-.1491E+01,-.1097E+01,-.7177E+00,-.3548E+00, .1218E-01, &
2042 & .3088E+00, .4459E-02, .4542E-02, .4668E-02, .4752E-02, .4815E-02, &
2043 & .4919E-02, .5087E-02, .5254E-02, .5296E-02, .2324E-02, .2093E-02, &
2044 & .2294E-02, .2125E-02, .2058E-02, .1920E-02, .1786E-02, .1689E-02, &
2045 & .1788E-02, .2144E-02,-.7231E-05,-.7231E-05,-.7231E-05,-.6470E-05, &
2046 & -.6851E-05,-.7231E-05,-.5709E-05,-.6470E-05,-.4186E-05, .8754E-05, &
2047 & -.7612E-05,-.9134E-06,-.8640E-05,-.8487E-05,-.8259E-05,-.9553E-05, &
2048 & -.8107E-05,-.1654E-04,-.1858E-04/
2051 ! block data ckd11
2052 !c *********************************************************************
2053 !c hk is the interval in the g (cumulative probability) space from 0
2054 !c to one. coeh2o is the coefficient to calculate the H2O absorption
2055 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
2056 !c teen pressures, and three cumulative probabilities ( Fu, 1991 ).
2057 !c The spectral region is from 1250 to 1100 cm**-1. coech4 and coen2o
2058 !c are the coefficients to calculate the CH4 and N2O absorption coe-
2059 !c fficients in units of (cm-atm)**-1 at three temperature, nineteen
2060 !c pressures, and one cumulative probability (Fu, 1991), respectively.
2061 !c *********************************************************************
2062 ! common /band11/hk(3), coeh2o(3,19,3), coech4(3,19), coen2o(3,19)
2063 data hk_11 / 0.80, 0.15, 0.05 /
2064 data ( ( ( coeh2o_11(k,j,i), i = 1, 3 ), j = 1, 19 ), k = 1, 3 ) / &
2065 & -.2005E+02,-.1548E+02,-.1021E+02,-.2001E+02,-.1504E+02,-.1001E+02, &
2066 & -.1997E+02,-.1459E+02,-.9814E+01,-.1993E+02,-.1416E+02,-.9595E+01, &
2067 & -.1989E+02,-.1373E+02,-.9349E+01,-.1985E+02,-.1328E+02,-.9072E+01, &
2068 & -.1982E+02,-.1286E+02,-.8833E+01,-.1957E+02,-.1243E+02,-.8566E+01, &
2069 & -.1911E+02,-.1200E+02,-.8276E+01,-.1743E+02,-.1134E+02,-.7958E+01, &
2070 & -.1625E+02,-.1078E+02,-.7629E+01,-.1524E+02,-.1036E+02,-.7334E+01, &
2071 & -.1429E+02,-.9970E+01,-.7051E+01,-.1348E+02,-.9620E+01,-.6749E+01, &
2072 & -.1282E+02,-.9270E+01,-.6505E+01,-.1229E+02,-.8932E+01,-.6277E+01, &
2073 & -.1186E+02,-.8628E+01,-.6120E+01,-.1148E+02,-.8345E+01,-.6049E+01, &
2074 & -.1112E+02,-.8066E+01,-.5906E+01, .1842E-02, .2131E-01, .3033E-01, &
2075 & .1905E-02, .2137E-01, .2841E-01, .1926E-02, .2135E-01, .2696E-01, &
2076 & .1926E-02, .2133E-01, .2514E-01, .1884E-02, .2154E-01, .2401E-01, &
2077 & .5589E-02, .2156E-01, .2321E-01, .9483E-02, .2156E-01, .2210E-01, &
2078 & .1333E-01, .2150E-01, .2133E-01, .1725E-01, .2154E-01, .2074E-01, &
2079 & .2254E-01, .1999E-01, .2005E-01, .2118E-01, .1926E-01, .1978E-01, &
2080 & .1936E-01, .1920E-01, .1963E-01, .1905E-01, .1911E-01, .1934E-01, &
2081 & .1909E-01, .1903E-01, .1920E-01, .1922E-01, .1901E-01, .1899E-01, &
2082 & .1934E-01, .1930E-01, .1974E-01, .1966E-01, .1909E-01, .2014E-01, &
2083 & .1976E-01, .1905E-01, .1984E-01, .1963E-01, .1940E-01, .1897E-01, &
2084 & -.1522E-05,-.6013E-04,-.5062E-04,-.2665E-05,-.6204E-04,-.5519E-04, &
2085 & -.3806E-05,-.6394E-04,-.5633E-04,-.4567E-05,-.6280E-04,-.5214E-04, &
2086 & -.6090E-05,-.6128E-04,-.5290E-04, .6051E-04,-.6242E-04,-.5823E-04, &
2087 & .1313E-03,-.6013E-04,-.5176E-04, .1336E-03,-.5747E-04,-.4072E-04, &
2088 & .6318E-04,-.5671E-04,-.3996E-04,-.5595E-04,-.3996E-04,-.4263E-04, &
2089 & -.3958E-04,-.4719E-04,-.4453E-04,-.3387E-04,-.5138E-04,-.5100E-04, &
2090 & -.5252E-04,-.4986E-04,-.4491E-04,-.5100E-04,-.4453E-04,-.4529E-04, &
2091 & -.5176E-04,-.4795E-04,-.4453E-04,-.5557E-04,-.5176E-04,-.5062E-04, &
2092 & -.5747E-04,-.4795E-04,-.5633E-04,-.5709E-04,-.4643E-04,-.3806E-04, &
2093 & -.5481E-04,-.5671E-04,-.4948E-04/
2094 data ( ( coech4_11(k,j), j = 1, 19 ), k = 1, 3 ) / &
2095 & -.1207E+02,-.1162E+02,-.1116E+02,-.1070E+02,-.1024E+02,-.9777E+01, &
2096 & -.9319E+01,-.8858E+01,-.8398E+01,-.7384E+01,-.6643E+01,-.6081E+01, &
2097 & -.5602E+01,-.5188E+01,-.4822E+01,-.4479E+01,-.4184E+01,-.3884E+01, &
2098 & -.3627E+01, .1036E-01, .1036E-01, .1040E-01, .1040E-01, .1045E-01, &
2099 & .1047E-01, .1049E-01, .1055E-01, .1059E-01, .1059E-01, .1026E-01, &
2100 & .1011E-01, .1024E-01, .1049E-01, .1072E-01, .1089E-01, .1109E-01, &
2101 & .1153E-01, .1191E-01,-.4910E-04,-.4834E-04,-.4910E-04,-.4910E-04, &
2102 & -.4910E-04,-.4872E-04,-.4834E-04,-.4948E-04,-.5100E-04,-.5633E-04, &
2103 & -.6166E-04,-.5595E-04,-.5366E-04,-.5366E-04,-.5328E-04,-.5328E-04, &
2104 & -.4948E-04,-.5519E-04,-.5595E-04/
2105 data ( ( coen2o_11(k,j), j = 1, 19 ), k = 1, 3 ) / &
2106 -.9461E+01,-.9003E+01,-.8543E+01,-.8084E+01,-.7629E+01,-.7166E+01, &
2107 & -.6707E+01,-.6249E+01,-.5793E+01,-.5312E+01,-.4847E+01,-.4393E+01, &
2108 & -.3974E+01,-.3587E+01,-.3231E+01,-.2885E+01,-.2602E+01,-.2358E+01, &
2109 & -.2108E+01, .4710E-02, .4752E-02, .4773E-02, .4773E-02, .4815E-02, &
2110 & .4877E-02, .4898E-02, .4982E-02, .5066E-02, .5296E-02, .5149E-02, &
2111 & .5129E-02, .5024E-02, .4752E-02, .4501E-02, .4270E-02, .4019E-02, &
2112 & .3646E-02, .2759E-02,-.1484E-04,-.1408E-04,-.1446E-04,-.1446E-04, &
2113 & -.1522E-04,-.1560E-04,-.1522E-04,-.1522E-04,-.1598E-04,-.1484E-04, &
2114 & -.9895E-05,-.1028E-04,-.7612E-05,-.1903E-05, .1903E-05, .0000E+00, &
2115 & .2283E-05, .6166E-05,-.2740E-05/
2118 ! block data ckd12
2119 !c *********************************************************************
2120 !c hk is the interval in the g (cumulative probability) space from 0
2121 !c to one. coeo3 is the coefficient to calculate the ozone absorption
2122 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
2123 !c teen pressures, and five cumulative probabilities ( Fu, 1991 ).
2124 !c The spectral region is from 1100 to 980 cm**-1. coeh2o is the
2125 !c coefficient to calculate the H2O absorption coefficient in units
2126 !c of (cm-atm)**-1 at three temperature, nineteen pressures, and one
2127 !c cumulative probability ( Fu, 1991 ).
2128 !c *********************************************************************
2129 ! common /band12/ hk(5), coeo3(3,19,5), coeh2o(3,19)
2130 data hk_12 / 0.45, 0.30, 0.2, 0.04, 0.01 /
2131 data ( ( ( coeo3_12(k,j,i), i = 1, 5 ), j = 1, 19 ), k = 1, 3 ) / &
2132 & -.6590E+01,-.3912E+01,-.8513E+00, .2731E+01, .5515E+01,-.6157E+01, &
2133 & -.3583E+01,-.7292E+00, .2740E+01, .5508E+01,-.5731E+01,-.3242E+01, &
2134 & -.5800E+00, .2782E+01, .5485E+01,-.5301E+01,-.2901E+01,-.4131E+00, &
2135 & .2805E+01, .5455E+01,-.4879E+01,-.2551E+01,-.2288E+00, .2878E+01, &
2136 & .5416E+01,-.4449E+01,-.2201E+01,-.2228E-01, .3000E+01, .5374E+01, &
2137 & -.4018E+01,-.1843E+01, .2055E+00, .3143E+01, .5342E+01,-.3615E+01, &
2138 & -.1502E+01, .4561E+00, .3288E+01, .5204E+01,-.3228E+01,-.1172E+01, &
2139 & .7099E+00, .3396E+01, .5077E+01,-.2828E+01,-.8499E+00, .9664E+00, &
2140 & .3463E+01, .4893E+01,-.2480E+01,-.5393E+00, .1229E+01, .3493E+01, &
2141 & .4656E+01,-.2181E+01,-.2653E+00, .1504E+01, .3456E+01, .4398E+01, &
2142 & -.1950E+01,-.1469E-01, .1735E+01, .3387E+01, .4115E+01,-.1788E+01, &
2143 & .2517E+00, .1919E+01, .3251E+01, .3832E+01,-.1677E+01, .5027E+00, &
2144 & .2032E+01, .3088E+01, .3581E+01,-.1637E+01, .7373E+00, .2100E+01, &
2145 & .2910E+01, .3364E+01,-.1650E+01, .9383E+00, .2123E+01, .2793E+01, &
2146 & .3150E+01,-.1658E+01, .1091E+01, .2112E+01, .2683E+01, .3021E+01, &
2147 & -.1654E+01, .1163E+01, .2099E+01, .2602E+01, .2871E+01, .9498E-02, &
2148 & .8894E-02, .1161E-01, .8828E-02,-.1669E-02, .9613E-02, .8347E-02, &
2149 & .1053E-01, .8462E-02,-.1612E-02, .9700E-02, .7829E-02, .9101E-02, &
2150 & .7915E-02,-.1439E-02, .9815E-02, .7167E-02, .7981E-02, .7282E-02, &
2151 & -.1094E-02, .9671E-02, .6764E-02, .6930E-02, .5613E-02,-.8347E-03, &
2152 & .9613E-02, .6312E-02, .6225E-02, .4145E-02,-.1295E-02, .9728E-02, &
2153 & .6099E-02, .5293E-02, .2965E-02,-.1756E-02, .9844E-02, .5915E-02, &
2154 & .4496E-02, .1871E-02,-.2044E-02, .9930E-02, .5817E-02, .3509E-02, &
2155 & .1324E-02,-.2044E-02, .9988E-02, .5535E-02, .2711E-02, .6620E-03, &
2156 & -.1813E-02, .1034E-01, .5247E-02, .1926E-02,-.2303E-03,-.1842E-02, &
2157 & .1058E-01, .4795E-02, .1197E-02,-.9498E-03,-.2216E-02, .1084E-01, &
2158 & .4414E-02, .6188E-03,-.1123E-02,-.2303E-02, .1079E-01, .3926E-02, &
2159 & .1756E-03,-.1497E-02,-.2274E-02, .1039E-01, .3425E-02,-.1900E-03, &
2160 & -.1353E-02,-.2389E-02, .9815E-02, .2769E-02,-.6620E-03,-.1756E-02, &
2161 & -.1785E-02, .9818E-02, .2444E-02,-.1016E-02,-.1410E-02,-.1698E-02, &
2162 & .1074E-01, .3218E-02,-.1235E-02,-.1900E-02,-.2533E-02, .1145E-01, &
2163 & .3684E-02,-.1364E-02,-.1353E-02,-.1957E-02,-.4030E-04,-.2375E-04, &
2164 & -.3814E-05,-.4943E-04,-.3166E-04,-.3742E-04,-.1871E-04,-.1137E-04, &
2165 & -.4317E-04,-.2878E-04,-.3526E-04,-.2015E-04,-.1295E-04,-.4821E-04, &
2166 & -.2303E-04,-.3382E-04,-.2087E-04,-.1519E-04,-.2231E-04,-.1871E-04, &
2167 & -.3454E-04,-.2087E-04,-.8109E-05,-.6476E-05,-.1511E-04,-.3454E-04, &
2168 & -.1820E-04,-.1269E-05,-.1439E-04,-.5037E-05,-.4173E-04,-.2598E-04, &
2169 & .6645E-05,-.1943E-04,-.2087E-04,-.3454E-04,-.2267E-04, .2159E-05, &
2170 & -.2231E-04,-.2159E-05,-.2950E-04,-.2080E-04, .2159E-06,-.4317E-05, &
2171 & .1799E-04,-.3670E-04,-.1590E-04,-.4461E-05,-.9354E-05,-.3598E-05, &
2172 & -.3216E-04,-.1475E-04,-.2231E-05,-.1295E-04,-.2878E-05,-.3576E-04, &
2173 & -.7347E-05,-.1022E-04,-.2159E-05,-.7915E-05,-.3015E-04,-.5230E-05, &
2174 & -.5109E-05,-.6476E-05,-.7196E-05,-.2331E-04,-.1079E-04,-.4102E-05, &
2175 & .1439E-05,-.1223E-04,-.2216E-04,-.1094E-04,-.5325E-05,-.7196E-06, &
2176 & -.1655E-04,-.1036E-04,-.7627E-05,-.2878E-05, .5037E-05,-.1295E-04, &
2177 & .1029E-04,-.1346E-04,-.4821E-05,-.7915E-05, .7915E-05, .2835E-04, &
2178 & -.2893E-04,-.1367E-05,-.7196E-05,-.1871E-04, .3965E-04,-.3310E-04, &
2179 & -.3310E-05,-.7195E-06, .2303E-04/
2180 data ( ( coeh2o_12(k,j), j = 1, 19 ), k = 1, 3 ) / &
2181 & -.1984E+02,-.1983E+02,-.1982E+02,-.1981E+02,-.1963E+02,-.1917E+02, &
2182 & -.1871E+02,-.1825E+02,-.1779E+02,-.1639E+02,-.1545E+02,-.1484E+02, &
2183 & -.1433E+02,-.1387E+02,-.1345E+02,-.1305E+02,-.1268E+02,-.1231E+02, &
2184 & -.1196E+02, .6071E-03, .2072E-02, .6196E-02, .1030E-01, .1436E-01, &
2185 & .1846E-01, .2259E-01, .2667E-01, .2993E-01, .2878E-01, .2803E-01, &
2186 & .2851E-01, .2864E-01, .2874E-01, .2862E-01, .2859E-01, .2853E-01, &
2187 & .2868E-01, .2887E-01,-.3808E-06, .2474E-04, .9895E-04, .1728E-03, &
2188 & .1911E-03, .1165E-03, .4225E-04,-.3121E-04,-.8982E-04,-.9553E-04, &
2189 & -.9705E-04,-.9591E-04,-.9287E-04,-.9172E-04,-.9096E-04,-.9134E-04, &
2190 & -.9248E-04,-.1050E-03,-.1031E-03/
2193 ! block data ckd13
2194 !c *********************************************************************
2195 !c hk is the interval in the g (cumulative probability) space from 0
2196 !c to one. coeh2o is the coefficient to calculate the H2O absorption
2197 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
2198 !c teen pressures, and two cumulative probabilities ( Fu, 1991 ).
2199 !c The spectral region is from 980 to 800 cm**-1.
2200 !c *********************************************************************
2201 ! common /band13/ hk(2), coeh2o(3,19,2)
2202 data hk_13 / 0.95, 0.05 /
2203 data ( ( ( coeh2o_13(k,j,i), i = 1, 2 ), j = 1, 19 ), k = 1, 3 ) / &
2204 & -.1992E+02,-.1446E+02,-.1992E+02,-.1405E+02,-.1991E+02,-.1363E+02, &
2205 & -.1990E+02,-.1322E+02,-.1989E+02,-.1282E+02,-.1989E+02,-.1242E+02, &
2206 & -.1988E+02,-.1201E+02,-.1987E+02,-.1159E+02,-.1986E+02,-.1119E+02, &
2207 & -.1982E+02,-.1079E+02,-.1817E+02,-.1039E+02,-.1659E+02,-.1000E+02, &
2208 & -.1537E+02,-.9623E+01,-.1460E+02,-.9266E+01,-.1406E+02,-.8959E+01, &
2209 & -.1354E+02,-.8676E+01,-.1309E+02,-.8411E+01,-.1267E+02,-.8232E+01, &
2210 & -.1229E+02,-.8094E+01, .5024E-03, .3199E-01, .5652E-03, .3199E-01, &
2211 & .6071E-03, .3211E-01, .6489E-03, .3199E-01, .6699E-03, .3178E-01, &
2212 & .6908E-03, .3157E-01, .6908E-03, .3109E-01, .6698E-03, .3075E-01, &
2213 & .6698E-03, .3054E-01, .1474E-01, .3000E-01, .3085E-01, .2960E-01, &
2214 & .3659E-01, .2935E-01, .3016E-01, .2920E-01, .2834E-01, .2895E-01, &
2215 & .2780E-01, .2870E-01, .2753E-01, .2843E-01, .2755E-01, .2820E-01, &
2216 & .2765E-01, .2732E-01, .2769E-01, .2705E-01, .6299E-09,-.7993E-04, &
2217 & -.3802E-06,-.7992E-04,-.3802E-06,-.8525E-04,-.3808E-06,-.8449E-04, &
2218 & -.7610E-06,-.7764E-04,-.1142E-05,-.7231E-04,-.1142E-05,-.7345E-04, &
2219 & -.2284E-05,-.8259E-04,-.2284E-05,-.8031E-04, .2436E-03,-.7878E-04, &
2220 & .7612E-05,-.8525E-04,-.1248E-03,-.9439E-04,-.9477E-04,-.9172E-04, &
2221 & -.8982E-04,-.8640E-04,-.7916E-04,-.6813E-04,-.7574E-04,-.6090E-04, &
2222 & -.7612E-04,-.7117E-04,-.7498E-04,-.7041E-04,-.7269E-04,-.7992E-04/
2225 ! block data ckd14
2226 !c **********************************************************************
2227 !c hk is the interval in the g (cumulative probability) space from 0
2228 !c to one. coehca and coehcb are the coefficients to calculate the
2229 !c H2O and CO2 overlapping absorption coefficients in units of (cm-
2230 !c atm)**-1 at three temperature, nineteen pressures, and ten cumu-
2231 !c lative probabilities (Fu, 1991). The spectral region is from 800
2232 !c to 670 cm**-1.
2233 !c **********************************************************************
2234 ! common /band14/ hk(10), coehca(3,19,10), coehcb(3,19,10)
2235 data hk_14 / .3,.3,.2,.12,.06,.012,.004,.0025,.0011,.0004 /
2236 data ( ( ( coehca_14(k,j,i), i = 1, 10 ), j = 1, 19 ), k = 1, 3 ) / &
2237 & -.1847E+02,-.1399E+02,-.1106E+02,-.8539E+01,-.5852E+01,-.3295E+01, &
2238 & -.1208E+01,-.6272E-01, .2055E+01, .6071E+01,-.1801E+02,-.1357E+02, &
2239 & -.1067E+02,-.8171E+01,-.5562E+01,-.3071E+01,-.1073E+01, .1033E+00, &
2240 & .2055E+01, .6071E+01,-.1755E+02,-.1314E+02,-.1027E+02,-.7798E+01, &
2241 & -.5224E+01,-.2823E+01,-.9280E+00, .2723E+00, .2165E+01, .5969E+01, &
2242 & -.1709E+02,-.1272E+02,-.9868E+01,-.7404E+01,-.4880E+01,-.2569E+01, &
2243 & -.6908E+00, .4453E+00, .2241E+01, .5969E+01,-.1663E+02,-.1230E+02, &
2244 & -.9467E+01,-.7013E+01,-.4535E+01,-.2297E+01,-.4408E+00, .6353E+00, &
2245 & .2359E+01, .5969E+01,-.1617E+02,-.1188E+02,-.9050E+01,-.6619E+01, &
2246 & -.4160E+01,-.1967E+01,-.1687E+00, .8213E+00, .2421E+01, .5969E+01, &
2247 & -.1571E+02,-.1147E+02,-.8629E+01,-.6230E+01,-.3771E+01,-.1648E+01, &
2248 & .1573E+00, .1019E+01, .2511E+01, .5884E+01,-.1525E+02,-.1106E+02, &
2249 & -.8215E+01,-.5841E+01,-.3393E+01,-.1331E+01, .4013E+00, .1198E+01, &
2250 & .2654E+01, .5794E+01,-.1480E+02,-.1066E+02,-.7800E+01,-.5454E+01, &
2251 & -.3032E+01,-.9870E+00, .6323E+00, .1373E+01, .2905E+01, .5647E+01, &
2252 & -.1402E+02,-.9693E+01,-.7206E+01,-.4846E+01,-.2656E+01,-.6540E+00, &
2253 & .8323E+00, .1530E+01, .3211E+01, .5355E+01,-.1343E+02,-.9060E+01, &
2254 & -.6596E+01,-.4399E+01,-.2294E+01,-.3519E+00, .9823E+00, .1673E+01, &
2255 & .3420E+01, .5083E+01,-.1279E+02,-.8611E+01,-.5785E+01,-.4010E+01, &
2256 & -.1936E+01,-.1177E+00, .1134E+01, .1974E+01, .3591E+01, .4770E+01, &
2257 & -.1230E+02,-.8174E+01,-.5298E+01,-.3611E+01,-.1607E+01, .3636E-01, &
2258 & .1433E+01, .2260E+01, .3539E+01, .4439E+01,-.1192E+02,-.7763E+01, &
2259 & -.4946E+01,-.3228E+01,-.1321E+01, .1991E+00, .1720E+01, .2420E+01, &
2260 & .3383E+01, .4041E+01,-.1154E+02,-.7377E+01,-.4576E+01,-.2851E+01, &
2261 & -.1093E+01, .4430E+00, .1896E+01, .2462E+01, .3122E+01, .3620E+01, &
2262 & -.1118E+02,-.7003E+01,-.4210E+01,-.2524E+01,-.8973E+00, .7490E+00, &
2263 & .1966E+01, .2363E+01, .2818E+01, .3182E+01,-.1080E+02,-.6677E+01, &
2264 & -.3872E+01,-.2264E+01,-.6846E+00, .9392E+00, .1867E+01, .2138E+01, &
2265 & .2505E+01, .2738E+01,-.1031E+02,-.6353E+01,-.3596E+01,-.1938E+01, &
2266 & -.4537E+00, .1015E+01, .1659E+01, .1830E+01, .2142E+01, .2287E+01, &
2267 & -.9695E+01,-.5977E+01,-.3427E+01,-.1596E+01,-.1979E+00, .9458E+00, &
2268 & .1363E+01, .1545E+01, .1743E+01, .1832E+01, .3628E-01, .2728E-01, &
2269 & .2213E-01, .1656E-01, .1507E-01, .1564E-01, .1623E-01, .1419E-01, &
2270 & .1455E-01, .1089E-02, .3632E-01, .2740E-01, .2164E-01, .1606E-01, &
2271 & .1369E-01, .1418E-01, .1444E-01, .1275E-01, .1331E-01, .9210E-03, &
2272 & .3636E-01, .2746E-01, .2114E-01, .1557E-01, .1239E-01, .1285E-01, &
2273 & .1237E-01, .1141E-01, .1141E-01, .9210E-03, .3640E-01, .2748E-01, &
2274 & .2064E-01, .1516E-01, .1141E-01, .1125E-01, .1092E-01, .1026E-01, &
2275 & .1011E-01,-.5652E-03, .3646E-01, .2746E-01, .2024E-01, .1478E-01, &
2276 & .1036E-01, .9688E-02, .9610E-02, .9305E-02, .9399E-02,-.6489E-03, &
2277 & .3651E-01, .2734E-01, .1984E-01, .1438E-01, .9436E-02, .8486E-02, &
2278 & .8214E-02, .8995E-02, .7892E-02,-.8582E-03, .3655E-01, .2723E-01, &
2279 & .1951E-01, .1402E-01, .8716E-02, .7433E-02, .7169E-02, .8072E-02, &
2280 & .5443E-02,-.1172E-02, .3659E-01, .2709E-01, .1911E-01, .1379E-01, &
2281 & .8107E-02, .6818E-02, .6818E-02, .7033E-02, .3056E-02,-.1047E-02, &
2282 & .3670E-01, .2698E-01, .1890E-01, .1363E-01, .7502E-02, .6371E-02, &
2283 & .6558E-02, .6489E-02,-.5652E-03,-.1340E-02, .3592E-01, .2238E-01, &
2284 & .1804E-01, .1007E-01, .6730E-02, .5512E-02, .6194E-02, .4375E-02, &
2285 & -.1109E-02,-.3559E-03, .3609E-01, .2242E-01, .1526E-01, .8582E-02, &
2286 & .6284E-02, .5809E-02, .4501E-02, .9420E-03,-.9001E-03,-.1005E-02, &
2287 & .3703E-01, .2196E-01, .1281E-01, .7860E-02, .5861E-02, .5842E-02, &
2288 & .1800E-02,-.1591E-02,-.1235E-02,-.9420E-03, .3728E-01, .2114E-01, &
2289 & .1347E-01, .6678E-02, .5449E-02, .4837E-02,-.1084E-02,-.1361E-02, &
2290 & -.6699E-03,-.1256E-03, .3683E-01, .2061E-01, .1350E-01, .6133E-02, &
2291 & .5449E-02, .2111E-02,-.1386E-02,-.1235E-02,-.5652E-03,-.8373E-04, &
2292 & .3656E-01, .1988E-01, .1348E-01, .5441E-02, .5149E-02,-.8813E-03, &
2293 & -.1116E-02,-.8373E-03,-.3140E-03,-.6280E-04, .3669E-01, .1934E-01, &
2294 & .1363E-01, .5035E-02, .3585E-02,-.1250E-02,-.9357E-03,-.8227E-03, &
2295 & -.3140E-03,-.4187E-04, .3618E-01, .1856E-01, .1390E-01, .3836E-02, &
2296 & .1470E-02,-.1096E-02,-.8080E-03,-.4480E-03,-.2093E-03,-.2093E-04, &
2297 & .3416E-01, .1741E-01, .1431E-01, .1951E-02,-.2923E-04,-.9422E-03, &
2298 & -.4576E-03,-.2395E-03,-.1565E-03,-.2799E-04, .3219E-01, .1674E-01, &
2299 & .1516E-01, .6652E-03,-.5051E-03,-.7052E-03,-.2002E-03,-.2135E-03, &
2300 & -.7633E-04,-.7300E-04,-.1290E-03,-.9934E-04,-.5595E-04,-.3996E-04, &
2301 & .1294E-04,-.9134E-05, .1294E-05,-.3121E-05,-.4757E-04,-.1979E-04, &
2302 & -.1305E-03,-.9629E-04,-.5481E-04,-.4301E-04, .1827E-04,-.9363E-05, &
2303 & .1777E-04,-.2185E-04,-.1903E-04,-.1675E-04,-.1313E-03,-.9439E-04, &
2304 & -.5404E-04,-.4263E-04, .9134E-05,-.1020E-04, .3524E-04,-.2599E-04, &
2305 & -.2093E-04, .1675E-04,-.1313E-03,-.9172E-04,-.5252E-04,-.4567E-04, &
2306 & .4186E-05,-.3920E-05, .2552E-04,-.2059E-04,-.2246E-04,-.1028E-04, &
2307 & -.1324E-03,-.9210E-04,-.5138E-04,-.4491E-04, .6470E-05,-.2131E-05, &
2308 & .1496E-04,-.1572E-04,-.3311E-04,-.8754E-05,-.1324E-03,-.9058E-04, &
2309 & -.5328E-04,-.4225E-04, .1827E-05,-.8411E-06, .4719E-05,-.6813E-05, &
2310 & -.2474E-04,-.1256E-04,-.1340E-03,-.8868E-04,-.5633E-04,-.4187E-04, &
2311 & -.4415E-05, .6055E-05,-.1648E-04,-.1507E-04, .1979E-04,-.2131E-04, &
2312 & -.1340E-03,-.8373E-04,-.5899E-04,-.3920E-04,-.4072E-05, .1491E-04, &
2313 & -.9781E-05,-.5328E-05, .3578E-04,-.1979E-04,-.1321E-03,-.7954E-04, &
2314 & -.5899E-04,-.4072E-04, .1066E-05, .5728E-05,-.5138E-05,-.8373E-05, &
2315 & .2626E-04,-.2436E-04,-.1363E-03,-.6432E-04,-.5176E-04,-.3083E-04, &
2316 & .2169E-05,-.8944E-05, .3159E-05, .6470E-05,-.4187E-05, .4948E-05, &
2317 & -.1302E-03,-.7802E-04,-.3311E-04,-.1903E-04, .5328E-05,-.1884E-04, &
2318 & .1408E-04, .3311E-04, .1142E-05,-.7613E-06,-.1473E-03,-.6737E-04, &
2319 & -.7536E-04,-.1085E-04,-.1903E-05,-.1458E-04, .4034E-04,-.3941E-10, &
2320 & -.7992E-05, .2664E-05,-.1361E-03,-.5709E-04,-.8550E-04,-.5709E-05, &
2321 & -.8640E-05, .6523E-05, .1903E-05,-.8221E-05,-.3045E-05,-.9134E-05, &
2322 & -.1329E-03,-.5529E-04,-.7107E-04, .2664E-05,-.9020E-05, .3320E-04, &
2323 & -.2131E-05,-.4187E-05,-.7231E-05,-.3806E-05,-.1278E-03,-.5247E-04, &
2324 & -.6465E-04, .3806E-05,-.6091E-05, .1245E-04,-.3844E-05,-.6090E-05, &
2325 & -.8754E-05,-.2664E-05,-.1321E-03,-.5632E-04,-.5897E-04, .1012E-04, &
2326 & .1168E-04,-.4196E-06,-.8411E-05,-.8868E-05,-.1484E-04,-.1522E-05, &
2327 & -.1252E-03,-.4907E-04,-.5932E-04, .3245E-04, .1996E-04,-.3325E-05, &
2328 & -.5785E-05,-.6394E-05,-.6851E-05,-.1142E-05,-.1093E-03,-.4731E-04, &
2329 & -.6761E-04, .1808E-04, .1754E-04,-.5079E-05,-.5809E-05,-.5649E-05, &
2330 & -.3988E-05,-.5849E-06,-.1151E-03,-.4965E-04,-.7163E-04, .7839E-05, &
2331 & .5505E-05,-.6084E-05,-.3344E-05,-.3894E-05,-.1391E-05,-.1327E-05/
2332 data ( ( ( coehcb_14(k,j,i), i = 1, 10 ), j = 1, 19 ), k = 1, 3 ) / &
2333 & -.9398E+01,-.5678E+01,-.3606E+01,-.2192E+01, .2104E+01, .3044E+01, &
2334 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.9094E+01,-.5422E+01, &
2335 & -.3448E+01,-.1650E+01, .2046E+01, .2749E+01,-.4587E+02,-.4587E+02, &
2336 & -.4587E+02,-.4587E+02,-.8760E+01,-.5270E+01,-.3329E+01,-.1147E+01, &
2337 & .2112E+01, .2709E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2338 & -.8537E+01,-.5152E+01,-.3129E+01,-.9544E+00, .2254E+01, .2771E+01, &
2339 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.8176E+01,-.4936E+01, &
2340 & -.2680E+01,-.9259E+00, .2247E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2341 & -.4587E+02,-.4587E+02,-.7836E+01,-.4676E+01,-.2378E+01,-.3550E+00, &
2342 & .1396E+01, .1976E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2343 & -.7419E+01,-.4122E+01,-.2407E+01,-.1204E-01, .1744E+01,-.4587E+02, &
2344 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.7124E+01,-.3727E+01, &
2345 & -.2160E+01, .6158E+00, .1953E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2346 & -.4587E+02,-.4587E+02,-.6823E+01,-.3324E+01,-.1748E+01,-.9806E-01, &
2347 & .2319E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2348 & -.5957E+01,-.3017E+01,-.1647E+01, .1398E+01,-.4587E+02,-.4587E+02, &
2349 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.5115E+01,-.2290E+01, &
2350 & -.5273E+00, .5662E+00, .1459E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2351 & -.4587E+02,-.4587E+02,-.4162E+01,-.1453E+01, .1116E+00,-.4587E+02, &
2352 & .9569E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2353 & -.3611E+01,-.9744E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2354 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.3075E+01,-.4176E+00, &
2355 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2356 & -.4587E+02,-.4587E+02,-.3469E+01,-.9395E+00, .5092E+00, .6200E+00, &
2357 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2358 & -.3808E+01,-.1505E+01, .3901E+00, .6264E+00,-.1155E+01,-.4587E+02, &
2359 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4058E+01,-.1818E+01, &
2360 & .2693E+00, .7087E+00, .3820E+00,-.4587E+02,-.4587E+02,-.4587E+02, &
2361 & -.4587E+02,-.4587E+02,-.4262E+01,-.2097E+01,-.5711E-01, .5681E+00, &
2362 & .1310E+01, .7371E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2363 & -.3997E+01,-.1784E+01, .4388E-01, .5167E+00, .6930E+00,-.6906E+00, &
2364 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, .2944E-01, .2723E-01, &
2365 & .1854E-01, .2023E-01, .2254E-01, .3059E-02, .4788E+00, .3059E-02, &
2366 & .3059E-02, .3059E-02, .3080E-01, .2549E-01, .1547E-01, .2225E-01, &
2367 & .2107E-01, .3059E-02, .4737E+00, .3059E-02, .3059E-02, .3059E-02, &
2368 & .3269E-01, .2656E-01, .2125E-01, .2179E-01, .2162E-01, .4589E+00, &
2369 & .4643E+00, .3059E-02, .3059E-02, .3059E-02, .3322E-01, .2476E-01, &
2370 & .2075E-01, .2139E-01, .1907E-01, .4501E+00, .4441E+00, .3059E-02, &
2371 & .3059E-02, .3059E-02, .3387E-01, .2182E-01, .2665E-01, .1841E-01, &
2372 & .2506E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2373 & .3532E-01, .2091E-01, .1995E-01, .2067E-01, .1949E-01, .4491E+00, &
2374 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3468E-01, .2075E-01, &
2375 & .2587E-01, .1401E-01, .8646E-02, .3059E-02, .3059E-02, .3059E-02, &
2376 & .3059E-02, .3059E-02, .3666E-01, .2430E-01, .1919E-01, .2007E-01, &
2377 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2378 & .3613E-01, .2147E-01, .1892E-01, .1361E-01, .3059E-02, .4506E+00, &
2379 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3129E-01, .1954E-01, &
2380 & .2442E-01, .1011E-01, .4420E+00, .3059E-02, .3059E-02, .3059E-02, &
2381 & .3059E-02, .3059E-02, .3177E-01, .2101E-01, .1526E-01, .4376E+00, &
2382 & .4379E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2383 & .2887E-01, .2044E-01, .1285E-01, .3059E-02,-.4862E-03, .3059E-02, &
2384 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2759E-01, .2114E-01, &
2385 & .4303E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2386 & .3059E-02, .3059E-02, .2880E-01, .1690E-01,-.4187E+00, .3059E-02, &
2387 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2388 & .2852E-01, .2255E-01, .2184E-01, .4334E+00, .4217E+00, .3059E-02, &
2389 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2840E-01, .2136E-01, &
2390 & .1644E-01, .2812E-01, .4358E+00, .4288E+00, .3059E-02, .3059E-02, &
2391 & .3059E-02, .3059E-02, .2809E-01, .2173E-01, .1708E-01, .3346E-01, &
2392 & .4225E-01, .4419E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2393 & .2702E-01, .2260E-01, .1607E-01, .2720E-01, .3982E-01, .4452E+00, &
2394 & .4365E+00, .4345E+00, .4432E+00, .4623E+00, .2684E-01, .2328E-01, &
2395 & .2099E-01, .3040E-01, .3867E-01, .4389E+00, .3132E-01, .3158E-01, &
2396 & .4083E-01, .4580E+00,-.1581E-03,-.9707E-04,-.1250E-03, .2580E-03, &
2397 & .7378E-04,-.1617E-01, .8646E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2398 & -.1319E-03,-.9528E-04,-.1710E-03, .7118E-04, .2076E-04,-.1608E-01, &
2399 & .8552E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.1721E-03,-.4680E-04, &
2400 & -.5522E-04,-.6242E-04, .4517E-04,-.7777E-02, .8382E-02,-.4656E-05, &
2401 & -.4656E-05,-.4656E-05,-.1482E-03,-.4208E-04,-.5216E-04,-.6514E-04, &
2402 & -.8378E-04,-.7956E-02, .8013E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2403 & -.1501E-03,-.4002E-04,-.1664E-03, .2272E-04,-.1888E-03,-.4656E-05, &
2404 & -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1201E-03,-.4709E-04, &
2405 & -.5371E-04,-.1574E-03, .1854E-03,-.7712E-02,-.4656E-05,-.4656E-05, &
2406 & -.4656E-05,-.4656E-05,-.1333E-03,-.1062E-03, .5785E-04,-.4150E-04, &
2407 & -.5717E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2408 & -.1212E-03,-.8524E-04,-.5895E-04,-.2884E-03,-.1581E-01,-.4656E-05, &
2409 & -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.8148E-04,-.9361E-04, &
2410 & -.2873E-03, .1883E-03,-.1594E-01, .8133E-02,-.4656E-05,-.4656E-05, &
2411 & -.4656E-05,-.4656E-05,-.1221E-03,-.1430E-04, .6335E-04,-.2581E-03, &
2412 & .7977E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2413 & -.9257E-04,-.5008E-04, .6389E-04,-.7455E-02,-.7745E-02,-.4656E-05, &
2414 & -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1186E-03,-.9037E-04, &
2415 & -.7461E-04,-.4656E-05, .1168E-03,-.4656E-05,-.4656E-05,-.4656E-05, &
2416 & -.4656E-05,-.4656E-05,-.8513E-04,-.5708E-04, .7763E-02,-.4656E-05, &
2417 & -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2418 & -.1124E-03,-.1228E-03, .7663E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2419 & -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1015E-03,-.8369E-04, &
2420 & -.2167E-03,-.7548E-02, .7608E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2421 & -.4656E-05,-.4656E-05,-.1049E-03,-.6414E-04,-.1384E-03,-.1644E-03, &
2422 & -.6919E-02, .7736E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2423 & -.1008E-03,-.7047E-04,-.1276E-03,-.2445E-03,-.1860E-03, .7975E-02, &
2424 & -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.9629E-04,-.1007E-03, &
2425 & -.1127E-03,-.1527E-03,-.3238E-03,-.7373E-02, .7877E-02, .7840E-02, &
2426 & .7997E-02, .8345E-02,-.8800E-04,-.1072E-03,-.1046E-03,-.1777E-03, &
2427 & -.2146E-03,-.7016E-02, .1516E-01, .1532E-01, .1509E-01, .8268E-02/
2430 ! block data ckd15
2431 !c **********************************************************************
2432 !c hk is the interval in the g (cumulative probability) space from 0
2433 !c to one. coehca and coehcb are the coefficients to calculate the
2434 !c H2O and CO2 overlapping absorption coefficients in units of (cm-
2435 !c atm)**-1 at three temperatures, nineteen pressures, and 12 cumu-
2436 !c lative probabilities (Fu, 1991). The spectral region is from 670
2437 !c to 540 cm**-1.
2438 !c **********************************************************************
2439 ! common /band15/ hk(12), coehca(3,19,12), coehcb(3,19,12)
2440 data hk_15 /.24,.36,.18,.1,.05,.02,.016,.012,.01,.006,.0039,.0021/
2441 data ( ( ( coehca_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 1, 2 ) / &
2442 & -.1921E+02,-.1363E+02,-.1080E+02,-.8392E+01,-.6776E+01,-.5696E+01, &
2443 & -.4572E+01,-.3752E+01,-.2382E+01,-.1110E+01, .6803E+00, .3259E+01, &
2444 & -.1875E+02,-.1321E+02,-.1040E+02,-.8026E+01,-.6449E+01,-.5401E+01, &
2445 & -.4316E+01,-.3498E+01,-.2141E+01,-.9439E+00, .8103E+00, .3314E+01, &
2446 & -.1829E+02,-.1278E+02,-.1000E+02,-.7646E+01,-.6089E+01,-.5085E+01, &
2447 & -.4047E+01,-.3217E+01,-.1872E+01,-.7106E+00, .9573E+00, .3390E+01, &
2448 & -.1783E+02,-.1236E+02,-.9596E+01,-.7264E+01,-.5735E+01,-.4740E+01, &
2449 & -.3743E+01,-.2882E+01,-.1587E+01,-.4714E+00, .1120E+01, .3425E+01, &
2450 & -.1737E+02,-.1195E+02,-.9193E+01,-.6877E+01,-.5371E+01,-.4404E+01, &
2451 & -.3405E+01,-.2574E+01,-.1298E+01,-.1747E+00, .1327E+01, .3547E+01, &
2452 & -.1691E+02,-.1153E+02,-.8776E+01,-.6490E+01,-.4993E+01,-.4049E+01, &
2453 & -.3039E+01,-.2256E+01,-.1012E+01, .1103E+00, .1530E+01, .3651E+01, &
2454 & -.1644E+02,-.1112E+02,-.8360E+01,-.6105E+01,-.4623E+01,-.3688E+01, &
2455 & -.2694E+01,-.1915E+01,-.6855E+00, .3993E+00, .1714E+01, .3950E+01, &
2456 & -.1598E+02,-.1073E+02,-.7943E+01,-.5723E+01,-.4236E+01,-.3314E+01, &
2457 & -.2338E+01,-.1596E+01,-.3583E+00, .6963E+00, .1868E+01, .4127E+01, &
2458 & -.1553E+02,-.1034E+02,-.7542E+01,-.5357E+01,-.3856E+01,-.2942E+01, &
2459 & -.1986E+01,-.1299E+01,-.5472E-01, .9443E+00, .2149E+01, .4261E+01, &
2460 & -.1485E+02,-.9661E+01,-.7008E+01,-.4830E+01,-.3458E+01,-.2566E+01, &
2461 & -.1658E+01,-.9639E+00, .2083E+00, .1182E+01, .2458E+01, .4452E+01, &
2462 & -.1427E+02,-.9166E+01,-.6373E+01,-.4404E+01,-.3073E+01,-.2209E+01, &
2463 & -.1349E+01,-.6648E+00, .4023E+00, .1452E+01, .2739E+01, .4466E+01, &
2464 & -.1380E+02,-.8726E+01,-.5772E+01,-.3982E+01,-.2732E+01,-.1874E+01, &
2465 & -.1052E+01,-.4403E+00, .5763E+00, .1792E+01, .2999E+01, .4335E+01, &
2466 & -.1305E+02,-.8270E+01,-.5304E+01,-.3586E+01,-.2392E+01,-.1568E+01, &
2467 & -.8299E+00,-.2650E+00, .8584E+00, .2062E+01, .3141E+01, .4168E+01, &
2468 & -.1269E+02,-.7900E+01,-.4956E+01,-.3205E+01,-.2065E+01,-.1332E+01, &
2469 & -.6415E+00,-.7921E-01, .1170E+01, .2269E+01, .3198E+01, .4066E+01, &
2470 & -.1227E+02,-.7536E+01,-.4576E+01,-.2859E+01,-.1815E+01,-.1139E+01, &
2471 & -.4520E+00, .2272E+00, .1371E+01, .2351E+01, .3150E+01, .3935E+01, &
2472 & -.1186E+02,-.7159E+01,-.4223E+01,-.2538E+01,-.1619E+01,-.9324E+00, &
2473 & -.1566E+00, .5151E+00, .1520E+01, .2339E+01, .3132E+01, .3880E+01, &
2474 & -.1120E+02,-.6777E+01,-.3919E+01,-.2330E+01,-.1387E+01,-.6737E+00, &
2475 & .1108E+00, .6991E+00, .1531E+01, .2163E+01, .3150E+01, .3767E+01, &
2476 & -.9973E+01,-.6279E+01,-.3638E+01,-.2048E+01,-.1098E+01,-.4407E+00, &
2477 & .3043E+00, .7797E+00, .1424E+01, .2002E+01, .3122E+01, .3611E+01, &
2478 & -.8483E+01,-.5607E+01,-.3357E+01,-.1744E+01,-.8884E+00,-.2264E+00, &
2479 & .3800E+00, .7504E+00, .1245E+01, .2032E+01, .3097E+01, .3546E+01, &
2480 & .3762E-01, .2372E-01, .1643E-01, .1208E-01, .1170E-01, .1164E-01, &
2481 & .1214E-01, .1161E-01, .1028E-01, .9185E-02, .7712E-02, .1001E-01, &
2482 & .3762E-01, .2382E-01, .1593E-01, .1145E-01, .1059E-01, .1049E-01, &
2483 & .1080E-01, .1057E-01, .8894E-02, .7807E-02, .7132E-02, .1032E-01, &
2484 & .3764E-01, .2386E-01, .1555E-01, .1080E-01, .9692E-02, .9231E-02, &
2485 & .9585E-02, .9644E-02, .7711E-02, .6443E-02, .6223E-02, .9922E-02, &
2486 & .3764E-01, .2395E-01, .1516E-01, .1028E-01, .8917E-02, .8415E-02, &
2487 & .8457E-02, .8777E-02, .6436E-02, .5428E-02, .5499E-02, .8017E-02, &
2488 & .3768E-01, .2399E-01, .1482E-01, .9692E-02, .8247E-02, .7640E-02, &
2489 & .7582E-02, .7783E-02, .5432E-02, .4482E-02, .4919E-02, .5903E-02, &
2490 & .3770E-01, .2401E-01, .1449E-01, .9252E-02, .7620E-02, .6678E-02, &
2491 & .6845E-02, .6925E-02, .4939E-02, .3471E-02, .4124E-02, .3873E-02, &
2492 & .3776E-01, .2395E-01, .1419E-01, .8959E-02, .7096E-02, .6184E-02, &
2493 & .6110E-02, .6075E-02, .4419E-02, .2891E-02, .3056E-02, .1214E-02, &
2494 & .3780E-01, .2391E-01, .1392E-01, .8687E-02, .6573E-02, .5733E-02, &
2495 & .5359E-02, .5009E-02, .4034E-02, .2755E-02, .1968E-02,-.4187E-04, &
2496 & .3791E-01, .2382E-01, .1373E-01, .8561E-02, .6060E-02, .5120E-02, &
2497 & .4618E-02, .4713E-02, .3965E-02, .2481E-02, .8164E-03,-.1088E-02, &
2498 & .3843E-01, .2148E-01, .1302E-01, .6384E-02, .5256E-02, .4260E-02, &
2499 & .4077E-02, .4181E-02, .4132E-02, .2135E-02,-.2931E-03,-.1151E-02, &
2500 & .3896E-01, .2081E-01, .1097E-01, .5568E-02, .4475E-02, .3795E-02, &
2501 & .3828E-02, .3996E-02, .3766E-02, .1193E-02,-.1089E-02,-.9420E-03, &
2502 & .3973E-01, .2024E-01, .9943E-02, .4815E-02, .3820E-02, .3663E-02, &
2503 & .3568E-02, .3881E-02, .2859E-02, .6698E-03,-.1549E-02,-.6280E-03, &
2504 & .3635E-01, .1963E-01, .1061E-01, .3812E-02, .3509E-02, .3429E-02, &
2505 & .3693E-02, .3316E-02, .1120E-02, .6552E-03,-.1193E-02,-.1109E-02, &
2506 & .3631E-01, .1893E-01, .1056E-01, .3172E-02, .3378E-02, .3164E-02, &
2507 & .2751E-02, .1722E-02, .1112E-02, .4354E-03,-.7327E-03,-.1319E-02, &
2508 & .3500E-01, .1828E-01, .1050E-01, .2831E-02, .2784E-02, .2564E-02, &
2509 & .1469E-02, .7739E-03, .1209E-02, .7913E-03,-.2512E-03,-.1758E-02, &
2510 & .3352E-01, .1763E-01, .1045E-01, .2401E-02, .1928E-02, .1340E-02, &
2511 & .3753E-03, .5794E-03, .9060E-03, .1042E-02, .1465E-03,-.2533E-02, &
2512 & .2880E-01, .1729E-01, .1077E-01, .1347E-02, .1194E-02,-.1191E-03, &
2513 & .2828E-03, .6606E-03, .9743E-03, .1002E-02, .0000E+00,-.3140E-02, &
2514 & .2040E-01, .1585E-01, .1165E-01, .3871E-05, .1509E-04,-.1046E-02, &
2515 & .2444E-03, .4359E-03, .1041E-02, .2429E-02,-.1721E-03,-.2786E-02, &
2516 & .1737E-01, .1560E-01, .1240E-01,-.2139E-03,-.1025E-02,-.1248E-02, &
2517 & -.6934E-04, .1649E-03, .4062E-03, .1554E-02,-.4179E-03,-.7795E-03/
2518 data ( ( ( coehca_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 3, 3 ) / &
2519 & -.1488E-03,-.9248E-04,-.2322E-04,-.4187E-05, .1104E-04, .9895E-05, &
2520 & -.2283E-05, .2512E-05,-.9058E-05, .8449E-05, .8297E-05,-.3882E-04, &
2521 & -.1488E-03,-.9058E-04,-.2398E-04,-.5709E-05, .1218E-04, .1180E-04, &
2522 & .1522E-05, .6927E-05,-.1161E-04, .1714E-04,-.4948E-06,-.3540E-04, &
2523 & -.1500E-03,-.8830E-04,-.2474E-04,-.8373E-05, .6470E-05, .7992E-05, &
2524 & .9096E-05, .6737E-05,-.1485E-04, .1873E-04,-.4948E-06,-.4491E-04, &
2525 & -.1500E-03,-.8601E-04,-.2664E-04,-.1028E-04, .6851E-05, .6851E-05, &
2526 & .1294E-04,-.2550E-05,-.1520E-04, .2310E-04, .4948E-06,-.2017E-04, &
2527 & -.1507E-03,-.8373E-04,-.2664E-04,-.1256E-04, .4567E-05, .1028E-04, &
2528 & .9210E-05,-.2131E-05,-.6995E-05, .7498E-05,-.1104E-04,-.2284E-05, &
2529 & -.1519E-03,-.8183E-04,-.2816E-04,-.1142E-04, .7611E-06, .7231E-05, &
2530 & .1751E-05,-.7612E-06, .8312E-05, .2436E-05,-.7231E-05, .2398E-04, &
2531 & -.1530E-03,-.7992E-04,-.2893E-04,-.9896E-05, .3806E-06, .8906E-05, &
2532 & .3159E-05,-.5328E-05, .3692E-05,-.2093E-05,-.6851E-05,-.3045E-05, &
2533 & -.1538E-03,-.7536E-04,-.3007E-04,-.8754E-05,-.3045E-05, .5138E-05, &
2534 & .9134E-06,-.1979E-06, .1560E-05,-.1507E-04, .2284E-04, .9895E-05, &
2535 & -.1541E-03,-.7688E-04,-.2969E-04,-.5709E-05,-.3996E-05, .1142E-05, &
2536 & -.8373E-06, .1235E-04,-.7079E-05,-.6737E-05, .1028E-04, .3578E-04, &
2537 & -.1560E-03,-.6851E-04,-.1903E-04,-.4187E-05,-.4605E-05,-.1142E-06, &
2538 & .3878E-05, .3597E-05,-.9591E-05, .5328E-05, .7612E-05,-.4948E-05, &
2539 & -.1587E-03,-.6546E-04,-.2740E-04,-.7612E-06,-.3578E-05, .1713E-05, &
2540 & .6064E-05,-.9781E-05, .1408E-05, .5709E-05, .8373E-05,-.1256E-04, &
2541 & -.1484E-03,-.5823E-04,-.4301E-04,-.1522E-05, .7498E-05,-.5328E-06, &
2542 & -.7855E-05,-.1599E-05, .1964E-04,-.2284E-05, .7882E-10, .5328E-05, &
2543 & -.1238E-03,-.5700E-04,-.5266E-04, .3286E-05, .4910E-05,-.8602E-05, &
2544 & .6090E-06, .8454E-05, .1256E-05,-.4072E-05,-.1903E-05, .6470E-05, &
2545 & -.1155E-03,-.5231E-04,-.4396E-04, .3626E-05,-.7051E-05,-.1743E-05, &
2546 & .9667E-05, .2064E-04,-.2778E-05,-.6546E-05,-.4948E-05, .1903E-05, &
2547 & -.1024E-03,-.5129E-04,-.4506E-04, .7943E-06, .3074E-06, .3243E-05, &
2548 & .2754E-04,-.1479E-05, .1661E-05,-.2969E-05,-.1066E-04, .7612E-06, &
2549 & -.8473E-04,-.5418E-04,-.4674E-04,-.3418E-05, .9460E-05, .1151E-04, &
2550 & .5714E-05,-.1069E-04,-.2022E-05,-.9061E-05,-.1104E-04,-.3083E-04, &
2551 & -.4283E-04,-.5037E-04,-.4476E-04, .1951E-04, .8922E-05, .1296E-04, &
2552 & -.4053E-05,-.4355E-05,-.2355E-05,-.5004E-05,-.1218E-04,-.1522E-04, &
2553 & .6411E-05,-.5937E-04,-.5331E-04, .1934E-04, .5284E-05, .1129E-04, &
2554 & -.2166E-05,-.1484E-06,-.5407E-05,-.1364E-04,-.3115E-05, .3004E-04, &
2555 & -.5074E-04,-.6256E-04,-.5097E-04, .2218E-04, .1228E-04,-.1160E-05, &
2556 & -.1105E-05, .1618E-06,-.6089E-05,-.4216E-06,-.5314E-05, .7903E-05/
2557 data ( ( ( coehcb_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 1, 2 ) / &
2558 & -.9593E+01,-.4078E+01,-.2812E+01,-.6506E+00,-.4123E+00, .2055E+01, &
2559 & .4097E+01, .4671E+01, .4639E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2560 & -.9276E+01,-.3757E+01,-.2467E+01,-.5784E+00, .8833E-01, .2232E+01, &
2561 & .3826E+01, .4723E+01, .4942E+01, .5135E+01,-.4587E+02,-.4587E+02, &
2562 & -.8968E+01,-.3508E+01,-.2116E+01,-.1363E+00, .1662E+00, .2424E+01, &
2563 & .4220E+01, .4513E+01, .1375E+01, .4601E+01,-.4587E+02,-.4587E+02, &
2564 & -.8662E+01,-.3164E+01,-.1722E+01, .5178E-01, .7288E+00, .2411E+01, &
2565 & .3805E+01, .4766E+01, .4342E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2566 & -.8292E+01,-.2799E+01,-.1359E+01, .3271E+00, .1650E+01, .2395E+01, &
2567 & .4192E+01, .4758E+01, .2470E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2568 & -.7812E+01,-.2404E+01,-.1085E+01, .7167E+00, .2202E+01, .2922E+01, &
2569 & .4322E+01, .4591E+01, .4186E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2570 & -.7441E+01,-.2066E+01,-.7142E+00, .1057E+01, .2524E+01, .2946E+01, &
2571 & .4220E+01, .3607E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2572 & -.7191E+01,-.1745E+01,-.3487E+00, .1453E+01, .2739E+01, .3660E+01, &
2573 & .4114E+01, .3245E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2574 & -.6895E+01,-.1326E+01,-.3500E+00, .1647E+01, .2899E+01, .4023E+01, &
2575 & .3361E+01, .3360E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2576 & -.5876E+01,-.9573E+00, .2014E+00, .2130E+01, .3493E+01, .4088E+01, &
2577 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2578 & -.4429E+01,-.3417E+00, .1204E+01, .2780E+01, .3843E+01, .3099E+01, &
2579 & -.4587E+02, .3605E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2580 & -.3122E+01, .2697E+00, .1866E+01, .3526E+01, .3569E+01, .1025E+01, &
2581 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2582 & -.2284E+01, .8186E+00, .2754E+01, .3206E+01, .3704E+01,-.4587E+02, &
2583 & -.4587E+02, .4625E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2584 & -.1711E+01, .1220E+01, .3248E+01,-.4587E+02, .2565E+01, .3297E+01, &
2585 & -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2586 & -.1758E+01, .7970E+00, .2758E+01, .2926E+01, .2613E+01, .1974E+01, &
2587 & -.4587E+02, .2310E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
2588 & -.1737E+01, .3499E+00, .2246E+01, .2673E+01, .3308E+01, .3463E+01, &
2589 & .3103E+01, .2611E+01, .2178E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2590 & -.1559E+01, .2215E+00, .1875E+01, .2500E+01, .3346E+01, .3585E+01, &
2591 & .3946E+01, .3533E+01, .3205E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
2592 & -.1601E+01, .5060E-01, .1275E+01, .2176E+01, .3081E+01, .3649E+01, &
2593 & .3940E+01, .4106E+01, .4112E+01, .4349E+01, .2292E+01,-.4587E+02, &
2594 & -.1222E+01, .3199E+00, .1642E+01, .2380E+01, .3254E+01, .3534E+01, &
2595 & .3687E+01, .3717E+01, .3402E+01, .3868E+01,-.4587E+02,-.4587E+02, &
2596 & .2967E-01, .1697E-01, .1795E-01, .1387E-01, .2032E-01, .1187E-01, &
2597 & .2560E-01, .1044E-01,-.4560E+00, .3059E-02, .3059E-02, .3059E-02, &
2598 & .2998E-01, .1586E-01, .1786E-01, .1521E-01, .1710E-01, .1061E-01, &
2599 & .2030E-01, .1158E-01, .4452E+00, .3059E-02, .3059E-02, .3059E-02, &
2600 & .2993E-01, .1551E-01, .1481E-01, .9846E-02, .2443E-01, .1150E-01, &
2601 & .1865E-01, .1376E-01, .4617E+00, .3059E-02, .3059E-02, .3059E-02, &
2602 & .3035E-01, .1417E-01, .1438E-01, .1511E-01, .1901E-01, .8582E-02, &
2603 & .1746E-01, .1450E-01, .4523E+00, .3059E-02, .3059E-02, .3059E-02, &
2604 & .2970E-01, .1347E-01, .1322E-01, .1252E-01, .1665E-01, .1037E-01, &
2605 & .1320E-01, .1199E-01, .4436E+00, .3059E-02, .3059E-02, .3059E-02, &
2606 & .2949E-01, .1291E-01, .1671E-01, .1111E-01, .1400E-01, .1318E-01, &
2607 & .1060E-01, .1046E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2608 & .3004E-01, .1300E-01, .1413E-01, .9085E-02, .9764E-02, .2260E-01, &
2609 & .9778E-02, .4671E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2610 & .3086E-01, .1436E-01, .1205E-01, .1081E-01, .4681E-02, .1479E-01, &
2611 & .1888E-01, .3494E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2612 & .3094E-01, .1500E-01, .1457E-01, .1060E-01, .8319E-02, .8983E-02, &
2613 & .3791E-01, .2232E-01, .4631E+00, .3059E-02, .3059E-02, .3059E-02, &
2614 & .3158E-01, .1585E-01, .1292E-01, .6531E-02, .1383E-01, .4605E+00, &
2615 & .4662E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2616 & .3182E-01, .1586E-01, .8724E-02, .5798E-02, .2454E-01, .4607E+00, &
2617 & .4560E+00, .4511E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2618 & .2369E-01, .1606E-01, .5477E-02, .1228E-01, .4579E+00, .4561E+00, &
2619 & .4497E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2620 & .2190E-01, .1779E-01, .6267E-02, .4535E+00, .4533E+00, .3059E-02, &
2621 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2622 & .2100E-01, .1653E-01, .7449E-02, .4543E+00, .4472E+00, .4439E+00, &
2623 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
2624 & .1864E-01, .1771E-01, .7040E-02, .2877E-01, .3381E-01, .2691E-01, &
2625 & .4466E+00, .3059E-02, .4613E+00, .3059E-02, .3059E-02, .3059E-02, &
2626 & .1637E-01, .1641E-01, .8424E-02, .1318E-01, .2060E-01, .3426E-01, &
2627 & .4122E-01, .4621E+00, .4555E+00, .4525E+00, .3059E-02, .3059E-02, &
2628 & .1607E-01, .1452E-01, .8013E-02, .1213E-01, .1482E-01, .2125E-01, &
2629 & .3379E-01, .3562E-01, .4619E+00, .4569E+00, .3059E-02, .3059E-02, &
2630 & .1698E-01, .1538E-01, .6616E-02, .1147E-01, .1217E-01, .1696E-01, &
2631 & .1871E-01, .2273E-01, .4513E-01, .4702E+00, .4617E+00, .4553E+00, &
2632 & .1700E-01, .1547E-01, .6456E-02, .1324E-01, .1502E-01, .2095E-01, &
2633 & .2547E-01, .2823E-01, .4107E-01, .4676E+00, .4583E+00, .4498E+00/
2634 data ( ( ( coehcb_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 3, 3 ) / &
2635 & -.6747E-05,-.2483E-04, .6575E-04, .1026E-03, .3888E-03,-.8519E-04, &
2636 & -.1629E-03,-.1808E-04,-.8355E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2637 & -.2270E-04,-.3427E-04, .5118E-04, .1218E-03, .1245E-03,-.1245E-03, &
2638 & .3841E-05,-.4151E-04,-.8763E-02,-.1687E-01,-.4656E-05,-.4656E-05, &
2639 & -.4557E-04,-.3023E-04, .2286E-04, .5656E-04, .4113E-04,-.1407E-03, &
2640 & -.1301E-03, .8503E-04,-.7284E-02,-.1669E-01,-.4656E-05,-.4656E-05, &
2641 & -.5325E-04,-.5309E-04,-.1246E-04, .2244E-04, .5136E-04,-.1272E-03, &
2642 & .4217E-04,-.1749E-04,-.8435E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2643 & -.6857E-04,-.7217E-04, .1740E-05, .3653E-04,-.1490E-03,-.4090E-04, &
2644 & -.2376E-04, .2047E-04,-.7974E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2645 & -.1232E-03,-.9826E-04,-.2849E-04, .1703E-04,-.1895E-03,-.3363E-03, &
2646 & .7102E-04,-.1838E-05,-.1655E-01,-.4656E-05,-.4656E-05,-.4656E-05, &
2647 & -.9896E-04,-.5127E-04,-.2704E-04,-.1218E-04,-.1207E-03,-.5883E-04, &
2648 & .6893E-04,-.7924E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2649 & -.7837E-04,-.4980E-04, .6902E-05,-.1072E-03,-.4051E-04,-.1991E-05, &
2650 & -.1173E-03,-.5195E-04,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2651 & -.8136E-04,-.8102E-04, .1254E-03,-.4658E-04, .3173E-04,-.4461E-05, &
2652 & -.1558E-03,-.2036E-03, .8360E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2653 & -.2232E-04,-.6411E-04, .9486E-04,-.2322E-03,-.8282E-04,-.8202E-02, &
2654 & .8416E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2655 & -.1398E-03,-.7165E-04,-.4258E-04,-.3970E-04,-.2839E-03,-.7873E-02, &
2656 & .8231E-02,-.8213E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2657 & -.6754E-04,-.7469E-04,-.6898E-04,-.1702E-03,-.8079E-02,-.7270E-02, &
2658 & .8116E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2659 & -.2396E-04,-.2361E-04,-.8664E-04,-.8038E-02,-.8207E-02,-.4656E-05, &
2660 & -.4656E-05,-.1670E-01,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2661 & -.5479E-04,-.7593E-04,-.1005E-03, .8199E-02,-.7942E-02,-.8244E-02, &
2662 & -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
2663 & -.3806E-04,-.5825E-04,-.1003E-03,-.2925E-03,-.1506E-03, .3148E-04, &
2664 & .8060E-02,-.1593E-01, .8327E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
2665 & -.4706E-04,-.3630E-04,-.7811E-04,-.6881E-04,-.1822E-03,-.3091E-03, &
2666 & -.3033E-03,-.7684E-02,-.7663E-02, .8167E-02,-.4656E-05,-.4656E-05, &
2667 & -.7669E-04,-.4610E-04,-.8063E-04,-.7250E-04,-.1094E-03,-.1241E-03, &
2668 & -.2944E-03,-.1736E-03,-.7886E-02, .8248E-02,-.4656E-05,-.4656E-05, &
2669 & -.7138E-04,-.4545E-04,-.3653E-04,-.6075E-04,-.4528E-04,-.1077E-03, &
2670 & -.1119E-03,-.1657E-03,-.4695E-03,-.8112E-02,-.7587E-02, .8217E-02, &
2671 & -.6812E-04,-.4558E-04,-.6739E-04,-.8861E-04,-.9386E-04,-.1334E-03, &
2672 & -.2007E-03,-.2179E-03,-.1650E-03,-.8001E-02, .8273E-02, .8118E-02/
2675 ! block data ckd16
2676 !c *********************************************************************
2677 !c hk is the interval in the g (cumulative probability) space from 0
2678 !c to one. coeh2o is the coefficient to calculate the H2O absorption
2679 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
2680 !c teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
2681 !c The spectral region is from 540 to 400 cm**-1.
2682 !c *********************************************************************
2683 ! common /band16/ hk(7), coeh2o(3,19,7)
2684 data hk_16 / .12, .24, .24, .20, .12, .06, .02 /
2685 data ( ( ( coeh2o_16(k,j,i), i = 1, 7 ), j = 1, 19 ), k = 1, 3 ) / &
2686 & -.2344E+02,-.2016E+02,-.1986E+02,-.1655E+02,-.1243E+02,-.8437E+01, &
2687 & -.4858E+01,-.2298E+02,-.2014E+02,-.1984E+02,-.1609E+02,-.1198E+02, &
2688 & -.8020E+01,-.4548E+01,-.2252E+02,-.2012E+02,-.1981E+02,-.1564E+02, &
2689 & -.1153E+02,-.7596E+01,-.4239E+01,-.2206E+02,-.2009E+02,-.1957E+02, &
2690 & -.1517E+02,-.1111E+02,-.7161E+01,-.3871E+01,-.2160E+02,-.2007E+02, &
2691 & -.1911E+02,-.1472E+02,-.1065E+02,-.6721E+01,-.3479E+01,-.2113E+02, &
2692 & -.2005E+02,-.1865E+02,-.1426E+02,-.1021E+02,-.6302E+01,-.3081E+01, &
2693 & -.2067E+02,-.2003E+02,-.1819E+02,-.1379E+02,-.9765E+01,-.5883E+01, &
2694 & -.2678E+01,-.2026E+02,-.2001E+02,-.1773E+02,-.1333E+02,-.9332E+01, &
2695 & -.5443E+01,-.2253E+01,-.2024E+02,-.1999E+02,-.1727E+02,-.1288E+02, &
2696 & -.8897E+01,-.5029E+01,-.1858E+01,-.2026E+02,-.1959E+02,-.1481E+02, &
2697 & -.1147E+02,-.7477E+01,-.4555E+01,-.1464E+01,-.2022E+02,-.1632E+02, &
2698 & -.1305E+02,-.9885E+01,-.6689E+01,-.4108E+01,-.1068E+01,-.1936E+02, &
2699 & -.1438E+02,-.1163E+02,-.8499E+01,-.6146E+01,-.3673E+01,-.6816E+00, &
2700 & -.1675E+02,-.1281E+02,-.1020E+02,-.7716E+01,-.5678E+01,-.3256E+01, &
2701 & -.3125E+00,-.1510E+02,-.1124E+02,-.8821E+01,-.7140E+01,-.5243E+01, &
2702 & -.2851E+01,-.2560E-01,-.1334E+02,-.9708E+01,-.8061E+01,-.6611E+01, &
2703 & -.4842E+01,-.2459E+01, .1711E+00,-.1155E+02,-.8798E+01,-.7440E+01, &
2704 & -.6123E+01,-.4439E+01,-.2089E+01, .2480E+00,-.1020E+02,-.8154E+01, &
2705 & -.6945E+01,-.5681E+01,-.4055E+01,-.1737E+01, .2390E+00,-.9464E+01, &
2706 & -.7677E+01,-.6512E+01,-.5284E+01,-.3707E+01,-.1453E+01, .2015E+00, &
2707 & -.9033E+01,-.7246E+01,-.6093E+01,-.4882E+01,-.3346E+01,-.1264E+01, &
2708 & .1033E+00, .4658E-01, .5840E-02, .4626E-02, .2688E-01, .2395E-01, &
2709 & .1804E-01, .2074E-01, .4660E-01, .1884E-02, .8561E-02, .2690E-01, &
2710 & .2403E-01, .1788E-01, .1934E-01, .4660E-01, .1800E-02, .1252E-01, &
2711 & .2694E-01, .2393E-01, .1786E-01, .1825E-01, .4660E-01, .1779E-02, &
2712 & .1649E-01, .2696E-01, .2397E-01, .1779E-01, .1765E-01, .4348E-01, &
2713 & .1758E-02, .2043E-01, .2696E-01, .2393E-01, .1748E-01, .1675E-01, &
2714 & .3944E-01, .1737E-02, .2445E-01, .2698E-01, .2384E-01, .1752E-01, &
2715 & .1549E-01, .3538E-01, .1654E-02, .2847E-01, .2702E-01, .2384E-01, &
2716 & .1714E-01, .1565E-01, .3127E-01, .1570E-02, .3245E-01, .2705E-01, &
2717 & .2374E-01, .1712E-01, .1514E-01, .2715E-01, .1444E-02, .3540E-01, &
2718 & .2711E-01, .2363E-01, .1702E-01, .1446E-01, .2960E-01, .1760E-01, &
2719 & .2977E-01, .2397E-01, .2087E-01, .1618E-01, .1445E-01, .2466E-01, &
2720 & .3039E-01, .2428E-01, .2217E-01, .1821E-01, .1593E-01, .1463E-01, &
2721 & .2640E-01, .2545E-01, .2231E-01, .2060E-01, .1773E-01, .1555E-01, &
2722 & .1473E-01, .3456E-01, .2135E-01, .2030E-01, .1844E-01, .1740E-01, &
2723 & .1559E-01, .1428E-01, .3203E-01, .2047E-01, .1809E-01, .1760E-01, &
2724 & .1725E-01, .1545E-01, .1541E-01, .2137E-01, .1857E-01, .1616E-01, &
2725 & .1698E-01, .1700E-01, .1537E-01, .1636E-01, .1338E-01, .1518E-01, &
2726 & .1580E-01, .1658E-01, .1710E-01, .1518E-01, .1513E-01, .1570E-01, &
2727 & .1614E-01, .1603E-01, .1673E-01, .1706E-01, .1497E-01, .1439E-01, &
2728 & .1987E-01, .1731E-01, .1601E-01, .1675E-01, .1681E-01, .1535E-01, &
2729 & .1425E-01, .2018E-01, .1723E-01, .1597E-01, .1691E-01, .1666E-01, &
2730 & .1509E-01, .1446E-01,-.2873E-03,-.8031E-04, .4225E-04,-.9287E-04, &
2731 & -.6013E-04,-.4339E-04,-.2474E-04,-.2862E-03,-.8372E-05, .1146E-03, &
2732 & -.9248E-04,-.6166E-04,-.3882E-04,-.1827E-04,-.2870E-03,-.6851E-05, &
2733 & .1865E-03,-.9172E-04,-.6128E-04,-.3616E-04,-.7612E-05,-.2877E-03, &
2734 & -.7231E-05, .1880E-03,-.9287E-04,-.5671E-04,-.4110E-04,-.1104E-04, &
2735 & -.3429E-03,-.7612E-05, .1149E-03,-.9287E-04,-.6356E-04,-.4529E-04, &
2736 & -.2436E-04,-.4187E-03,-.7992E-05, .4339E-04,-.9325E-04,-.6280E-04, &
2737 & -.4225E-04,-.3197E-04,-.4925E-03,-.8754E-05,-.2740E-04,-.9477E-04, &
2738 & -.6432E-04,-.3768E-04,-.3361E-04,-.5511E-03,-.8753E-05,-.9972E-04, &
2739 & -.9515E-04,-.6394E-04,-.3806E-04,-.3787E-04,-.4792E-03,-.1028E-04, &
2740 & -.1534E-03,-.9477E-04,-.6356E-04,-.3616E-04,-.2923E-04,-.5070E-03, &
2741 & .1922E-03,-.1028E-03,-.5823E-04,-.7954E-04,-.2550E-04,-.3893E-04, &
2742 & -.3776E-03,-.1043E-03,-.7993E-04,-.7422E-04,-.4948E-04,-.3007E-04, &
2743 & -.3863E-04, .8335E-04,-.5709E-04,-.6090E-04,-.7840E-04,-.3692E-04, &
2744 & -.3007E-04,-.4251E-04,-.6204E-04,-.4872E-04,-.3806E-04,-.4681E-04, &
2745 & -.3463E-04,-.3007E-04,-.4312E-04,-.1142E-04,-.5176E-04,-.5024E-04, &
2746 & -.3007E-04,-.3730E-04,-.3037E-04,-.3888E-04, .2550E-04,-.6508E-04, &
2747 & -.2512E-04,-.3083E-04,-.3197E-04,-.3041E-04,-.3750E-04, .1484E-04, &
2748 & -.1941E-04,-.2626E-04,-.3349E-04,-.3463E-04,-.2896E-04,-.1716E-04, &
2749 & -.7231E-04,-.3920E-04,-.2893E-04,-.3540E-04,-.3311E-04,-.3734E-04, &
2750 & -.2550E-05,-.7650E-04,-.3159E-04,-.2778E-04,-.3121E-04,-.2169E-04, &
2751 & -.4365E-04,-.1546E-04,-.7916E-04,-.2931E-04,-.2854E-04,-.3654E-04, &
2752 & -.1979E-04,-.4811E-04,-.1435E-04/
2755 ! block data ckd17
2756 !c *********************************************************************
2757 !c hk is the interval in the g (cumulative probability) space from 0
2758 !c to one. coeh2o is the coefficient to calculate the H2O absorption
2759 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
2760 !c teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
2761 !c The spectral region is from 400 to 280 cm**-1.
2762 !c *********************************************************************
2763 ! common /band17/ hk(7), coeh2o(3,19,7)
2764 data hk_17 / .12, .26, .22, .20, .10, .085, .015 /
2765 data ( ( ( coeh2o_17(k,j,i), i = 1, 7 ), j = 1, 19 ), k = 1, 3 ) / &
2766 & -.2255E+02,-.2000E+02,-.1703E+02,-.1282E+02,-.9215E+01,-.5938E+01, &
2767 & -.2009E+01,-.2209E+02,-.1997E+02,-.1657E+02,-.1236E+02,-.8764E+01, &
2768 & -.5499E+01,-.1582E+01,-.2163E+02,-.1993E+02,-.1611E+02,-.1191E+02, &
2769 & -.8324E+01,-.5061E+01,-.1170E+01,-.2117E+02,-.1990E+02,-.1565E+02, &
2770 & -.1146E+02,-.7889E+01,-.4631E+01,-.7737E+00,-.2071E+02,-.1987E+02, &
2771 & -.1519E+02,-.1100E+02,-.7440E+01,-.4179E+01,-.3719E+00,-.2026E+02, &
2772 & -.1985E+02,-.1473E+02,-.1054E+02,-.6995E+01,-.3721E+01, .0000E+00, &
2773 & -.2024E+02,-.1982E+02,-.1426E+02,-.1009E+02,-.6549E+01,-.3284E+01, &
2774 & .4053E+00,-.2022E+02,-.1980E+02,-.1381E+02,-.9639E+01,-.6097E+01, &
2775 & -.2821E+01, .8375E+00,-.2021E+02,-.1933E+02,-.1335E+02,-.9187E+01, &
2776 & -.5653E+01,-.2379E+01, .1272E+01,-.2010E+02,-.1503E+02,-.1125E+02, &
2777 & -.7665E+01,-.4492E+01,-.1893E+01, .1642E+01,-.1747E+02,-.1278E+02, &
2778 & -.9547E+01,-.6120E+01,-.3756E+01,-.1443E+01, .1995E+01,-.1529E+02, &
2779 & -.1095E+02,-.8107E+01,-.5036E+01,-.3182E+01,-.1032E+01, .2429E+01, &
2780 & -.1370E+02,-.9303E+01,-.6691E+01,-.4357E+01,-.2683E+01,-.6173E+00, &
2781 & .2805E+01,-.1150E+02,-.7859E+01,-.5618E+01,-.3843E+01,-.2234E+01, &
2782 & -.2171E+00, .2973E+01,-.9590E+01,-.6537E+01,-.4886E+01,-.3355E+01, &
2783 & -.1805E+01, .1615E+00, .3157E+01,-.7530E+01,-.5699E+01,-.4306E+01, &
2784 & -.2892E+01,-.1388E+01, .5448E+00, .3155E+01,-.6758E+01,-.5112E+01, &
2785 & -.3809E+01,-.2464E+01,-.9947E+00, .8713E+00, .3203E+01,-.6245E+01, &
2786 & -.4610E+01,-.3376E+01,-.2058E+01,-.6166E+00, .1073E+01, .3109E+01, &
2787 & -.5777E+01,-.4175E+01,-.2963E+01,-.1671E+01,-.2556E+00, .1241E+01, &
2788 & .3014E+01, .4264E-01, .1968E-02, .1863E-01, .1436E-01, .1101E-01, &
2789 & .1055E-01, .1281E-01, .4264E-01, .1989E-02, .1861E-01, .1438E-01, &
2790 & .1095E-01, .1030E-01, .1211E-01, .3996E-01, .1968E-02, .1861E-01, &
2791 & .1434E-01, .1103E-01, .1019E-01, .1160E-01, .3600E-01, .1947E-02, &
2792 & .1861E-01, .1442E-01, .1086E-01, .1003E-01, .1157E-01, .3203E-01, &
2793 & .5756E-02, .1861E-01, .1444E-01, .1080E-01, .9922E-02, .1151E-01, &
2794 & .2801E-01, .9713E-02, .1859E-01, .1446E-01, .1070E-01, .9880E-02, &
2795 & .1066E-01, .2393E-01, .1369E-01, .1859E-01, .1451E-01, .1057E-01, &
2796 & .9880E-02, .1072E-01, .1987E-01, .1767E-01, .1863E-01, .1451E-01, &
2797 & .1040E-01, .9880E-02, .1057E-01, .1572E-01, .2169E-01, .1863E-01, &
2798 & .1442E-01, .1022E-01, .9742E-02, .1036E-01, .3391E-02, .1884E-01, &
2799 & .1566E-01, .1105E-01, .1011E-01, .1001E-01, .1017E-01, .1982E-01, &
2800 & .1444E-01, .1189E-01, .1030E-01, .9859E-02, .9861E-02, .1038E-01, &
2801 & .1748E-01, .1321E-01, .9922E-02, .1068E-01, .1013E-01, .9937E-02, &
2802 & .9958E-02, .1346E-01, .9943E-02, .9566E-02, .1097E-01, .9815E-02, &
2803 & .9964E-02, .1059E-01, .9817E-02, .7159E-02, .8687E-02, .1114E-01, &
2804 & .1007E-01, .1014E-01, .1058E-01, .3370E-02, .7264E-02, .9378E-02, &
2805 & .1112E-01, .9767E-02, .1016E-01, .1101E-01, .2993E-02, .8017E-02, &
2806 & .9566E-02, .1116E-01, .9738E-02, .1025E-01, .1086E-01, .8331E-02, &
2807 & .8771E-02, .1001E-01, .1117E-01, .9847E-02, .1076E-01, .1084E-01, &
2808 & .7850E-02, .9378E-02, .1001E-01, .1105E-01, .9964E-02, .1113E-01, &
2809 & .1168E-01, .8038E-02, .9336E-02, .9817E-02, .1096E-01, .1024E-01, &
2810 & .1175E-01, .1107E-01,-.2188E-03,-.2283E-05,-.8069E-04,-.4415E-04, &
2811 & -.2284E-04,-.4491E-04,-.4518E-04,-.2196E-03,-.2665E-05,-.8107E-04, &
2812 & -.4301E-04,-.2398E-04,-.4795E-04,-.4693E-04,-.2683E-03,-.3045E-05, &
2813 & -.8107E-04,-.4301E-04,-.2246E-04,-.4757E-04,-.4152E-04,-.3403E-03, &
2814 & -.4187E-05,-.8031E-04,-.3996E-04,-.1865E-04,-.4301E-04,-.4350E-04, &
2815 & -.4118E-03, .6584E-04,-.8107E-04,-.4034E-04,-.1903E-04,-.4643E-04, &
2816 & -.4834E-04,-.4803E-03, .1378E-03,-.8069E-04,-.4072E-04,-.1713E-04, &
2817 & -.5176E-04,-.3460E-04,-.4099E-03, .2101E-03,-.8069E-04,-.3920E-04, &
2818 & -.1713E-04,-.5024E-04,-.3524E-04,-.3391E-03, .2809E-03,-.7992E-04, &
2819 & -.3616E-04,-.2017E-04,-.5633E-04,-.4886E-04,-.2668E-03, .2078E-03, &
2820 & -.8069E-04,-.3768E-04,-.2131E-04,-.5580E-04,-.5454E-04,-.2207E-04, &
2821 & -.8601E-04,-.4643E-04,-.2436E-04,-.4148E-04,-.5458E-04,-.4579E-04, &
2822 & -.5138E-04,-.2893E-04,-.3273E-04,-.3882E-04,-.3920E-04,-.5035E-04, &
2823 & -.3170E-04,-.2169E-04,-.3007E-04,-.2740E-04,-.5328E-04,-.4491E-04, &
2824 & -.4403E-04,-.6383E-04, .4834E-04,-.2702E-04,-.4453E-04,-.4339E-04, &
2825 & -.4457E-04,-.4551E-04,-.8133E-04, .3768E-04,-.7611E-06,-.2626E-04, &
2826 & -.4643E-04,-.4305E-04,-.4840E-04,-.5149E-04, .7193E-04,-.2169E-04, &
2827 & -.4491E-04,-.3996E-04,-.4483E-04,-.4487E-04,-.6698E-04,-.4834E-04, &
2828 & -.3463E-04,-.4986E-04,-.4377E-04,-.4514E-04,-.5377E-04,-.2626E-04, &
2829 & -.4187E-04,-.3692E-04,-.5100E-04,-.4651E-04,-.4392E-04,-.5386E-04, &
2830 & -.4643E-04,-.4301E-04,-.3578E-04,-.5176E-04,-.4594E-04,-.4551E-04, &
2831 & -.3920E-04,-.3425E-04,-.4491E-04,-.3654E-04,-.5138E-04,-.4377E-04, &
2832 & -.5614E-04,-.5758E-04,-.3600E-04/
2835 ! block data ckd18
2836 !c *********************************************************************
2837 !c hk is the interval in the g (cumulative probability) space from 0
2838 !c to one. coeh2o is the coefficient to calculate the H2O absorption
2839 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
2840 !c teen pressures, and eight cumulative probabilities ( Fu, 1991 ).
2841 !c The spectral region is from 280 to 0 cm**-1.
2842 !c *********************************************************************
2843 ! common /band18/ hk(8), coeh2o(3,19,8)
2844 data hk_18 / .07, .1, .2, .25, .2, .1, .03, .02 /
2845 data ( ( ( coeh2o_18(k,j,i), i = 1, 8 ), j = 1, 19 ), k = 1, 3 ) / &
2846 & -.2121E+02,-.2002E+02,-.1676E+02,-.1274E+02,-.8780E+01,-.5167E+01, &
2847 & -.2692E+01,-.6275E+00,-.2075E+02,-.1996E+02,-.1630E+02,-.1228E+02, &
2848 & -.8324E+01,-.4718E+01,-.2260E+01,-.2303E+00,-.2029E+02,-.1990E+02, &
2849 & -.1584E+02,-.1182E+02,-.7868E+01,-.4269E+01,-.1806E+01, .1645E+00, &
2850 & -.2022E+02,-.1985E+02,-.1538E+02,-.1136E+02,-.7417E+01,-.3820E+01, &
2851 & -.1373E+01, .5657E+00,-.2018E+02,-.1981E+02,-.1492E+02,-.1090E+02, &
2852 & -.6965E+01,-.3369E+01,-.9319E+00, .9577E+00,-.2013E+02,-.1937E+02, &
2853 & -.1446E+02,-.1044E+02,-.6512E+01,-.2917E+01,-.4928E+00, .1376E+01, &
2854 & -.2009E+02,-.1891E+02,-.1400E+02,-.9984E+01,-.6063E+01,-.2466E+01, &
2855 & -.6887E-01, .1768E+01,-.2006E+02,-.1845E+02,-.1354E+02,-.9530E+01, &
2856 & -.5618E+01,-.2024E+01, .3615E+00, .2196E+01,-.2003E+02,-.1800E+02, &
2857 & -.1308E+02,-.9075E+01,-.5174E+01,-.1593E+01, .7820E+00, .2600E+01, &
2858 & -.1827E+02,-.1464E+02,-.1097E+02,-.7525E+01,-.3733E+01,-.1077E+01, &
2859 & .1204E+01, .3014E+01,-.1525E+02,-.1210E+02,-.9275E+01,-.5876E+01, &
2860 & -.2768E+01,-.6286E+00, .1622E+01, .3394E+01,-.1298E+02,-.1060E+02, &
2861 & -.7764E+01,-.4462E+01,-.2154E+01,-.2001E+00, .2034E+01, .3756E+01, &
2862 & -.1157E+02,-.8941E+01,-.5984E+01,-.3509E+01,-.1651E+01, .2279E+00, &
2863 & .2422E+01, .4066E+01,-.9986E+01,-.7062E+01,-.4794E+01,-.2818E+01, &
2864 & -.1196E+01, .6394E+00, .2791E+01, .4283E+01,-.8064E+01,-.5512E+01, &
2865 & -.3933E+01,-.2274E+01,-.7559E+00, .1036E+01, .3085E+01, .4444E+01, &
2866 & -.6440E+01,-.4863E+01,-.3219E+01,-.1791E+01,-.3279E+00, .1427E+01, &
2867 & .3304E+01, .4527E+01,-.5902E+01,-.4207E+01,-.2756E+01,-.1350E+01, &
2868 & .7686E-01, .1776E+01, .3475E+01, .4550E+01,-.5439E+01,-.3739E+01, &
2869 & -.2330E+01,-.9233E+00, .4612E+00, .2066E+01, .3564E+01, .4502E+01, &
2870 & -.5006E+01,-.3316E+01,-.1906E+01,-.5066E+00, .8352E+00, .2272E+01, &
2871 & .3587E+01, .4419E+01, .2338E-01, .1968E-02, .9503E-02, .3412E-02, &
2872 & .6280E-03,-.1109E-02,-.1089E-02,-.1026E-02, .1972E-01, .2093E-02, &
2873 & .9503E-02, .3391E-02, .6489E-03,-.1172E-02,-.1164E-02,-.1158E-02, &
2874 & .1603E-01, .3328E-02, .9524E-02, .3391E-02, .6489E-03,-.1277E-02, &
2875 & -.1229E-02,-.1296E-02, .1229E-01, .7138E-02, .9524E-02, .3370E-02, &
2876 & .6070E-03,-.1319E-02,-.1264E-02,-.1610E-02, .8478E-02, .1095E-01, &
2877 & .9566E-02, .3412E-02, .5652E-03,-.1382E-02,-.1266E-02,-.1566E-02, &
2878 & .4563E-02, .1480E-01, .9566E-02, .3412E-02, .5443E-03,-.1423E-02, &
2879 & -.1199E-02,-.1679E-02, .2261E-02, .1865E-01, .9608E-02, .3454E-02, &
2880 & .4815E-03,-.1423E-02,-.1296E-02,-.1555E-02, .2198E-02, .2250E-01, &
2881 & .9671E-02, .3412E-02, .4187E-03,-.1426E-02,-.1472E-02,-.1800E-02, &
2882 & .2072E-02, .2600E-01, .9734E-02, .3433E-02, .3977E-03,-.1428E-02, &
2883 & -.1541E-02,-.1591E-02, .1987E-01, .8645E-02, .6280E-02, .1298E-02, &
2884 & -.1151E-02,-.1509E-02,-.1662E-02,-.1570E-02, .4668E-02, .8373E-02, &
2885 & .3956E-02,-.4187E-04,-.1968E-02,-.1624E-02,-.1700E-02,-.1947E-02, &
2886 & .9231E-02, .5694E-02, .1444E-02,-.2512E-03,-.1827E-02,-.1662E-02, &
2887 & -.1576E-02,-.1633E-02, .8666E-02, .3077E-02,-.1737E-02,-.1277E-02, &
2888 & -.1507E-02,-.1757E-02,-.1612E-02,-.1612E-02, .8164E-03,-.4375E-02, &
2889 & -.1884E-02,-.1277E-02,-.1564E-02,-.1853E-02,-.1591E-02,-.1486E-02, &
2890 & -.1486E-02,-.2596E-02,-.1633E-02,-.1539E-02,-.1662E-02,-.1846E-02, &
2891 & -.1423E-02,-.1277E-02,-.1423E-02,-.2617E-02,-.1005E-02,-.1379E-02, &
2892 & -.1687E-02,-.1905E-02,-.1528E-02,-.1298E-02,-.1675E-03,-.1947E-02, &
2893 & -.5024E-03,-.1325E-02,-.1696E-02,-.1698E-02,-.1486E-02,-.1277E-02, &
2894 & .1047E-03,-.1109E-02,-.5861E-03,-.1363E-02,-.1620E-02,-.1666E-02, &
2895 & -.1507E-02,-.9210E-03, .1047E-03,-.1047E-02,-.8394E-03,-.1342E-02, &
2896 & -.1591E-02,-.1323E-02,-.1340E-02,-.9420E-03,-.1085E-03, .2283E-05, &
2897 & -.4719E-04,-.3807E-06,-.1522E-05,-.3425E-05,-.7612E-06, .1751E-05, &
2898 & -.1766E-03, .1523E-05,-.4719E-04,-.7609E-06,-.3807E-06,-.3045E-05, &
2899 & .1599E-05, .8723E-05,-.2443E-03, .1941E-04,-.4757E-04,-.1522E-05, &
2900 & -.3806E-06,-.1903E-05,-.2778E-05, .1294E-04,-.1838E-03, .8563E-04, &
2901 & -.4757E-04,-.1903E-05, .1142E-05,-.2664E-05,-.6090E-06, .1321E-04, &
2902 & -.1161E-03, .1526E-03,-.4757E-04,-.2664E-05,-.3805E-06,-.3806E-05, &
2903 & -.2093E-05, .2253E-04,-.4795E-04, .9248E-04,-.4757E-04,-.1903E-05, &
2904 & .0000E+00,-.3045E-05,-.7992E-06, .1393E-04,-.9134E-05, .2246E-04, &
2905 & -.4834E-04,-.2664E-05, .3804E-06,-.5328E-05,-.1510E-05, .1465E-04, &
2906 & -.1028E-04,-.4757E-04,-.4948E-04,-.1142E-05, .7614E-06,-.4910E-05, &
2907 & -.5709E-06, .1477E-04,-.1256E-04,-.1066E-03,-.4910E-04,-.1523E-05, &
2908 & -.3805E-06,-.3121E-05,-.2512E-05, .1142E-04,-.7878E-04,-.2664E-05, &
2909 & -.8373E-05,-.7612E-06, .1104E-04,-.3311E-05,-.1979E-05, .5709E-05, &
2910 & -.2626E-04,-.4872E-04,-.3808E-06,-.2283E-05, .2284E-05,-.3349E-05, &
2911 & -.4034E-05, .7231E-05,-.4910E-04, .1599E-04, .1256E-04,-.7612E-05, &
2912 & .1180E-05,-.1815E-05,-.7193E-05, .3045E-05, .1576E-09, .6470E-05, &
2913 & -.1408E-04,-.1903E-05, .1522E-05,-.4746E-05,-.4948E-05, .3806E-06, &
2914 & .9020E-04, .5214E-04, .6090E-05,-.1104E-04, .1180E-05,-.2778E-05, &
2915 & -.6090E-05,-.2664E-05,-.6737E-04,-.1218E-04,-.3806E-05,-.5214E-05, &
2916 & -.1066E-05,-.1294E-05,-.3045E-05,-.2664E-05,-.4643E-04, .1713E-04, &
2917 & -.1218E-04,-.6204E-05,-.2360E-05,-.1979E-05,-.1903E-05,-.3806E-05, &
2918 & -.3045E-04,-.1256E-04,-.9134E-05,-.6508E-05,-.1027E-05,-.7993E-06, &
2919 & -.1142E-05,-.7992E-05,-.3616E-04,-.1028E-04,-.1066E-04,-.6051E-05, &
2920 & .1066E-05,-.1751E-05,-.2284E-05,-.2284E-05,-.3920E-04,-.9895E-05, &
2921 & -.1321E-04,-.3844E-05,-.2055E-05,-.2512E-05,-.3806E-05,-.3425E-05/
2922 end module band
2923 !c pgwc(nv) aerosol concentration ( # / m ** 3 )
2925 !c---------- 4/1/97 (7) -- NEXT 1142 LINES -- Replaces old
2926 !c aerosol1,aerosol2 block data.
2927 ! block data aerosol1
2928 module aerosol1
2929 !c 4/1/97
2930 !c ********************************************************************
2931 !c
2932 !c mb: Number of bands in code (will always be 18)
2933 !c naer: Number of aerosol types (will need to be changed here AND in
2934 !c aerosol subroutine.
2935 !c nrh: Number of different relative humidities (currently 8)
2936 !c
2937 !c Optical properties are dimensioned (18,8,naer): Number of bands, &
2938 !c number of relative humidities, and number of aerosol types.
2939 !c Properties for ocean, continental, and urban were extracted from
2940 !c tables and interpolated (energy-weighted) into the Fu-Liou
2941 !c spectral bands. Tegen and Lacis values are not RH-dependent,
2942 !c so values are repeated.
2943 !c
2944 !c a_ssa: single-scattering albedo. One data statement for EACH type
2945 !c of aerosol.
2946 !c
2947 !c a_ext: extinction coefficient. Normalization is not important.
2948 !c These values are used for spectral weighting only!! One
2949 !c data statement for EACH type of aerosol.
2950 !c
2951 !c a_asy: Asymmetry parameter.One data statement for EACH type of
2952 !c aerosol.
2953 !c
2954 !c ********************************************************************
2955 !c USE RadParams
2956 !# include "para.file"
2957 USE PARA_FILE
2958 !c include 'para.file'
2959 implicit none
2960 !c## include 'rad_0698.h'
2961 integer, private :: i,j
2962 !c# real a_ssax(mbx,nrh,naer),a_extx(mbx,nrh,naer)
2963 !c# real a_asyx(mbx,nrh,naer)
2964 ! common /aer_optx/ a_ssax,a_extx,a_asyx
2965 real a_ssax(mbx,nrh,naer),a_extx(mbx,nrh,naer)
2966 real a_asyx(mbx,nrh,naer)
2968 !c *******************************************
2969 !c Data statements for aerosol type 1 (marine)
2970 !c *******************************************
2971 data ((a_ssax(i,j,1),i=1,mbx),j=1,nrh) / &
2972 & .1000E+01,.9984E+00,.9525E+00,.9053E+00,.7378E+00,.8873E+00, &
2973 & .8528E+00,.8678E+00,.6329E+00,.7734E+00,.7571E+00,.7446E+00, &
2974 & .5500E+00,.3973E+00,.4265E+00,.4511E+00,.4341E+00,.3346E+00, &
2975 & .1000E+01,.9974E+00,.9586E+00,.9109E+00,.7298E+00,.8807E+00, &
2976 & .8421E+00,.8447E+00,.6212E+00,.7637E+00,.7352E+00,.7322E+00, &
2977 & .5276E+00,.3942E+00,.4226E+00,.4474E+00,.4344E+00,.3404E+00, &
2978 & .1000E+01,.9980E+00,.9691E+00,.9182E+00,.7075E+00,.8584E+00, &
2979 & .8072E+00,.8201E+00,.5870E+00,.7255E+00,.6977E+00,.6968E+00, &
2980 & .4866E+00,.3946E+00,.4212E+00,.4429E+00,.4396E+00,.3688E+00, &
2981 & .1000E+01,.9988E+00,.9820E+00,.9212E+00,.6840E+00,.8189E+00, &
2982 & .7384E+00,.7583E+00,.5412E+00,.6484E+00,.6295E+00,.6340E+00, &
2983 & .4620E+00,.4177E+00,.4341E+00,.4484E+00,.4522E+00,.4161E+00, &
2984 & .1000E+01,.9989E+00,.9836E+00,.9178E+00,.6825E+00,.8084E+00, &
2985 & .7180E+00,.7351E+00,.5334E+00,.6226E+00,.6058E+00,.6108E+00, &
2986 & .4623E+00,.4255E+00,.4399E+00,.4518E+00,.4559E+00,.4284E+00, &
2987 & .1000E+01,.9990E+00,.9832E+00,.9107E+00,.6815E+00,.7994E+00, &
2988 & .7018E+00,.7143E+00,.5313E+00,.6011E+00,.5836E+00,.5877E+00, &
2989 & .4635E+00,.4341E+00,.4456E+00,.4551E+00,.4589E+00,.4382E+00, &
2990 & .1000E+01,.9987E+00,.9813E+00,.8925E+00,.6748E+00,.7865E+00, &
2991 & .6908E+00,.6951E+00,.5373E+00,.5836E+00,.5624E+00,.5605E+00, &
2992 & .4652E+00,.4443E+00,.4537E+00,.4598E+00,.4620E+00,.4474E+00, &
2993 & .1000E+01,.9988E+00,.9800E+00,.8969E+00,.6654E+00,.7781E+00, &
2994 & .6947E+00,.6954E+00,.5480E+00,.5842E+00,.5572E+00,.5477E+00, &
2995 & .4642E+00,.4479E+00,.4572E+00,.4614E+00,.4620E+00,.4495E+00/
2996 data ((a_extx(i,j,1),i=1,mbx),j=1,nrh) / &
2997 & .2085E-03,.2085E-03,.1753E-03,.1667E-03,.1655E-03,.1667E-03, &
2998 & .1721E-03,.1735E-03,.1698E-03,.1700E-03,.1691E-03,.1647E-03, &
2999 & .1267E-03,.1256E-03,.1477E-03,.1473E-03,.1320E-03,.1206E-03, &
3000 & .2442E-03,.2391E-03,.1959E-03,.1850E-03,.1841E-03,.1836E-03, &
3001 & .1895E-03,.1909E-03,.1867E-03,.1895E-03,.1879E-03,.1794E-03, &
3002 & .1379E-03,.1395E-03,.1642E-03,.1644E-03,.1482E-03,.1336E-03, &
3003 & .3488E-03,.3479E-03,.3010E-03,.2796E-03,.2720E-03,.2663E-03, &
3004 & .2693E-03,.2725E-03,.2678E-03,.2743E-03,.2717E-03,.2589E-03, &
3005 & .2028E-03,.2152E-03,.2470E-03,.2496E-03,.2322E-03,.2076E-03, &
3006 & .7848E-03,.7872E-03,.7928E-03,.7466E-03,.7085E-03,.6744E-03, &
3007 & .6381E-03,.6362E-03,.6401E-03,.6470E-03,.6477E-03,.6350E-03, &
3008 & .5307E-03,.5726E-03,.6321E-03,.6438E-03,.6297E-03,.5842E-03, &
3009 & .1112E-02,.1113E-02,.1148E-02,.1112E-02,.1057E-02,.1004E-02, &
3010 & .9203E-03,.9076E-03,.9195E-03,.9147E-03,.9172E-03,.9072E-03, &
3011 & .7833E-03,.8441E-03,.9175E-03,.9317E-03,.9216E-03,.8724E-03, &
3012 & .1636E-02,.1619E-02,.1667E-02,.1673E-02,.1619E-02,.1548E-02, &
3013 & .1385E-02,.1345E-02,.1367E-02,.1335E-02,.1334E-02,.1324E-02, &
3014 & .1184E-02,.1269E-02,.1366E-02,.1379E-02,.1373E-02,.1323E-02, &
3015 & .2803E-02,.2748E-02,.2765E-02,.2829E-02,.2862E-02,.2813E-02, &
3016 & .2508E-02,.2396E-02,.2421E-02,.2312E-02,.2280E-02,.2252E-02, &
3017 & .2093E-02,.2240E-02,.2390E-02,.2388E-02,.2373E-02,.2328E-02, &
3018 & .4213E-02,.4113E-02,.4088E-02,.4098E-02,.4248E-02,.4287E-02, &
3019 & .3951E-02,.3743E-02,.3733E-02,.3520E-02,.3416E-02,.3331E-02, &
3020 & .3154E-02,.3390E-02,.3609E-02,.3580E-02,.3527E-02,.3473E-02/
3021 data ((a_asyx(i,j,1),i=1,mbx),j=1,nrh) / &
3022 & .7972E+00,.8182E+00,.8172E+00,.8200E+00,.8119E+00,.7766E+00, &
3023 & .8040E+00,.8212E+00,.8646E+00,.8447E+00,.8440E+00,.8411E+00, &
3024 & .8880E+00,.8602E+00,.7911E+00,.7291E+00,.6673E+00,.5545E+00, &
3025 & .8017E+00,.8218E+00,.8187E+00,.8216E+00,.8160E+00,.7809E+00, &
3026 & .8095E+00,.8488E+00,.8715E+00,.8498E+00,.8488E+00,.8597E+00, &
3027 & .8958E+00,.8652E+00,.7976E+00,.7375E+00,.6763E+00,.5685E+00, &
3028 & .7986E+00,.8234E+00,.8312E+00,.8353E+00,.8296E+00,.7968E+00, &
3029 & .8248E+00,.8507E+00,.8891E+00,.8648E+00,.8726E+00,.8853E+00, &
3030 & .9177E+00,.8834E+00,.8248E+00,.7727E+00,.7198E+00,.6379E+00, &
3031 & .7617E+00,.8120E+00,.8494E+00,.8614E+00,.8610E+00,.8308E+00, &
3032 & .8540E+00,.8626E+00,.9124E+00,.8874E+00,.9025E+00,.9183E+00, &
3033 & .9476E+00,.9123E+00,.8683E+00,.8336E+00,.7948E+00,.7445E+00, &
3034 & .7412E+00,.7992E+00,.8491E+00,.8673E+00,.8711E+00,.8437E+00, &
3035 & .8652E+00,.8700E+00,.9176E+00,.8950E+00,.9099E+00,.9256E+00, &
3036 & .9550E+00,.9187E+00,.8787E+00,.8512E+00,.8183E+00,.7759E+00, &
3037 & .7144E+00,.7752E+00,.8417E+00,.8684E+00,.8779E+00,.8554E+00, &
3038 & .8775E+00,.8804E+00,.9226E+00,.9026E+00,.9169E+00,.9319E+00, &
3039 & .9607E+00,.9236E+00,.8850E+00,.8645E+00,.8394E+00,.8044E+00, &
3040 & .6858E+00,.7430E+00,.8251E+00,.8605E+00,.8799E+00,.8649E+00, &
3041 & .8931E+00,.8955E+00,.9294E+00,.9133E+00,.9253E+00,.9394E+00, &
3042 & .9660E+00,.9273E+00,.8877E+00,.8751E+00,.8610E+00,.8366E+00, &
3043 & .6686E+00,.7251E+00,.8155E+00,.8500E+00,.8752E+00,.8642E+00, &
3044 & .9001E+00,.9040E+00,.9324E+00,.9183E+00,.9292E+00,.9420E+00, &
3045 & .9677E+00,.9280E+00,.8855E+00,.8724E+00,.8665E+00,.8517E+00/
3047 !c ************************************************
3048 !c Data statements for aerosol type 2 (continental)
3049 !c ************************************************
3050 data ((a_ssax(i,j,2),i=1,mbx),j=1,nrh) / &
3051 & .9607E+00,.9253E+00,.7650E+00,.3869E+00,.7830E+00,.8196E+00, &
3052 & .5468E+00,.3954E+00,.2303E+00,.6683E-01,.8012E-01,.1274E+00, &
3053 & .1627E+00,.9903E-01,.5161E-01,.4431E-01,.2697E-01,.1631E-01, &
3054 & .9606E+00,.9252E+00,.7650E+00,.3872E+00,.7821E+00,.8195E+00, &
3055 & .5486E+00,.3983E+00,.2330E+00,.6891E-01,.8092E-01,.1285E+00, &
3056 & .1625E+00,.1015E+00,.5113E-01,.4522E-01,.2781E-01,.1691E-01, &
3057 & .9632E+00,.9301E+00,.7820E+00,.4110E+00,.7464E+00,.8202E+00, &
3058 & .5511E+00,.4098E+00,.2105E+00,.7610E-01,.8126E-01,.1259E+00, &
3059 & .1316E+00,.6796E-01,.4130E-01,.4058E-01,.2661E-01,.1672E-01, &
3060 & .9730E+00,.9487E+00,.8461E+00,.5175E+00,.7033E+00,.8338E+00, &
3061 & .5724E+00,.4600E+00,.1834E+00,.1095E+00,.8760E-01,.1199E+00, &
3062 & .7362E-01,.2678E-01,.2572E-01,.3075E-01,.2423E-01,.1656E-01, &
3063 & .9820E+00,.9667E+00,.9056E+00,.6542E+00,.7047E+00,.8543E+00, &
3064 & .6027E+00,.5125E+00,.1824E+00,.1479E+00,.1006E+00,.1160E+00, &
3065 & .4699E-01,.1763E-01,.2012E-01,.2466E-01,.2149E-01,.1529E-01, &
3066 & .9859E+00,.9745E+00,.9303E+00,.7255E+00,.7137E+00,.8662E+00, &
3067 & .6230E+00,.5426E+00,.1894E+00,.1718E+00,.1117E+00,.1168E+00, &
3068 & .3984E-01,.1625E-01,.1928E-01,.2322E-01,.2079E-01,.1493E-01, &
3069 & .9891E+00,.9808E+00,.9500E+00,.7911E+00,.7245E+00,.8778E+00, &
3070 & .6552E+00,.5913E+00,.2128E+00,.2271E+00,.1459E+00,.1391E+00, &
3071 & .4313E-01,.2095E-01,.2574E-01,.3247E-01,.3267E-01,.2510E-01, &
3072 & .9914E+00,.9853E+00,.9630E+00,.8391E+00,.7353E+00,.8871E+00, &
3073 & .6780E+00,.6222E+00,.2295E+00,.2635E+00,.1717E+00,.1553E+00, &
3074 & .4561E-01,.2404E-01,.2966E-01,.3769E-01,.3967E-01,.3733E-01/
3075 data ((a_extx(i,j,2),i=1,mbx),j=1,nrh) / &
3076 & .1067E-04,.5658E-05,.1248E-05,.1317E-05,.2144E-06,.1635E-06, &
3077 & .1051E-06,.1039E-06,.1074E-06,.1852E-06,.3665E-06,.2548E-06, &
3078 & .8879E-07,.9337E-07,.1557E-06,.1269E-06,.1362E-06,.1536E-06, &
3079 & .1067E-04,.5659E-05,.1250E-05,.1318E-05,.2156E-06,.1645E-06, &
3080 & .1060E-06,.1047E-06,.1083E-06,.1859E-06,.3671E-06,.2554E-06, &
3081 & .8921E-07,.9426E-07,.1563E-06,.1274E-06,.1366E-06,.1539E-06, &
3082 & .1145E-04,.6089E-05,.1366E-05,.1390E-05,.2705E-06,.1893E-06, &
3083 & .1202E-06,.1160E-06,.1392E-06,.1982E-06,.3933E-06,.2795E-06, &
3084 & .1146E-06,.1395E-06,.1987E-06,.1543E-06,.1569E-06,.1719E-06, &
3085 & .1554E-04,.8394E-05,.2017E-05,.1792E-05,.5780E-06,.3314E-06, &
3086 & .1978E-06,.1767E-06,.3055E-06,.2637E-06,.5149E-06,.3873E-06, &
3087 & .2577E-06,.4005E-06,.4371E-06,.3044E-06,.2654E-06,.2658E-06, &
3088 & .2344E-04,.1308E-04,.3456E-05,.2666E-05,.1253E-05,.6574E-06, &
3089 & .3619E-06,.3005E-06,.6400E-06,.3929E-06,.7060E-06,.5523E-06, &
3090 & .5532E-06,.9393E-06,.9290E-06,.6129E-06,.4778E-06,.4448E-06, &
3091 & .3004E-04,.1716E-04,.4801E-05,.3491E-05,.1886E-05,.9781E-06, &
3092 & .5168E-06,.4150E-06,.9341E-06,.5071E-06,.8499E-06,.6765E-06, &
3093 & .8087E-06,.1406E-05,.1356E-05,.8808E-06,.6589E-06,.5955E-06, &
3094 & .3935E-04,.2315E-04,.6913E-05,.4819E-05,.2908E-05,.1535E-05, &
3095 & .8007E-06,.6334E-06,.1408E-05,.7153E-06,.1081E-05,.8758E-06, &
3096 & .1200E-05,.2109E-05,.2009E-05,.1301E-05,.9483E-06,.8356E-06, &
3097 & .5037E-04,.3051E-04,.9659E-05,.6565E-05,.4238E-05,.2277E-05, &
3098 & .1165E-05,.9083E-06,.1992E-05,.9700E-06,.1351E-05,.1111E-05, &
3099 & .1676E-05,.2962E-05,.2801E-05,.1811E-05,.1302E-05,.9664E-06/
3100 data ((a_asyx(i,j,2),i=1,mbx),j=1,nrh) / &
3101 & .6406E+00,.6057E+00,.5447E+00,.4976E+00,.4323E+00,.4216E+00, &
3102 & .4084E+00,.4038E+00,.3530E+00,.5334E+00,.4666E+00,.3619E+00, &
3103 & .4654E+00,.5418E+00,.5190E+00,.4775E+00,.4633E+00,.3869E+00, &
3104 & .6406E+00,.6057E+00,.5449E+00,.4982E+00,.4338E+00,.4240E+00, &
3105 & .4135E+00,.4106E+00,.3639E+00,.5480E+00,.4744E+00,.3681E+00, &
3106 & .4720E+00,.5471E+00,.5244E+00,.4836E+00,.4694E+00,.3936E+00, &
3107 & .6514E+00,.6161E+00,.5532E+00,.5076E+00,.4378E+00,.4297E+00, &
3108 & .4202E+00,.4202E+00,.3811E+00,.5519E+00,.4816E+00,.3768E+00, &
3109 & .4809E+00,.5492E+00,.5237E+00,.4896E+00,.4800E+00,.4086E+00, &
3110 & .6892E+00,.6537E+00,.5854E+00,.5436E+00,.4553E+00,.4509E+00, &
3111 & .4419E+00,.4494E+00,.4211E+00,.5500E+00,.4860E+00,.4133E+00, &
3112 & .5070E+00,.5397E+00,.5109E+00,.5082E+00,.5147E+00,.4602E+00, &
3113 & .7238E+00,.6909E+00,.6212E+00,.5832E+00,.4777E+00,.4729E+00, &
3114 & .4524E+00,.4581E+00,.4252E+00,.5112E+00,.4636E+00,.4340E+00, &
3115 & .5076E+00,.4990E+00,.4697E+00,.4977E+00,.5255E+00,.4928E+00, &
3116 & .7390E+00,.7084E+00,.6399E+00,.6042E+00,.4924E+00,.4874E+00, &
3117 & .4601E+00,.4628E+00,.4269E+00,.4922E+00,.4535E+00,.4423E+00, &
3118 & .5024E+00,.4712E+00,.4434E+00,.4853E+00,.5258E+00,.5079E+00, &
3119 & .7522E+00,.7245E+00,.6593E+00,.6270E+00,.5142E+00,.5121E+00, &
3120 & .4943E+00,.5049E+00,.4707E+00,.5452E+00,.5173E+00,.5260E+00, &
3121 & .5827E+00,.5439E+00,.5142E+00,.5589E+00,.5958E+00,.5818E+00, &
3122 & .7620E+00,.7371E+00,.6754E+00,.6456E+00,.5312E+00,.5297E+00, &
3123 & .5112E+00,.5218E+00,.4872E+00,.5553E+00,.5396E+00,.5633E+00, &
3124 & .6177E+00,.5629E+00,.5322E+00,.5821E+00,.6221E+00,.6250E+00/
3126 !c ******************************************
3127 !c Data statements for aerosol type 3 (urban)
3128 !c ******************************************
3129 data ((a_ssax(i,j,3),i=1,mbx),j=1,nrh) / &
3130 & .9371E+00,.8999E+00,.7175E+00,.3628E+00,.6462E+00,.6564E+00, &
3131 & .4011E+00,.2856E+00,.1754E+00,.3630E-01,.6500E-01,.8672E-01, &
3132 & .8039E-01,.3570E-01,.1633E-01,.1202E-01,.4884E-02,.2383E-02, &
3133 & .9365E+00,.8992E+00,.7160E+00,.3622E+00,.6417E+00,.6511E+00, &
3134 & .3969E+00,.2828E+00,.1736E+00,.3634E-01,.6489E-01,.8637E-01, &
3135 & .7938E-01,.3683E-01,.1618E-01,.1207E-01,.4972E-02,.2454E-02, &
3136 & .9386E+00,.9035E+00,.7316E+00,.3838E+00,.6180E+00,.6530E+00, &
3137 & .3951E+00,.2856E+00,.1549E+00,.3982E-01,.6398E-01,.8328E-01, &
3138 & .6367E-01,.2501E-01,.1367E-01,.1095E-01,.4813E-02,.2445E-02, &
3139 & .9522E+00,.9265E+00,.8037E+00,.4882E+00,.6214E+00,.7102E+00, &
3140 & .4367E+00,.3326E+00,.1370E+00,.5985E-01,.6507E-01,.7825E-01, &
3141 & .3715E-01,.1113E-01,.9892E-02,.9000E-02,.4744E-02,.2534E-02, &
3142 & .9669E+00,.9502E+00,.8773E+00,.6289E+00,.6589E+00,.7812E+00, &
3143 & .5069E+00,.4094E+00,.1465E+00,.9469E-01,.7425E-01,.7846E-01, &
3144 & .2566E-01,.8722E-02,.9422E-02,.8668E-02,.5022E-02,.2619E-02, &
3145 & .9733E+00,.9620E+00,.9086E+00,.7041E+00,.6797E+00,.8128E+00, &
3146 & .5458E+00,.4545E+00,.1573E+00,.1192E+00,.8364E-01,.8086E-01, &
3147 & .2264E-01,.8812E-02,.9970E-02,.9079E-02,.5429E-02,.2765E-02, &
3148 & .9790E+00,.9710E+00,.9339E+00,.7734E+00,.6992E+00,.8399E+00, &
3149 & .5866E+00,.5038E+00,.1729E+00,.1520E+00,.9926E-01,.8757E-01, &
3150 & .2187E-01,.1003E-01,.1172E-01,.1103E-01,.7504E-02,.4245E-02, &
3151 & .9832E+00,.9776E+00,.9511E+00,.8253E+00,.7164E+00,.8604E+00, &
3152 & .6219E+00,.5461E+00,.1893E+00,.1831E+00,.1159E+00,.9521E-01, &
3153 & .2208E-01,.1143E-01,.1350E-01,.1280E-01,.9112E-02,.6206E-02/
3154 data ((a_extx(i,j,3),i=1,mbx),j=1,nrh) / &
3155 & .6974E-05,.3689E-05,.8308E-06,.8639E-06,.1517E-06,.1172E-06, &
3156 & .7603E-07,.7487E-07,.7732E-07,.1226E-06,.2351E-06,.1602E-06, &
3157 & .5585E-07,.5913E-07,.9781E-07,.7830E-07,.8414E-07,.9499E-07, &
3158 & .6982E-05,.3693E-05,.8327E-06,.8656E-06,.1529E-06,.1183E-06, &
3159 & .7697E-07,.7577E-07,.7826E-07,.1234E-06,.2358E-06,.1609E-06, &
3160 & .5659E-07,.6006E-07,.9840E-07,.7871E-07,.8445E-07,.9516E-07, &
3161 & .7505E-05,.3978E-05,.9110E-06,.9159E-06,.1901E-06,.1358E-06, &
3162 & .8773E-07,.8470E-07,.9992E-07,.1329E-06,.2542E-06,.1781E-06, &
3163 & .7504E-07,.9126E-07,.1270E-06,.9669E-07,.9796E-07,.1067E-06, &
3164 & .1017E-04,.5464E-05,.1328E-05,.1172E-05,.3857E-06,.2239E-06, &
3165 & .1355E-06,.1219E-06,.2064E-06,.1743E-06,.3321E-06,.2476E-06, &
3166 & .1704E-06,.2630E-06,.2819E-06,.1932E-06,.1672E-06,.1659E-06, &
3167 & .1528E-04,.8466E-05,.2240E-05,.1723E-05,.8128E-06,.4251E-06, &
3168 & .2346E-06,.1956E-06,.4180E-06,.2532E-06,.4515E-06,.3513E-06, &
3169 & .3619E-06,.6124E-06,.5990E-06,.3904E-06,.3021E-06,.2789E-06, &
3170 & .1963E-04,.1111E-04,.3099E-05,.2247E-05,.1219E-05,.6254E-06, &
3171 & .3299E-06,.2652E-06,.6084E-06,.3245E-06,.5427E-06,.4307E-06, &
3172 & .5313E-06,.9227E-06,.8816E-06,.5662E-06,.4201E-06,.3763E-06, &
3173 & .2594E-04,.1505E-04,.4440E-05,.3077E-05,.1861E-05,.9545E-06, &
3174 & .4851E-06,.3783E-06,.8998E-06,.4362E-06,.6725E-06,.5438E-06, &
3175 & .7839E-06,.1386E-05,.1306E-05,.8310E-06,.5971E-06,.5214E-06, &
3176 & .3343E-04,.1989E-04,.6191E-05,.4176E-05,.2703E-05,.1404E-05, &
3177 & .6921E-06,.5279E-06,.3548E-06,.5771E-06,.8264E-06,.6774E-06, &
3178 & .1089E-05,.1946E-05,.1820E-05,.1152E-05,.8146E-06,.5980E-06/
3179 data ((a_asyx(i,j,3),i=1,mbx),j=1,nrh) / &
3180 & .6381E+00,.6035E+00,.5386E+00,.4849E+00,.3957E+00,.3761E+00, &
3181 & .3199E+00,.3006E+00,.2684E+00,.2713E+00,.2763E+00,.2241E+00, &
3182 & .2351E+00,.2725E+00,.2616E+00,.2607E+00,.3195E+00,.3162E+00, &
3183 & .6381E+00,.6035E+00,.5385E+00,.4849E+00,.3958E+00,.3764E+00, &
3184 & .3207E+00,.3018E+00,.2700E+00,.2780E+00,.2836E+00,.2254E+00, &
3185 & .2366E+00,.2730E+00,.2629E+00,.2658E+00,.3269E+00,.3239E+00, &
3186 & .6490E+00,.6137E+00,.5468E+00,.4946E+00,.4020E+00,.3834E+00, &
3187 & .3274E+00,.3089E+00,.2773E+00,.2849E+00,.2936E+00,.2285E+00, &
3188 & .2374E+00,.2654E+00,.2526E+00,.2639E+00,.3284E+00,.3327E+00, &
3189 & .6866E+00,.6512E+00,.5797E+00,.5327E+00,.4280E+00,.4121E+00, &
3190 & .3550E+00,.3374E+00,.3039E+00,.3043E+00,.2931E+00,.2444E+00, &
3191 & .2438E+00,.2427E+00,.2265E+00,.2565E+00,.3291E+00,.3575E+00, &
3192 & .7213E+00,.6884E+00,.6168E+00,.5756E+00,.4606E+00,.4473E+00, &
3193 & .3883E+00,.3700E+00,.3315E+00,.3171E+00,.2900E+00,.2650E+00, &
3194 & .2506E+00,.2220E+00,.2017E+00,.2297E+00,.2957E+00,.3450E+00, &
3195 & .7362E+00,.7055E+00,.6357E+00,.5977E+00,.4792E+00,.4674E+00, &
3196 & .4080E+00,.3893E+00,.3483E+00,.3287E+00,.2983E+00,.2787E+00, &
3197 & .2562E+00,.2159E+00,.1939E+00,.2169E+00,.2754E+00,.3308E+00, &
3198 & .7488E+00,.7206E+00,.6539E+00,.6192E+00,.4991E+00,.4892E+00, &
3199 & .4329E+00,.4163E+00,.3733E+00,.3608E+00,.3302E+00,.3274E+00, &
3200 & .2936E+00,.2500E+00,.2283E+00,.2661E+00,.3470E+00,.4161E+00, &
3201 & .7584E+00,.7326E+00,.6694E+00,.6376E+00,.5167E+00,.5082E+00, &
3202 & .4535E+00,.4373E+00,.3927E+00,.3798E+00,.3500E+00,.3381E+00, &
3203 & .3171E+00,.2640E+00,.2404E+00,.2809E+00,.3669E+00,.4590E+00/
3205 !c ***********************************************
3206 !c Data statements for T&L 0.5 micron dust aerosol
3207 !c ***********************************************
3208 data ((a_ssax(i,j,4),i=1,mbx),j=1,nrh) / &
3209 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3210 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3211 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
3212 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3213 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3214 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
3215 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3216 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3217 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
3218 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3219 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3220 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
3221 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3222 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3223 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
3224 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3225 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3226 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
3227 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3228 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3229 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
3230 & .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
3231 & .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
3232 & .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02/
3233 data ((a_extx(i,j,4),i=1,mbx),j=1,nrh) / &
3234 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3235 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3236 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
3237 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3238 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3239 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
3240 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3241 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3242 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
3243 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3244 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3245 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
3246 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3247 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3248 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
3249 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3250 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3251 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
3252 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3253 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3254 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
3255 & .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
3256 & .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
3257 & .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01/
3258 data ((a_asyx(i,j,4),i=1,mbx),j=1,nrh) / &
3259 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3260 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3261 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
3262 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3263 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3264 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
3265 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3266 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3267 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
3268 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3269 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3270 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
3271 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3272 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3273 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
3274 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3275 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3276 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
3277 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3278 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3279 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
3280 & .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
3281 & .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
3282 & .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02/
3283 !c ***********************************************
3284 !c Data statements for T&L 1.0 micron dust aerosol
3285 !c ***********************************************
3286 data ((a_ssax(i,j,5),i=1,mbx),j=1,nrh) / &
3287 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3288 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3289 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
3290 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3291 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3292 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
3293 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3294 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3295 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
3296 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3297 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3298 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
3299 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3300 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3301 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
3302 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3303 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3304 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
3305 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3306 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3307 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
3308 & .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
3309 & .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
3310 & .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01/
3311 data ((a_extx(i,j,5),i=1,mbx),j=1,nrh) / &
3312 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3313 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3314 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
3315 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3316 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3317 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
3318 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3319 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3320 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
3321 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3322 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3323 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
3324 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3325 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3326 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
3327 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3328 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3329 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
3330 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3331 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3332 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
3333 & .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
3334 & .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
3335 & .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01/
3336 data ((a_asyx(i,j,5),i=1,mbx),j=1,nrh) / &
3337 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3338 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3339 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
3340 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3341 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3342 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
3343 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3344 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3345 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
3346 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3347 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3348 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
3349 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3350 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3351 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
3352 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3353 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3354 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
3355 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3356 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3357 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
3358 & .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
3359 & .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
3360 & .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01/
3361 !c ***********************************************
3362 !c Data statements for T&L 2.0 micron dust aerosol
3363 !c ***********************************************
3364 data ((a_ssax(i,j,6),i=1,mbx),j=1,nrh) / &
3365 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3366 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3367 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
3368 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3369 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3370 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
3371 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3372 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3373 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
3374 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3375 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3376 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
3377 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3378 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3379 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
3380 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3381 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3382 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
3383 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3384 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3385 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
3386 & .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
3387 & .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
3388 & .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00/
3389 data ((a_extx(i,j,6),i=1,mbx),j=1,nrh) / &
3390 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3391 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3392 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
3393 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3394 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3395 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
3396 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3397 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3398 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
3399 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3400 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3401 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
3402 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3403 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3404 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
3405 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3406 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3407 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
3408 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3409 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3410 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
3411 & .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
3412 & .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
3413 & .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00/
3414 data ((a_asyx(i,j,6),i=1,mbx),j=1,nrh) / &
3415 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3416 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3417 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
3418 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3419 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3420 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
3421 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3422 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3423 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
3424 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3425 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3426 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
3427 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3428 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3429 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
3430 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3431 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3432 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
3433 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3434 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3435 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
3436 & .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
3437 & .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
3438 & .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00/
3439 !c ***********************************************
3440 !c Data statements for T&L 4.0 micron dust aerosol
3441 !c ***********************************************
3442 data ((a_ssax(i,j,7),i=1,mbx),j=1,nrh) / &
3443 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3444 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3445 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
3446 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3447 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3448 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
3449 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3450 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3451 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
3452 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3453 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3454 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
3455 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3456 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3457 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
3458 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3459 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3460 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
3461 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3462 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3463 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
3464 & .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
3465 & .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
3466 & .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00/
3467 data ((a_extx(i,j,7),i=1,mbx),j=1,nrh) / &
3468 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3469 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3470 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
3471 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3472 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3473 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
3474 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3475 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3476 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
3477 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3478 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3479 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
3480 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3481 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3482 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
3483 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3484 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3485 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
3486 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3487 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3488 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
3489 & .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
3490 & .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
3491 & .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00/
3492 data ((a_asyx(i,j,7),i=1,mbx),j=1,nrh) / &
3493 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3494 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3495 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
3496 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3497 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3498 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
3499 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3500 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3501 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
3502 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3503 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3504 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
3505 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3506 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3507 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
3508 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3509 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3510 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
3511 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3512 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3513 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
3514 & .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
3515 & .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
3516 & .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00/
3517 !c ***********************************************
3518 !c Data statements for T&L 8.0 micron dust aerosol
3519 !c ***********************************************
3520 data ((a_ssax(i,j,8),i=1,mbx),j=1,nrh) / &
3521 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3522 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3523 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
3524 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3525 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3526 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
3527 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3528 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3529 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
3530 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3531 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3532 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
3533 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3534 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3535 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
3536 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3537 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3538 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
3539 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3540 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3541 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
3542 & .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
3543 & .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
3544 & .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00/
3545 data ((a_extx(i,j,8),i=1,mbx),j=1,nrh) / &
3546 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3547 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3548 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
3549 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3550 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3551 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
3552 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3553 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3554 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
3555 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3556 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3557 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
3558 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3559 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3560 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
3561 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3562 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3563 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
3564 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3565 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3566 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
3567 & .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
3568 & .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
3569 & .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01/
3570 data ((a_asyx(i,j,8),i=1,mbx),j=1,nrh) / &
3571 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3572 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3573 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
3574 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3575 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3576 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
3577 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3578 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3579 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
3580 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3581 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3582 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
3583 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3584 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3585 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
3586 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3587 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3588 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
3589 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3590 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3591 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
3592 & .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
3593 & .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
3594 & .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00/
3596 !====================================================================
3597 ! OPAC X
3598 !-----------------------------------------------------------
3599 !9) inso Insoluble
3600 data ((a_extx(i,j, 9 ),i=1,mbx), j=1,1 ) / &
3601 & 0.9992E+00,0.1055E+01,0.1097E+01,0.9565E+00,0.7209E+00,0.8266E+00, &
3602 & 0.6757E+00,0.4984E+00,0.4294E+00,0.4649E+00,0.5541E+00,0.8549E+00, &
3603 & 0.6774E+00,0.5136E+00,0.4909E+00,0.4952E+00,0.4213E+00,0.3563E+00/
3604 data ((a_ssax(i,j, 9 ),i=1,mbx), j=1,1 ) / &
3605 & 0.7289E+00,0.7933E+00,0.8553E+00,0.8828E+00,0.8465E+00,0.8840E+00, &
3606 & 0.8537E+00,0.7561E+00,0.5914E+00,0.6595E+00,0.5205E+00,0.5811E+00, &
3607 & 0.6361E+00,0.6307E+00,0.6348E+00,0.5020E+00,0.4057E+00,0.3352E+00/
3608 data ((a_asyx(i,j, 9 ),i=1,mbx), j=1,1 ) / &
3609 & 0.8317E+00,0.7882E+00,0.8003E+00,0.8834E+00,0.9145E+00,0.8506E+00, &
3610 & 0.8563E+00,0.8778E+00,0.8615E+00,0.8283E+00,0.7892E+00,0.6657E+00, &
3611 & 0.6808E+00,0.6886E+00,0.6387E+00,0.5706E+00,0.4973E+00,0.3480E+00/
3612 !-----------------------------------------------------------
3613 !10) waso Water Soluble (8 RH%)
3614 data ((a_extx(i,j,10 ),i=1,mbx), j=1,8 ) / &
3615 & 0.1015E+01,0.4304E+00,0.1407E+00,0.4076E-01,0.2793E-01,0.9580E-02, &
3616 & 0.8208E-02,0.8256E-02,0.1281E-01,0.1857E-01,0.3590E-01,0.2404E-01, &
3617 & 0.8152E-02,0.8273E-02,0.2205E-01,0.1285E-01,0.1426E-01,0.2008E-01, &
3618 & 0.1015E+01,0.4417E+00,0.1461E+00,0.4302E-01,0.7731E-01,0.1407E-01, &
3619 & 0.1064E-01,0.1307E-01,0.1784E-01,0.1697E-01,0.3190E-01,0.2466E-01, &
3620 & 0.1843E-01,0.3242E-01,0.3835E-01,0.2407E-01,0.1947E-01,0.2221E-01, &
3621 & 0.1014E+01,0.4488E+00,0.1501E+00,0.4563E-01,0.9123E-01,0.1620E-01, &
3622 & 0.1167E-01,0.1446E-01,0.1949E-01,0.1647E-01,0.2965E-01,0.2378E-01, &
3623 & 0.2184E-01,0.4049E-01,0.4408E-01,0.2782E-01,0.2101E-01,0.2265E-01, &
3624 & 0.1014E+01,0.4559E+00,0.1546E+00,0.4833E-01,0.1014E+00,0.1818E-01, &
3625 & 0.1258E-01,0.1550E-01,0.2072E-01,0.1613E-01,0.2769E-01,0.2283E-01, &
3626 & 0.2429E-01,0.4633E-01,0.4824E-01,0.3054E-01,0.2207E-01,0.2287E-01, &
3627 & 0.1013E+01,0.4713E+00,0.1650E+00,0.5434E-01,0.1170E+00,0.2223E-01, &
3628 & 0.1438E-01,0.1721E-01,0.2264E-01,0.1573E-01,0.2436E-01,0.2105E-01, &
3629 & 0.2776E-01,0.5469E-01,0.5422E-01,0.3446E-01,0.2350E-01,0.2308E-01, &
3630 & 0.1012E+01,0.4913E+00,0.1795E+00,0.6242E-01,0.1310E+00,0.2735E-01, &
3631 & 0.1663E-01,0.1898E-01,0.2444E-01,0.1565E-01,0.2154E-01,0.1943E-01, &
3632 & 0.3035E-01,0.6100E-01,0.5878E-01,0.3746E-01,0.2454E-01,0.2318E-01, &
3633 & 0.1011E+01,0.5221E+00,0.2038E+00,0.7577E-01,0.1474E+00,0.3559E-01, &
3634 & 0.2032E-01,0.2156E-01,0.2687E-01,0.1612E-01,0.1925E-01,0.1809E-01, &
3635 & 0.3271E-01,0.6668E-01,0.6308E-01,0.4032E-01,0.2557E-01,0.2331E-01, &
3636 & 0.1010E+01,0.5447E+00,0.2230E+00,0.8651E-01,0.1583E+00,0.4224E-01, &
3637 & 0.2339E-01,0.2363E-01,0.2874E-01,0.1684E-01,0.1855E-01,0.1772E-01, &
3638 & 0.3399E-01,0.6967E-01,0.6553E-01,0.4195E-01,0.2624E-01,0.2355E-01/
3639 data ((a_ssax(i,j,10 ),i=1,mbx), j=1,8 ) / &
3640 & 0.9633E+00,0.8961E+00,0.7687E+00,0.7940E+00,0.5192E+00,0.7595E+00, &
3641 & 0.3996E+00,0.2073E+00,0.9201E-01,0.1337E-01,0.3585E-01,0.4407E-01, &
3642 & 0.3943E-01,0.1419E-01,0.4977E-02,0.3965E-02,0.8396E-03,0.1067E-03, &
3643 & 0.9776E+00,0.9357E+00,0.8539E+00,0.8702E+00,0.4324E+00,0.7956E+00, &
3644 & 0.4373E+00,0.2277E+00,0.9151E-01,0.3219E-01,0.3617E-01,0.4094E-01, &
3645 & 0.1815E-01,0.4240E-02,0.3668E-02,0.3164E-02,0.1059E-02,0.1485E-03, &
3646 & 0.9820E+00,0.9484E+00,0.8829E+00,0.8940E+00,0.4503E+00,0.8121E+00, &
3647 & 0.4596E+00,0.2482E+00,0.9977E-01,0.4317E-01,0.3868E-01,0.4120E-01, &
3648 & 0.1566E-01,0.3913E-02,0.3780E-02,0.3268E-02,0.1219E-02,0.1749E-03, &
3649 & 0.9850E+00,0.9577E+00,0.9041E+00,0.9111E+00,0.4686E+00,0.8259E+00, &
3650 & 0.4808E+00,0.2680E+00,0.1088E+00,0.5411E-01,0.4245E-01,0.4209E-01, &
3651 & 0.1441E-01,0.3948E-02,0.4031E-02,0.3475E-02,0.1394E-02,0.2031E-03, &
3652 & 0.9895E+00,0.9710E+00,0.9349E+00,0.9351E+00,0.5035E+00,0.8496E+00, &
3653 & 0.5230E+00,0.3079E+00,0.1297E+00,0.7788E-01,0.5266E-01,0.4537E-01, &
3654 & 0.1346E-01,0.4473E-02,0.4808E-02,0.4116E-02,0.1823E-02,0.2823E-03, &
3655 & 0.9928E+00,0.9810E+00,0.9578E+00,0.9527E+00,0.5393E+00,0.8720E+00, &
3656 & 0.5707E+00,0.3541E+00,0.1579E+00,0.1089E+00,0.6886E-01,0.5146E-01, &
3657 & 0.1377E-01,0.5552E-02,0.6102E-02,0.5203E-02,0.2488E-02,0.4103E-03, &
3658 & 0.9956E+00,0.9891E+00,0.9761E+00,0.9670E+00,0.5805E+00,0.8959E+00, &
3659 & 0.6318E+00,0.4163E+00,0.2022E+00,0.1575E+00,0.9848E-01,0.6388E-01, &
3660 & 0.1577E-01,0.7723E-02,0.8602E-02,0.7370E-02,0.3795E-02,0.6676E-03, &
3661 & 0.9968E+00,0.9924E+00,0.9834E+00,0.9730E+00,0.6038E+00,0.9087E+00, &
3662 & 0.6692E+00,0.4563E+00,0.2352E+00,0.1938E+00,0.1231E+00,0.7513E-01, &
3663 & 0.1802E-01,0.9667E-02,0.1084E-01,0.9370E-02,0.5020E-02,0.9152E-03/
3664 data ((a_asyx(i,j,10 ),i=1,mbx), j=1,8 ) / &
3665 & 0.6143E+00,0.5585E+00,0.4813E+00,0.4255E+00,0.3592E+00,0.3090E+00, &
3666 & 0.2571E+00,0.2231E+00,0.1912E+00,0.1539E+00,0.1519E+00,0.1543E+00, &
3667 & 0.1251E+00,0.9279E-01,0.7617E-01,0.6363E-01,0.3473E-01,0.1405E-01, &
3668 & 0.6722E+00,0.6148E+00,0.5341E+00,0.4799E+00,0.3881E+00,0.3523E+00, &
3669 & 0.2969E+00,0.2574E+00,0.2247E+00,0.1905E+00,0.1774E+00,0.1667E+00, &
3670 & 0.1328E+00,0.9845E-01,0.8187E-01,0.6865E-01,0.4277E-01,0.1880E-01, &
3671 & 0.6904E+00,0.6342E+00,0.5549E+00,0.5011E+00,0.4022E+00,0.3708E+00, &
3672 & 0.3143E+00,0.2736E+00,0.2399E+00,0.2062E+00,0.1893E+00,0.1753E+00, &
3673 & 0.1392E+00,0.1030E+00,0.8623E-01,0.7257E-01,0.4688E-01,0.2120E-01, &
3674 & 0.7042E+00,0.6494E+00,0.5709E+00,0.5194E+00,0.4152E+00,0.3860E+00, &
3675 & 0.3294E+00,0.2869E+00,0.2526E+00,0.2205E+00,0.2002E+00,0.1837E+00, &
3676 & 0.1454E+00,0.1079E+00,0.9064E-01,0.7653E-01,0.5081E-01,0.2344E-01, &
3677 & 0.7254E+00,0.6740E+00,0.5991E+00,0.5504E+00,0.4394E+00,0.4146E+00, &
3678 & 0.3578E+00,0.3133E+00,0.2782E+00,0.2459E+00,0.2224E+00,0.2017E+00, &
3679 & 0.1597E+00,0.1181E+00,0.1001E+00,0.8510E-01,0.5879E-01,0.2824E-01, &
3680 & 0.7433E+00,0.6967E+00,0.6270E+00,0.5823E+00,0.4667E+00,0.4446E+00, &
3681 & 0.3888E+00,0.3432E+00,0.3068E+00,0.2755E+00,0.2484E+00,0.2241E+00, &
3682 & 0.1777E+00,0.1315E+00,0.1119E+00,0.9622E-01,0.6871E-01,0.3408E-01, &
3683 & 0.7612E+00,0.7217E+00,0.6594E+00,0.6202E+00,0.5032E+00,0.4833E+00, &
3684 & 0.4295E+00,0.3836E+00,0.3454E+00,0.3147E+00,0.2852E+00,0.2571E+00, &
3685 & 0.2045E+00,0.1520E+00,0.1300E+00,0.1126E+00,0.8357E-01,0.4311E-01, &
3686 & 0.7701E+00,0.7355E+00,0.6784E+00,0.6433E+00,0.5268E+00,0.5073E+00, &
3687 & 0.4559E+00,0.4108E+00,0.3712E+00,0.3412E+00,0.3106E+00,0.2803E+00, &
3688 & 0.2242E+00,0.1672E+00,0.1436E+00,0.1248E+00,0.9454E-01,0.5018E-01/
3689 !-----------------------------------------------------------
3690 !11) soot Soot
3691 data ((a_extx(i,j,11 ),i=1,mbx), j=1,1 ) / &
3692 & 0.1017E+01,0.5114E+00,0.2718E+00,0.1911E+00,0.1446E+00,0.1113E+00, &
3693 & 0.8555E-01,0.7200E-01,0.6089E-01,0.5213E-01,0.4566E-01,0.4003E-01, &
3694 & 0.3392E-01,0.2769E-01,0.2254E-01,0.1702E-01,0.1213E-01,0.7093E-02/
3695 data ((a_ssax(i,j,11 ),i=1,mbx), j=1,1 ) / &
3696 & 0.2102E+00,0.1127E+00,0.4250E-01,0.2007E-01,0.9655E-02,0.5070E-02, &
3697 & 0.2738E-02,0.1795E-02,0.1192E-02,0.8190E-03,0.6116E-03,0.4481E-03, &
3698 & 0.2918E-03,0.1761E-03,0.1049E-03,0.5490E-04,0.2308E-04,0.5530E-05/
3699 data ((a_asyx(i,j,11 ),i=1,mbx), j=1,1 ) / &
3700 & 0.3375E+00,0.2412E+00,0.1541E+00,0.1086E+00,0.7644E-01,0.5501E-01, &
3701 & 0.3917E-01,0.3088E-01,0.2415E-01,0.1913E-01,0.1581E-01,0.1289E-01, &
3702 & 0.9727E-02,0.6915E-02,0.4858E-02,0.3121E-02,0.1759E-02,0.1141E-02/
3703 !-----------------------------------------------------------
3704 !12) ssam Sea Salt (Accumulation Mode) (8 RH%)
3705 data ((a_extx(i,j,12 ),i=1,mbx), j=1,8 ) / &
3706 & 0.9977E+00,0.9420E+00,0.7044E+00,0.4678E+00,0.4148E+00,0.2336E+00, &
3707 & 0.1493E+00,0.7957E-01,0.7247E-01,0.4367E-01,0.5551E-01,0.4474E-01, &
3708 & 0.2241E-01,0.1365E-01,0.2654E-01,0.2912E-01,0.3158E-01,0.1472E+00, &
3709 & 0.9989E+00,0.1010E+01,0.8520E+00,0.6085E+00,0.5675E+00,0.4096E+00, &
3710 & 0.2546E+00,0.1694E+00,0.1644E+00,0.1067E+00,0.9235E-01,0.7284E-01, &
3711 & 0.8140E-01,0.1443E+00,0.1495E+00,0.1081E+00,0.7115E-01,0.1054E+00, &
3712 & 0.9984E+00,0.1028E+01,0.9029E+00,0.6677E+00,0.6213E+00,0.4742E+00, &
3713 & 0.2993E+00,0.2035E+00,0.1981E+00,0.1314E+00,0.1092E+00,0.8514E-01, &
3714 & 0.9789E-01,0.1765E+00,0.1827E+00,0.1321E+00,0.8473E-01,0.1036E+00, &
3715 & 0.9991E+00,0.1045E+01,0.9466E+00,0.7224E+00,0.6693E+00,0.5337E+00, &
3716 & 0.3425E+00,0.2364E+00,0.2303E+00,0.1556E+00,0.1262E+00,0.9751E-01, &
3717 & 0.1125E+00,0.2040E+00,0.2118E+00,0.1541E+00,0.9772E-01,0.1055E+00, &
3718 & 0.9984E+00,0.1066E+01,0.1022E+01,0.8298E+00,0.7614E+00,0.6542E+00, &
3719 & 0.4369E+00,0.3089E+00,0.3009E+00,0.2109E+00,0.1665E+00,0.1265E+00, &
3720 & 0.1427E+00,0.2574E+00,0.2702E+00,0.2006E+00,0.1267E+00,0.1155E+00, &
3721 & 0.9990E+00,0.1079E+01,0.1088E+01,0.9476E+00,0.8625E+00,0.7960E+00, &
3722 & 0.5610E+00,0.4073E+00,0.3966E+00,0.2898E+00,0.2262E+00,0.1696E+00, &
3723 & 0.1816E+00,0.3214E+00,0.3426E+00,0.2624E+00,0.1681E+00,0.1363E+00, &
3724 & 0.9994E+00,0.1075E+01,0.1141E+01,0.1086E+01,0.9872E+00,0.9866E+00, &
3725 & 0.7578E+00,0.5745E+00,0.5599E+00,0.4348E+00,0.3419E+00,0.2551E+00, &
3726 & 0.2490E+00,0.4208E+00,0.4585E+00,0.3704E+00,0.2469E+00,0.1830E+00, &
3727 & 0.9998E+00,0.1066E+01,0.1149E+01,0.1154E+01,0.1059E+01,0.1105E+01, &
3728 & 0.9090E+00,0.7161E+00,0.7000E+00,0.5694E+00,0.4561E+00,0.3430E+00, &
3729 & 0.3119E+00,0.5031E+00,0.5565E+00,0.4695E+00,0.3264E+00,0.2343E+00/
3730 data ((a_ssax(i,j,12 ),i=1,mbx), j=1,8 ) / &
3731 & 0.1000E+01,0.9991E+00,0.9957E+00,0.9892E+00,0.9560E+00,0.9897E+00, &
3732 & 0.9825E+00,0.9471E+00,0.9222E+00,0.8519E+00,0.7555E+00,0.8130E+00, &
3733 & 0.7537E+00,0.5286E+00,0.2979E+00,0.1749E+00,0.6170E-01,0.1383E-01, &
3734 & 0.1000E+01,0.9997E+00,0.9976E+00,0.9895E+00,0.7743E+00,0.9725E+00, &
3735 & 0.9208E+00,0.8068E+00,0.6949E+00,0.7072E+00,0.6425E+00,0.5446E+00, &
3736 & 0.2100E+00,0.9825E-01,0.1218E+00,0.1271E+00,0.8758E-01,0.1948E-01, &
3737 & 0.1000E+01,0.9997E+00,0.9978E+00,0.9891E+00,0.7705E+00,0.9709E+00, &
3738 & 0.9168E+00,0.8044E+00,0.6898E+00,0.7093E+00,0.6428E+00,0.5309E+00, &
3739 & 0.1996E+00,0.1070E+00,0.1312E+00,0.1383E+00,0.1012E+00,0.2443E-01, &
3740 & 0.1000E+01,0.9998E+00,0.9979E+00,0.9888E+00,0.7694E+00,0.9699E+00, &
3741 & 0.9150E+00,0.8052E+00,0.6901E+00,0.7145E+00,0.6474E+00,0.5283E+00, &
3742 & 0.1984E+00,0.1163E+00,0.1411E+00,0.1495E+00,0.1139E+00,0.2946E-01, &
3743 & 0.1000E+01,0.9999E+00,0.9979E+00,0.9880E+00,0.7688E+00,0.9681E+00, &
3744 & 0.9134E+00,0.8094E+00,0.6964E+00,0.7279E+00,0.6622E+00,0.5372E+00, &
3745 & 0.2072E+00,0.1367E+00,0.1631E+00,0.1741E+00,0.1408E+00,0.4127E-01, &
3746 & 0.1000E+01,0.9999E+00,0.9978E+00,0.9865E+00,0.7684E+00,0.9659E+00, &
3747 & 0.9123E+00,0.8156E+00,0.7064E+00,0.7438E+00,0.6826E+00,0.5588E+00, &
3748 & 0.2270E+00,0.1626E+00,0.1908E+00,0.2048E+00,0.1747E+00,0.5801E-01, &
3749 & 0.1000E+01,0.9998E+00,0.9975E+00,0.9835E+00,0.7657E+00,0.9612E+00, &
3750 & 0.9093E+00,0.8228E+00,0.7186E+00,0.7624E+00,0.7101E+00,0.5961E+00, &
3751 & 0.2647E+00,0.2028E+00,0.2331E+00,0.2512E+00,0.2267E+00,0.9154E-01, &
3752 & 0.1000E+01,0.9998E+00,0.9970E+00,0.9801E+00,0.7611E+00,0.9558E+00, &
3753 & 0.9043E+00,0.8251E+00,0.7236E+00,0.7714E+00,0.7266E+00,0.6232E+00, &
3754 & 0.2972E+00,0.2351E+00,0.2662E+00,0.2865E+00,0.2670E+00,0.1236E+00/
3755 data ((a_asyx(i,j,12 ),i=1,mbx), j=1,8 ) / &
3756 & 0.6925E+00,0.7030E+00,0.7037E+00,0.7018E+00,0.6290E+00,0.6210E+00, &
3757 & 0.5823E+00,0.5754E+00,0.5304E+00,0.5025E+00,0.4631E+00,0.4344E+00, &
3758 & 0.4025E+00,0.3539E+00,0.3069E+00,0.2526E+00,0.1773E+00,0.5475E-01, &
3759 & 0.7710E+00,0.7780E+00,0.7844E+00,0.7895E+00,0.7592E+00,0.7110E+00, &
3760 & 0.6965E+00,0.6880E+00,0.6458E+00,0.6223E+00,0.5924E+00,0.5645E+00, &
3761 & 0.5042E+00,0.4073E+00,0.3515E+00,0.3059E+00,0.2449E+00,0.1281E+00, &
3762 & 0.7783E+00,0.7853E+00,0.7928E+00,0.8012E+00,0.7771E+00,0.7257E+00, &
3763 & 0.7169E+00,0.7105E+00,0.6705E+00,0.6489E+00,0.6225E+00,0.5962E+00, &
3764 & 0.5341E+00,0.4315E+00,0.3729E+00,0.3270E+00,0.2664E+00,0.1485E+00, &
3765 & 0.7840E+00,0.7886E+00,0.7979E+00,0.8088E+00,0.7893E+00,0.7363E+00, &
3766 & 0.7324E+00,0.7284E+00,0.6893E+00,0.6702E+00,0.6456E+00,0.6215E+00, &
3767 & 0.5591E+00,0.4524E+00,0.3921E+00,0.3454E+00,0.2847E+00,0.1658E+00, &
3768 & 0.7933E+00,0.7934E+00,0.8035E+00,0.8182E+00,0.8105E+00,0.7519E+00, &
3769 & 0.7564E+00,0.7580E+00,0.7218E+00,0.7047E+00,0.6859E+00,0.6656E+00, &
3770 & 0.6055E+00,0.4947E+00,0.4303E+00,0.3819E+00,0.3207E+00,0.2002E+00, &
3771 & 0.8009E+00,0.7966E+00,0.8065E+00,0.8250E+00,0.8289E+00,0.7651E+00, &
3772 & 0.7777E+00,0.7851E+00,0.7526E+00,0.7388E+00,0.7254E+00,0.7104E+00, &
3773 & 0.6555E+00,0.5434E+00,0.4756E+00,0.4249E+00,0.3629E+00,0.2389E+00, &
3774 & 0.8136E+00,0.8017E+00,0.8068E+00,0.8283E+00,0.8495E+00,0.7764E+00, &
3775 & 0.7991E+00,0.8159E+00,0.7883E+00,0.7786E+00,0.7723E+00,0.7651E+00, &
3776 & 0.7221E+00,0.6129E+00,0.5424E+00,0.4883E+00,0.4249E+00,0.2973E+00, &
3777 & 0.8244E+00,0.8072E+00,0.8066E+00,0.8277E+00,0.8617E+00,0.7812E+00, &
3778 & 0.8112E+00,0.8339E+00,0.8106E+00,0.8033E+00,0.8011E+00,0.7995E+00, &
3779 & 0.7670E+00,0.6642E+00,0.5932E+00,0.5376E+00,0.4736E+00,0.3449E+00/
3780 !-----------------------------------------------------------
3781 !13) sscm Sea Salt (Coarse Mode) (8 RH%)
3782 data ((a_extx(i,j,13 ),i=1,mbx), j=1,8 ) / &
3783 & 0.9980E+00,0.1032E+01,0.1084E+01,0.1141E+01,0.1180E+01,0.1239E+01, &
3784 & 0.1267E+01,0.1223E+01,0.1223E+01,0.1131E+01,0.1187E+01,0.1193E+01, &
3785 & 0.1003E+01,0.7764E+00,0.8981E+00,0.8734E+00,0.7043E+00,0.1087E+01, &
3786 & 0.9993E+00,0.1023E+01,0.1062E+01,0.1112E+01,0.1116E+01,0.1186E+01, &
3787 & 0.1231E+01,0.1199E+01,0.1211E+01,0.1190E+01,0.1166E+01,0.1088E+01, &
3788 & 0.8417E+00,0.8725E+00,0.1002E+01,0.1018E+01,0.9030E+00,0.8425E+00, &
3789 & 0.9997E+00,0.1023E+01,0.1056E+01,0.1100E+01,0.1103E+01,0.1170E+01, &
3790 & 0.1217E+01,0.1196E+01,0.1210E+01,0.1203E+01,0.1176E+01,0.1094E+01, &
3791 & 0.8508E+00,0.9063E+00,0.1030E+01,0.1053E+01,0.9529E+00,0.8484E+00, &
3792 & 0.1000E+01,0.1022E+01,0.1054E+01,0.1094E+01,0.1097E+01,0.1157E+01, &
3793 & 0.1208E+01,0.1194E+01,0.1209E+01,0.1213E+01,0.1186E+01,0.1105E+01, &
3794 & 0.8661E+00,0.9329E+00,0.1052E+01,0.1081E+01,0.9940E+00,0.8664E+00, &
3795 & 0.1000E+01,0.1020E+01,0.1045E+01,0.1079E+01,0.1084E+01,0.1135E+01, &
3796 & 0.1183E+01,0.1182E+01,0.1200E+01,0.1219E+01,0.1201E+01,0.1130E+01, &
3797 & 0.9010E+00,0.9733E+00,0.1084E+01,0.1122E+01,0.1062E+01,0.9151E+00, &
3798 & 0.9997E+00,0.1015E+01,0.1039E+01,0.1066E+01,0.1070E+01,0.1111E+01, &
3799 & 0.1154E+01,0.1163E+01,0.1181E+01,0.1209E+01,0.1205E+01,0.1153E+01, &
3800 & 0.9422E+00,0.1006E+01,0.1107E+01,0.1153E+01,0.1123E+01,0.9803E+00, &
3801 & 0.9997E+00,0.1013E+01,0.1034E+01,0.1052E+01,0.1058E+01,0.1087E+01, &
3802 & 0.1119E+01,0.1132E+01,0.1150E+01,0.1181E+01,0.1193E+01,0.1172E+01, &
3803 & 0.9974E+00,0.1041E+01,0.1125E+01,0.1178E+01,0.1183E+01,0.1076E+01, &
3804 & 0.9997E+00,0.1011E+01,0.1027E+01,0.1043E+01,0.1048E+01,0.1071E+01, &
3805 & 0.1097E+01,0.1109E+01,0.1124E+01,0.1152E+01,0.1169E+01,0.1167E+01, &
3806 & 0.1027E+01,0.1055E+01,0.1127E+01,0.1180E+01,0.1203E+01,0.1130E+01/
3807 data ((a_ssax(i,j,13 ),i=1,mbx), j=1,8 ) / &
3808 & 0.1000E+01,0.9930E+00,0.9727E+00,0.9556E+00,0.8560E+00,0.9741E+00, &
3809 & 0.9710E+00,0.9527E+00,0.9273E+00,0.9159E+00,0.8371E+00,0.8800E+00, &
3810 & 0.9069E+00,0.8668E+00,0.6916E+00,0.5906E+00,0.4595E+00,0.2559E+00, &
3811 & 0.1000E+01,0.9975E+00,0.9823E+00,0.9394E+00,0.7044E+00,0.9079E+00, &
3812 & 0.8498E+00,0.8049E+00,0.7115E+00,0.7686E+00,0.7483E+00,0.7304E+00, &
3813 & 0.5310E+00,0.3977E+00,0.4240E+00,0.4467E+00,0.4340E+00,0.2669E+00, &
3814 & 0.1000E+01,0.9979E+00,0.9830E+00,0.9334E+00,0.6994E+00,0.8936E+00, &
3815 & 0.8287E+00,0.7859E+00,0.6880E+00,0.7474E+00,0.7322E+00,0.7098E+00, &
3816 & 0.5087E+00,0.4006E+00,0.4249E+00,0.4450E+00,0.4379E+00,0.2892E+00, &
3817 & 0.1000E+01,0.9982E+00,0.9833E+00,0.9271E+00,0.6955E+00,0.8822E+00, &
3818 & 0.8119E+00,0.7713E+00,0.6711E+00,0.7314E+00,0.7197E+00,0.6954E+00, &
3819 & 0.4980E+00,0.4064E+00,0.4286E+00,0.4461E+00,0.4420E+00,0.3084E+00, &
3820 & 0.1000E+01,0.9986E+00,0.9832E+00,0.9143E+00,0.6881E+00,0.8606E+00, &
3821 & 0.7812E+00,0.7451E+00,0.6433E+00,0.7029E+00,0.6968E+00,0.6726E+00, &
3822 & 0.4893E+00,0.4204E+00,0.4386E+00,0.4515E+00,0.4504E+00,0.3412E+00, &
3823 & 0.1000E+01,0.9991E+00,0.9817E+00,0.8973E+00,0.6799E+00,0.8361E+00, &
3824 & 0.7480E+00,0.7169E+00,0.6158E+00,0.6723E+00,0.6710E+00,0.6503E+00, &
3825 & 0.4885E+00,0.4367E+00,0.4511E+00,0.4595E+00,0.4593E+00,0.3725E+00, &
3826 & 0.1000E+01,0.9992E+00,0.9791E+00,0.8695E+00,0.6676E+00,0.8005E+00, &
3827 & 0.7024E+00,0.6776E+00,0.5821E+00,0.6297E+00,0.6327E+00,0.6192E+00, &
3828 & 0.4926E+00,0.4581E+00,0.4687E+00,0.4714E+00,0.4702E+00,0.4072E+00, &
3829 & 0.1000E+01,0.9992E+00,0.9761E+00,0.8453E+00,0.6583E+00,0.7726E+00, &
3830 & 0.6703E+00,0.6494E+00,0.5614E+00,0.6001E+00,0.6039E+00,0.5952E+00, &
3831 & 0.4959E+00,0.4723E+00,0.4807E+00,0.4801E+00,0.4769E+00,0.4282E+00/
3832 data ((a_asyx(i,j,13 ),i=1,mbx), j=1,8 ) / &
3833 & 0.7964E+00,0.7818E+00,0.7631E+00,0.7611E+00,0.7325E+00,0.7164E+00, &
3834 & 0.7131E+00,0.7702E+00,0.7411E+00,0.7655E+00,0.7186E+00,0.6815E+00, &
3835 & 0.7176E+00,0.7450E+00,0.6774E+00,0.6201E+00,0.5680E+00,0.2940E+00, &
3836 & 0.8469E+00,0.8377E+00,0.8242E+00,0.8204E+00,0.8874E+00,0.7840E+00, &
3837 & 0.8116E+00,0.8563E+00,0.8519E+00,0.8503E+00,0.8474E+00,0.8563E+00, &
3838 & 0.8891E+00,0.8556E+00,0.7968E+00,0.7386E+00,0.6789E+00,0.5294E+00, &
3839 & 0.8506E+00,0.8444E+00,0.8319E+00,0.8316E+00,0.8958E+00,0.7934E+00, &
3840 & 0.8231E+00,0.8648E+00,0.8639E+00,0.8604E+00,0.8618E+00,0.8742E+00, &
3841 & 0.9029E+00,0.8659E+00,0.8120E+00,0.7583E+00,0.7014E+00,0.5713E+00, &
3842 & 0.8570E+00,0.8500E+00,0.8384E+00,0.8389E+00,0.9015E+00,0.8023E+00, &
3843 & 0.8313E+00,0.8704E+00,0.8722E+00,0.8666E+00,0.8712E+00,0.8855E+00, &
3844 & 0.9122E+00,0.8744E+00,0.8241E+00,0.7736E+00,0.7190E+00,0.6019E+00, &
3845 & 0.8604E+00,0.8566E+00,0.8500E+00,0.8528E+00,0.9109E+00,0.8159E+00, &
3846 & 0.8449E+00,0.8796E+00,0.8850E+00,0.8777E+00,0.8852E+00,0.9014E+00, &
3847 & 0.9259E+00,0.8882E+00,0.8437E+00,0.7991E+00,0.7488E+00,0.6523E+00, &
3848 & 0.8629E+00,0.8628E+00,0.8581E+00,0.8642E+00,0.9207E+00,0.8332E+00, &
3849 & 0.8599E+00,0.8889E+00,0.8985E+00,0.8885E+00,0.8968E+00,0.9141E+00, &
3850 & 0.9375E+00,0.9015E+00,0.8625E+00,0.8239E+00,0.7785E+00,0.6962E+00, &
3851 & 0.8680E+00,0.8658E+00,0.8674E+00,0.8815E+00,0.9323E+00,0.8570E+00, &
3852 & 0.8826E+00,0.9038E+00,0.9169E+00,0.9042E+00,0.9111E+00,0.9276E+00, &
3853 & 0.9504E+00,0.9180E+00,0.8843E+00,0.8539E+00,0.8157E+00,0.7501E+00, &
3854 & 0.8671E+00,0.8679E+00,0.8732E+00,0.8919E+00,0.9398E+00,0.8746E+00, &
3855 & 0.9008E+00,0.9166E+00,0.9314E+00,0.9176E+00,0.9221E+00,0.9365E+00, &
3856 & 0.9578E+00,0.9277E+00,0.8974E+00,0.8722E+00,0.8395E+00,0.7834E+00/
3857 !-----------------------------------------------------------
3858 !14) minm Mineral Dust (Nucleation Mode)
3859 data ((a_extx(i,j,14 ),i=1,mbx), j=1,1 ) / &
3860 & 0.6970E+00,0.3724E+00,0.1420E+00,0.6483E-01,0.3820E-01,0.1519E-01, &
3861 & 0.8261E-02,0.1004E-01,0.1296E-01,0.1639E-01,0.3130E-01,0.2811E-01, &
3862 & 0.2521E-01,0.1703E-01,0.1988E-01,0.1697E-01,0.9376E-02,0.9107E-02/
3863 data ((a_ssax(i,j,14 ),i=1,mbx), j=1,1 ) / &
3864 & 0.9647E+00,0.9747E+00,0.9551E+00,0.9100E+00,0.6865E+00,0.7466E+00, &
3865 & 0.5914E+00,0.2448E+00,0.1105E+00,0.2806E-01,0.1280E-01,0.9266E-01, &
3866 & 0.2898E-01,0.1546E-01,0.4009E-02,0.7202E-02,0.3913E-02,0.4404E-03/
3867 data ((a_asyx(i,j,14 ),i=1,mbx), j=1,1 ) / &
3868 & 0.6649E+00,0.6163E+00,0.5404E+00,0.4736E+00,0.4018E+00,0.3402E+00, &
3869 & 0.2763E+00,0.2324E+00,0.1920E+00,0.1511E+00,0.1181E+00,0.1573E+00, &
3870 & 0.1089E+00,0.8380E-01,0.5339E-01,0.5149E-01,0.3630E-01,0.1260E-01/
3871 !-----------------------------------------------------------
3872 !15) miam Mineral Dust (Accumulation Mode)
3873 data ((a_extx(i,j,15 ),i=1,mbx), j=1,1 ) / &
3874 & 0.9984E+00,0.1086E+01,0.1096E+01,0.9933E+00,0.8202E+00,0.6341E+00, &
3875 & 0.4556E+00,0.3471E+00,0.2878E+00,0.1996E+00,0.2565E+00,0.6046E+00, &
3876 & 0.3391E+00,0.2277E+00,0.1790E+00,0.2234E+00,0.1218E+00,0.6990E-01/
3877 data ((a_ssax(i,j,15 ),i=1,mbx), j=1,1 ) / &
3878 & 0.8711E+00,0.9378E+00,0.9463E+00,0.9390E+00,0.8556E+00,0.9280E+00, &
3879 & 0.9132E+00,0.7796E+00,0.6446E+00,0.3766E+00,0.1883E+00,0.4505E+00, &
3880 & 0.3751E+00,0.3398E+00,0.1766E+00,0.2689E+00,0.2345E+00,0.6417E-01/
3881 data ((a_asyx(i,j,15 ),i=1,mbx), j=1,1 ) / &
3882 & 0.7372E+00,0.6959E+00,0.6875E+00,0.6870E+00,0.6976E+00,0.6754E+00, &
3883 & 0.6587E+00,0.6577E+00,0.6356E+00,0.6194E+00,0.5500E+00,0.3734E+00, &
3884 & 0.4415E+00,0.4217E+00,0.3678E+00,0.2494E+00,0.2310E+00,0.1612E+00/
3885 !-----------------------------------------------------------
3886 !16) micm Mineral Dust (Coarse Mode)
3887 data ((a_extx(i,j,16 ),i=1,mbx), j=1,1 ) / &
3888 & 0.9996E+00,0.1027E+01,0.1068E+01,0.1107E+01,0.1148E+01,0.1198E+01, &
3889 & 0.1233E+01,0.1224E+01,0.1191E+01,0.1019E+01,0.8557E+00,0.1258E+01, &
3890 & 0.1215E+01,0.1151E+01,0.9892E+00,0.1223E+01,0.1120E+01,0.8345E+00/
3891 data ((a_ssax(i,j,16 ),i=1,mbx), j=1,1 ) / &
3892 & 0.6601E+00,0.7660E+00,0.7855E+00,0.7760E+00,0.6695E+00,0.8055E+00, &
3893 & 0.8213E+00,0.7032E+00,0.6400E+00,0.5581E+00,0.4115E+00,0.5215E+00, &
3894 & 0.4952E+00,0.5059E+00,0.4368E+00,0.4754E+00,0.4695E+00,0.3922E+00/
3895 data ((a_asyx(i,j,16 ),i=1,mbx), j=1,1 ) / &
3896 & 0.8973E+00,0.8441E+00,0.8113E+00,0.7920E+00,0.8221E+00,0.7620E+00, &
3897 & 0.7560E+00,0.8061E+00,0.8300E+00,0.8774E+00,0.8754E+00,0.6871E+00, &
3898 & 0.7447E+00,0.7345E+00,0.7462E+00,0.5502E+00,0.4931E+00,0.4435E+00/
3899 !-----------------------------------------------------------
3900 !17) mitr Mineral Dust (Transported Mode)
3901 data ((a_extx(i,j,17 ),i=1,mbx), j=1,1 ) / &
3902 & 0.9986E+00,0.1075E+01,0.1146E+01,0.1147E+01,0.1071E+01,0.9633E+00, &
3903 & 0.8081E+00,0.6535E+00,0.5407E+00,0.3475E+00,0.3921E+00,0.9254E+00, &
3904 & 0.5998E+00,0.4218E+00,0.3044E+00,0.4378E+00,0.2417E+00,0.1079E+00/
3905 data ((a_ssax(i,j,17 ),i=1,mbx), j=1,1 ) / &
3906 & 0.8289E+00,0.9121E+00,0.9248E+00,0.9199E+00,0.8342E+00,0.9235E+00, &
3907 & 0.9212E+00,0.8118E+00,0.7005E+00,0.4500E+00,0.2373E+00,0.4742E+00, &
3908 & 0.4401E+00,0.4147E+00,0.2391E+00,0.3436E+00,0.2894E+00,0.6579E-01/
3909 data ((a_asyx(i,j,17 ),i=1,mbx), j=1,1 ) / &
3910 & 0.7784E+00,0.7216E+00,0.6970E+00,0.6933E+00,0.7183E+00,0.6974E+00, &
3911 & 0.7035E+00,0.7204E+00,0.7080E+00,0.6903E+00,0.6241E+00,0.4321E+00, &
3912 & 0.5088E+00,0.4685E+00,0.3810E+00,0.2530E+00,0.1987E+00,0.7565E-01/
3913 !-----------------------------------------------------------
3914 !18) suso Sulfate Droplets (8 RH%)
3915 data ((a_extx(i,j,18 ),i=1,mbx), j=1,8 ) / &
3916 & 0.1009E+01,0.5315E+00,0.1916E+00,0.7670E-01,0.7874E-01,0.9590E-01, &
3917 & 0.6253E-01,0.7484E-01,0.4925E-01,0.9857E-01,0.1587E+00,0.9879E-01, &
3918 & 0.4700E-01,0.2393E-01,0.3030E-01,0.5892E-02,0.9433E-02,0.7848E-02, &
3919 & 0.1006E+01,0.5952E+00,0.2531E+00,0.1037E+00,0.1446E+00,0.7541E-01, &
3920 & 0.4527E-01,0.5074E-01,0.4011E-01,0.5088E-01,0.8283E-01,0.6455E-01, &
3921 & 0.4619E-01,0.5258E-01,0.5271E-01,0.2665E-01,0.1876E-01,0.1624E-01, &
3922 & 0.1006E+01,0.6212E+00,0.2790E+00,0.1177E+00,0.1633E+00,0.7724E-01, &
3923 & 0.4479E-01,0.4768E-01,0.4012E-01,0.4406E-01,0.6866E-01,0.5540E-01, &
3924 & 0.4558E-01,0.5987E-01,0.5860E-01,0.3197E-01,0.2137E-01,0.1845E-01, &
3925 & 0.1005E+01,0.6426E+00,0.3008E+00,0.1302E+00,0.1777E+00,0.8106E-01, &
3926 & 0.4587E-01,0.4669E-01,0.4100E-01,0.4064E-01,0.6060E-01,0.4993E-01, &
3927 & 0.4548E-01,0.6509E-01,0.6299E-01,0.3575E-01,0.2328E-01,0.2004E-01, &
3928 & 0.1004E+01,0.6814E+00,0.3426E+00,0.1554E+00,0.2042E+00,0.9223E-01, &
3929 & 0.5051E-01,0.4744E-01,0.4419E-01,0.3753E-01,0.5094E-01,0.4315E-01, &
3930 & 0.4619E-01,0.7387E-01,0.7072E-01,0.4208E-01,0.2658E-01,0.2275E-01, &
3931 & 0.1002E+01,0.7316E+00,0.4003E+00,0.1929E+00,0.2399E+00,0.1134E+00, &
3932 & 0.6077E-01,0.5232E-01,0.5093E-01,0.3767E-01,0.4499E-01,0.3886E-01, &
3933 & 0.4868E-01,0.8496E-01,0.8106E-01,0.5002E-01,0.3089E-01,0.2623E-01, &
3934 & 0.1001E+01,0.8035E+00,0.4928E+00,0.2593E+00,0.2985E+00,0.1572E+00, &
3935 & 0.8413E-01,0.6619E-01,0.6603E-01,0.4387E-01,0.4423E-01,0.3828E-01, &
3936 & 0.5504E-01,0.1028E+00,0.9851E-01,0.6287E-01,0.3814E-01,0.3191E-01, &
3937 & 0.1000E+01,0.8626E+00,0.5794E+00,0.3284E+00,0.3569E+00,0.2076E+00, &
3938 & 0.1130E+00,0.8469E-01,0.8470E-01,0.5441E-01,0.4914E-01,0.4181E-01, &
3939 & 0.6305E-01,0.1209E+00,0.1170E+00,0.7631E-01,0.4595E-01,0.3786E-01/
3940 data ((a_ssax(i,j,18 ),i=1,mbx), j=1,8 ) / &
3941 & 0.1000E+01,0.1000E+01,0.9976E+00,0.9708E+00,0.4906E+00,0.1774E+00, &
3942 & 0.1232E+00,0.6446E-01,0.5671E-01,0.1527E-01,0.2826E-01,0.4081E-01, &
3943 & 0.4101E-01,0.2760E-01,0.3588E-01,0.7646E-01,0.4123E-02,0.9668E-03, &
3944 & 0.1000E+01,0.1000E+01,0.9983E+00,0.9788E+00,0.5812E+00,0.4741E+00, &
3945 & 0.3407E+00,0.1657E+00,0.1505E+00,0.5469E-01,0.4088E-01,0.4982E-01, &
3946 & 0.3349E-01,0.1680E-01,0.1471E-01,0.1438E-01,0.6970E-02,0.1126E-02, &
3947 & 0.1000E+01,0.1000E+01,0.9985E+00,0.9808E+00,0.6104E+00,0.5805E+00, &
3948 & 0.4312E+00,0.2226E+00,0.1945E+00,0.8345E-01,0.5229E-01,0.5785E-01, &
3949 & 0.3432E-01,0.1778E-01,0.1680E-01,0.1577E-01,0.8189E-02,0.1382E-02, &
3950 & 0.1000E+01,0.1000E+01,0.9986E+00,0.9821E+00,0.6299E+00,0.6530E+00, &
3951 & 0.4985E+00,0.2720E+00,0.2305E+00,0.1115E+00,0.6457E-01,0.6601E-01, &
3952 & 0.3573E-01,0.1918E-01,0.1896E-01,0.1750E-01,0.9418E-02,0.1639E-02, &
3953 & 0.1000E+01,0.1000E+01,0.9987E+00,0.9839E+00,0.6588E+00,0.7549E+00, &
3954 & 0.6029E+00,0.3635E+00,0.2943E+00,0.1715E+00,0.9478E-01,0.8494E-01, &
3955 & 0.3964E-01,0.2273E-01,0.2375E-01,0.2170E-01,0.1224E-01,0.2239E-02, &
3956 & 0.1000E+01,0.1000E+01,0.9988E+00,0.9856E+00,0.6855E+00,0.8382E+00, &
3957 & 0.7003E+00,0.4687E+00,0.3675E+00,0.2569E+00,0.1474E+00,0.1163E+00, &
3958 & 0.4669E-01,0.2869E-01,0.3127E-01,0.2874E-01,0.1698E-01,0.3285E-02, &
3959 & 0.1000E+01,0.1000E+01,0.9988E+00,0.9871E+00,0.7126E+00,0.9027E+00, &
3960 & 0.7880E+00,0.5850E+00,0.4549E+00,0.3788E+00,0.2437E+00,0.1737E+00, &
3961 & 0.6041E-01,0.3976E-01,0.4490E-01,0.4222E-01,0.2651E-01,0.5546E-02, &
3962 & 0.1000E+01,0.1000E+01,0.9988E+00,0.9880E+00,0.7286E+00,0.9306E+00, &
3963 & 0.8321E+00,0.6533E+00,0.5139E+00,0.4686E+00,0.3312E+00,0.2294E+00, &
3964 & 0.7508E-01,0.5140E-01,0.5907E-01,0.5688E-01,0.3758E-01,0.8392E-02/
3965 data ((a_asyx(i,j,18 ),i=1,mbx), j=1,8 ) / &
3966 & 0.7172E+00,0.6760E+00,0.6086E+00,0.5473E+00,0.4571E+00,0.3765E+00, &
3967 & 0.3163E+00,0.2661E+00,0.2370E+00,0.1704E+00,0.1353E+00,0.1478E+00, &
3968 & 0.1519E+00,0.1258E+00,0.9522E-01,0.8572E-01,0.5257E-01,0.2308E-01, &
3969 & 0.7690E+00,0.7404E+00,0.6846E+00,0.6391E+00,0.5324E+00,0.4853E+00, &
3970 & 0.4211E+00,0.3673E+00,0.3292E+00,0.2748E+00,0.2325E+00,0.2197E+00, &
3971 & 0.1904E+00,0.1480E+00,0.1204E+00,0.1042E+00,0.7121E-01,0.3384E-01, &
3972 & 0.7779E+00,0.7541E+00,0.7040E+00,0.6637E+00,0.5565E+00,0.5153E+00, &
3973 & 0.4523E+00,0.3990E+00,0.3583E+00,0.3077E+00,0.2645E+00,0.2459E+00, &
3974 & 0.2086E+00,0.1601E+00,0.1321E+00,0.1139E+00,0.7974E-01,0.3877E-01, &
3975 & 0.7837E+00,0.7632E+00,0.7173E+00,0.6810E+00,0.5745E+00,0.5355E+00, &
3976 & 0.4752E+00,0.4226E+00,0.3808E+00,0.3328E+00,0.2889E+00,0.2660E+00, &
3977 & 0.2231E+00,0.1705E+00,0.1414E+00,0.1221E+00,0.8694E-01,0.4311E-01, &
3978 & 0.7900E+00,0.7755E+00,0.7368E+00,0.7068E+00,0.6048E+00,0.5693E+00, &
3979 & 0.5128E+00,0.4620E+00,0.4186E+00,0.3739E+00,0.3307E+00,0.3022E+00, &
3980 & 0.2507E+00,0.1908E+00,0.1600E+00,0.1377E+00,0.1008E+00,0.5131E-01, &
3981 & 0.7948E+00,0.7864E+00,0.7564E+00,0.7336E+00,0.6385E+00,0.6040E+00, &
3982 & 0.5541E+00,0.5070E+00,0.4625E+00,0.4216E+00,0.3796E+00,0.3465E+00, &
3983 & 0.2864E+00,0.2176E+00,0.1836E+00,0.1587E+00,0.1193E+00,0.6287E-01, &
3984 & 0.7975E+00,0.7959E+00,0.7766E+00,0.7635E+00,0.6804E+00,0.6449E+00, &
3985 & 0.6051E+00,0.5647E+00,0.5193E+00,0.4834E+00,0.4441E+00,0.4081E+00, &
3986 & 0.3392E+00,0.2584E+00,0.2196E+00,0.1909E+00,0.1477E+00,0.8069E-01, &
3987 & 0.7967E+00,0.8007E+00,0.7892E+00,0.7825E+00,0.7117E+00,0.6735E+00, &
3988 & 0.6423E+00,0.6084E+00,0.5632E+00,0.5303E+00,0.4951E+00,0.4587E+00, &
3989 & 0.3850E+00,0.2951E+00,0.2518E+00,0.2202E+00,0.1738E+00,0.9837E-01/
3990 end module aerosol1
3992 ! block data aerosol2
3993 module aerosol2
3994 !c 4/1/97
3995 !c ********************************************************************
3996 !c
3997 !c Data statements providing aerosol properties for the 10
3998 !c subintervals in the first Fu-Liou SW band.
3999 !c
4000 !c mb: Number of bands in code (will always be 10)
4001 !c naer: Number of aerosol types (will need to be changed here AND in
4002 !c aerosol subroutine.
4003 !c nrh: Number of different relative humidities (currently 8)
4004 !c
4005 !c Optical properties are dimensioned (10,8,naer): Number of
4006 !c sw sunintervals, number of relative humidities, and number of
4007 !c aerosol types. Properties were extracted from tables and mapped for
4008 !c the most part into the Fu-Liou spectral bands. sub-intervals 1-4,
4009 !c not available in the tables, were filled with properties from the
4010 !c 5th sub-interval. Intervals 5-6 were filled by direct insertion
4011 !c (1 table value per interval). The last two intervals were filled
4012 !c with 2 table values per interval, which were averaged using
4013 !c energy weighting. Tegen and Lacis values are not RH-dependent,
4014 !c so values are repeated.
4015 !c
4016 !c a_ssa: single-scattering albedo. One data statement for EACH type
4017 !c of aerosol.
4018 !c
4019 !c a_ext: extinction coefficient. Normalization is not important.
4020 !c These values are used for spectral weighting only!! One
4021 !c data statement for EACH type of aerosol.
4022 !c
4023 !c a_asy: Asymmetry parameter.One data statement for EACH type of
4024 !c aerosol.
4025 !c
4026 !c ********************************************************************
4027 !c USE RadParams
4028 !# include "para.file"
4029 USE PARA_FILE
4030 !c include 'para.file'
4031 implicit none
4032 !c## include 'rad_0698.h'
4033 integer, private :: i,j
4034 real a_ssay(mby,nrh,naer),a_exty(mby,nrh,naer)
4035 real a_asyy(mby,nrh,naer)
4036 ! common /aer_opty/ a_ssay,a_exty,a_asyy
4038 !c ****************************************************
4039 !c Data statements for aerosol type 1 (marine) sw bnd 1
4040 !c ****************************************************
4041 data ((a_ssay(i,j,1),i=1,mby),j=1,nrh) / &
4042 & .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4043 & .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4044 & .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4045 & .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4046 & .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4047 & .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4048 & .9999E+00,.9999E+00,.9999E+00,.9999E+00,.9999E+00,.1000E+01, &
4049 & .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4050 & .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4051 & .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4052 & .9993E+00,.9993E+00,.9993E+00,.9993E+00,.9993E+00,.1000E+01, &
4053 & .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4054 & .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4055 & .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4056 & .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
4057 & .1000E+01,.1000E+01,.1000E+01,.1000E+01/
4058 data ((a_exty(i,j,1),i=1,mby),j=1,nrh) / &
4059 & .2071E-03,.2071E-03,.2071E-03,.2071E-03,.2071E-03,.2084E-03, &
4060 & .2081E-03,.2065E-03,.2071E-03,.2101E-03, &
4061 & .2448E-03,.2448E-03,.2448E-03,.2448E-03,.2448E-03,.2459E-03, &
4062 & .2452E-03,.2437E-03,.2427E-03,.2447E-03, &
4063 & .3519E-03,.3519E-03,.3519E-03,.3519E-03,.3519E-03,.3499E-03, &
4064 & .3503E-03,.3510E-03,.3486E-03,.3468E-03, &
4065 & .7975E-03,.7975E-03,.7975E-03,.7975E-03,.7975E-03,.7928E-03, &
4066 & .7874E-03,.7863E-03,.7813E-03,.7843E-03, &
4067 & .1135E-02,.1135E-02,.1135E-02,.1135E-02,.1135E-02,.1122E-02, &
4068 & .1120E-02,.1113E-02,.1113E-02,.1106E-02, &
4069 & .1685E-02,.1685E-02,.1685E-02,.1685E-02,.1685E-02,.1671E-02, &
4070 & .1656E-02,.1644E-02,.1632E-02,.1626E-02, &
4071 & .2879E-02,.2879E-02,.2879E-02,.2879E-02,.2879E-02,.2872E-02, &
4072 & .2855E-02,.2832E-02,.2806E-02,.2770E-02, &
4073 & .4241E-02,.4241E-02,.4241E-02,.4241E-02,.4241E-02,.4274E-02, &
4074 & .4256E-02,.4255E-02,.4223E-02,.4171E-02/
4075 data ((a_asyy(i,j,1),i=1,mby),j=1,nrh) / &
4076 & .7513E+00,.7513E+00,.7513E+00,.7513E+00,.7513E+00,.7721E+00, &
4077 & .7842E+00,.7893E+00,.7963E+00,.8072E+00, &
4078 & .7568E+00,.7568E+00,.7568E+00,.7568E+00,.7568E+00,.7792E+00, &
4079 & .7907E+00,.7940E+00,.8002E+00,.8113E+00, &
4080 & .7412E+00,.7412E+00,.7412E+00,.7412E+00,.7412E+00,.7662E+00, &
4081 & .7783E+00,.7912E+00,.8007E+00,.8096E+00, &
4082 & .6857E+00,.6857E+00,.6857E+00,.6857E+00,.6857E+00,.7078E+00, &
4083 & .7249E+00,.7462E+00,.7600E+00,.7868E+00, &
4084 & .6639E+00,.6639E+00,.6639E+00,.6639E+00,.6639E+00,.6845E+00, &
4085 & .7070E+00,.7252E+00,.7393E+00,.7655E+00, &
4086 & .6515E+00,.6515E+00,.6515E+00,.6515E+00,.6515E+00,.6620E+00, &
4087 & .6810E+00,.6925E+00,.7165E+00,.7380E+00, &
4088 & .6220E+00,.6220E+00,.6220E+00,.6220E+00,.6220E+00,.6424E+00, &
4089 & .6525E+00,.6656E+00,.6848E+00,.7081E+00, &
4090 & .6129E+00,.6129E+00,.6129E+00,.6129E+00,.6129E+00,.6290E+00, &
4091 & .6397E+00,.6509E+00,.6676E+00,.6865E+00/
4093 !c *********************************************************
4094 !c Data statements for aerosol type 2 (continental) sw bnd 1
4095 !c *********************************************************
4096 data ((a_ssay(i,j,2),i=1,mby),j=1,nrh) / &
4097 & .9419E+00,.9419E+00,.9419E+00,.9419E+00,.9419E+00,.9634E+00, &
4098 & .9640E+00,.9652E+00,.9628E+00,.9566E+00, &
4099 & .9418E+00,.9418E+00,.9418E+00,.9418E+00,.9418E+00,.9633E+00, &
4100 & .9640E+00,.9652E+00,.9627E+00,.9565E+00, &
4101 & .9460E+00,.9460E+00,.9460E+00,.9460E+00,.9460E+00,.9650E+00, &
4102 & .9667E+00,.9673E+00,.9650E+00,.9595E+00, &
4103 & .9596E+00,.9596E+00,.9596E+00,.9596E+00,.9596E+00,.9744E+00, &
4104 & .9754E+00,.9760E+00,.9742E+00,.9703E+00, &
4105 & .9722E+00,.9722E+00,.9722E+00,.9722E+00,.9722E+00,.9827E+00, &
4106 & .9833E+00,.9838E+00,.9828E+00,.9805E+00, &
4107 & .9776E+00,.9776E+00,.9776E+00,.9776E+00,.9776E+00,.9861E+00, &
4108 & .9869E+00,.9872E+00,.9865E+00,.9846E+00, &
4109 & .9823E+00,.9823E+00,.9823E+00,.9823E+00,.9823E+00,.9892E+00, &
4110 & .9895E+00,.9900E+00,.9896E+00,.9883E+00, &
4111 & .9857E+00,.9857E+00,.9857E+00,.9857E+00,.9857E+00,.9912E+00, &
4112 & .9917E+00,.9921E+00,.9919E+00,.9907E+00/
4113 data ((a_exty(i,j,2),i=1,mby),j=1,nrh) / &
4114 & .1763E-04,.1763E-04,.1763E-04,.1763E-04,.1763E-04,.1574E-04, &
4115 & .1402E-04,.1248E-04,.1055E-04,.8482E-05, &
4116 & .1763E-04,.1763E-04,.1763E-04,.1763E-04,.1763E-04,.1574E-04, &
4117 & .1402E-04,.1249E-04,.1055E-04,.8483E-05, &
4118 & .1890E-04,.1890E-04,.1890E-04,.1890E-04,.1890E-04,.1689E-04, &
4119 & .1504E-04,.1339E-04,.1132E-04,.9110E-05, &
4120 & .2535E-04,.2535E-04,.2535E-04,.2535E-04,.2535E-04,.2270E-04, &
4121 & .2027E-04,.1811E-04,.1538E-04,.1244E-04, &
4122 & .3707E-04,.3707E-04,.3707E-04,.3707E-04,.3707E-04,.3347E-04, &
4123 & .3014E-04,.2714E-04,.2326E-04,.1903E-04, &
4124 & .4636E-04,.4636E-04,.4636E-04,.4636E-04,.4636E-04,.4215E-04, &
4125 & .3817E-04,.3459E-04,.2986E-04,.2465E-04, &
4126 & .5890E-04,.5890E-04,.5890E-04,.5890E-04,.5890E-04,.5402E-04, &
4127 & .4933E-04,.4501E-04,.3919E-04,.3269E-04, &
4128 & .7312E-04,.7312E-04,.7312E-04,.7312E-04,.7312E-04,.6769E-04, &
4129 & .6224E-04,.5721E-04,.5027E-04,.4240E-04/
4130 data ((a_asyy(i,j,2),i=1,mby),j=1,nrh) / &
4131 & .6740E+00,.6740E+00,.6740E+00,.6740E+00,.6740E+00,.6635E+00, &
4132 & .6570E+00,.6507E+00,.6414E+00,.6293E+00, &
4133 & .6740E+00,.6740E+00,.6740E+00,.6740E+00,.6740E+00,.6635E+00, &
4134 & .6570E+00,.6507E+00,.6414E+00,.6293E+00, &
4135 & .6809E+00,.6809E+00,.6809E+00,.6809E+00,.6809E+00,.6740E+00, &
4136 & .6678E+00,.6616E+00,.6523E+00,.6403E+00, &
4137 & .7167E+00,.7167E+00,.7167E+00,.7167E+00,.7167E+00,.7097E+00, &
4138 & .7046E+00,.6988E+00,.6904E+00,.6785E+00, &
4139 & .7447E+00,.7447E+00,.7447E+00,.7447E+00,.7447E+00,.7407E+00, &
4140 & .7371E+00,.7325E+00,.7251E+00,.7146E+00, &
4141 & .7561E+00,.7561E+00,.7561E+00,.7561E+00,.7561E+00,.7534E+00, &
4142 & .7508E+00,.7468E+00,.7404E+00,.7308E+00, &
4143 & .7656E+00,.7656E+00,.7656E+00,.7656E+00,.7656E+00,.7643E+00, &
4144 & .7622E+00,.7589E+00,.7536E+00,.7451E+00, &
4145 & .7723E+00,.7723E+00,.7723E+00,.7723E+00,.7723E+00,.7715E+00, &
4146 & .7706E+00,.7678E+00,.7635E+00,.7559E+00/
4148 !c ***************************************************
4149 !c Data statements for aerosol type 3 (urban) sw bnd 1
4150 !c ***************************************************
4151 data ((a_ssay(i,j,3),i=1,mby),j=1,nrh) / &
4152 & .9180E+00,.9180E+00,.9180E+00,.9180E+00,.9180E+00,.9394E+00, &
4153 & .9404E+00,.9417E+00,.9391E+00,.9333E+00, &
4154 & .9174E+00,.9174E+00,.9174E+00,.9174E+00,.9174E+00,.9388E+00, &
4155 & .9397E+00,.9411E+00,.9384E+00,.9327E+00, &
4156 & .9210E+00,.9210E+00,.9210E+00,.9210E+00,.9210E+00,.9400E+00, &
4157 & .9421E+00,.9428E+00,.9403E+00,.9353E+00, &
4158 & .9377E+00,.9377E+00,.9377E+00,.9377E+00,.9377E+00,.9527E+00, &
4159 & .9543E+00,.9551E+00,.9533E+00,.9500E+00, &
4160 & .9553E+00,.9553E+00,.9553E+00,.9553E+00,.9553E+00,.9663E+00, &
4161 & .9675E+00,.9685E+00,.9676E+00,.9659E+00, &
4162 & .9630E+00,.9630E+00,.9630E+00,.9630E+00,.9630E+00,.9722E+00, &
4163 & .9736E+00,.9743E+00,.9739E+00,.9728E+00, &
4164 & .9702E+00,.9702E+00,.9702E+00,.9702E+00,.9702E+00,.9776E+00, &
4165 & .9786E+00,.9795E+00,.9795E+00,.9788E+00, &
4166 & .9756E+00,.9756E+00,.9756E+00,.9756E+00,.9756E+00,.9816E+00, &
4167 & .9827E+00,.9836E+00,.9837E+00,.9832E+00/
4168 data ((a_exty(i,j,3),i=1,mby),j=1,nrh) / &
4169 & .1160E-04,.1160E-04,.1160E-04,.1160E-04,.1160E-04,.1033E-04, &
4170 & .9185E-05,.8166E-05,.6890E-05,.5530E-05, &
4171 & .1161E-04,.1161E-04,.1161E-04,.1161E-04,.1161E-04,.1034E-04, &
4172 & .9196E-05,.8175E-05,.6897E-05,.5536E-05, &
4173 & .1248E-04,.1248E-04,.1248E-04,.1248E-04,.1248E-04,.1112E-04, &
4174 & .9879E-05,.8785E-05,.7413E-05,.5952E-05, &
4175 & .1675E-04,.1675E-04,.1675E-04,.1675E-04,.1675E-04,.1494E-04, &
4176 & .1331E-04,.1187E-04,.1005E-04,.8106E-05, &
4177 & .2446E-04,.2446E-04,.2446E-04,.2446E-04,.2446E-04,.2199E-04, &
4178 & .1972E-04,.1772E-04,.1514E-04,.1235E-04, &
4179 & .3079E-04,.3079E-04,.3079E-04,.3079E-04,.3079E-04,.2783E-04, &
4180 & .2509E-04,.2265E-04,.1948E-04,.1601E-04, &
4181 & .3977E-04,.3977E-04,.3977E-04,.3977E-04,.3977E-04,.3616E-04, &
4182 & .3281E-04,.2978E-04,.2579E-04,.2139E-04, &
4183 & .4994E-04,.4994E-04,.4994E-04,.4994E-04,.4994E-04,.4577E-04, &
4184 & .4176E-04,.3815E-04,.3329E-04,.2788E-04/
4185 data ((a_asyy(i,j,3),i=1,mby),j=1,nrh) / &
4186 & .6710E+00,.6710E+00,.6710E+00,.6710E+00,.6710E+00,.6606E+00, &
4187 & .6543E+00,.6481E+00,.6390E+00,.6271E+00, &
4188 & .6711E+00,.6711E+00,.6711E+00,.6711E+00,.6711E+00,.6607E+00, &
4189 & .6543E+00,.6481E+00,.6389E+00,.6270E+00, &
4190 & .6811E+00,.6811E+00,.6811E+00,.6811E+00,.6811E+00,.6713E+00, &
4191 & .6652E+00,.6590E+00,.6498E+00,.6379E+00, &
4192 & .7143E+00,.7143E+00,.7143E+00,.7143E+00,.7143E+00,.7072E+00, &
4193 & .7020E+00,.6962E+00,.6878E+00,.6760E+00, &
4194 & .7425E+00,.7425E+00,.7425E+00,.7425E+00,.7425E+00,.7383E+00, &
4195 & .7346E+00,.7299E+00,.7225E+00,.7121E+00, &
4196 & .7541E+00,.7541E+00,.7541E+00,.7541E+00,.7541E+00,.7510E+00, &
4197 & .7482E+00,.7440E+00,.7375E+00,.7279E+00, &
4198 & .7637E+00,.7637E+00,.7637E+00,.7637E+00,.7637E+00,.7618E+00, &
4199 & .7593E+00,.7557E+00,.7501E+00,.7414E+00, &
4200 & .7707E+00,.7707E+00,.7707E+00,.7707E+00,.7707E+00,.7691E+00, &
4201 & .7677E+00,.7645E+00,.7598E+00,.7519E+00/
4203 !c ********************************************************
4204 !c Data statements for T&L 0.5 micron dust aerosol sw bnd 1
4205 !c ********************************************************
4206 data ((a_ssay(i,j,4),i=1,mby),j=1,nrh) / &
4207 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4208 & .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
4209 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4210 & .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
4211 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4212 & .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
4213 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4214 & .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
4215 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4216 & .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
4217 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4218 & .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
4219 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4220 & .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
4221 & .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
4222 & .8284E+00,.8779E+00,.9276E+00,.9653E+00/
4223 data ((a_exty(i,j,4),i=1,mby),j=1,nrh) / &
4224 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4225 & .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
4226 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4227 & .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
4228 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4229 & .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
4230 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4231 & .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
4232 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4233 & .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
4234 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4235 & .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
4236 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4237 & .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
4238 & .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
4239 & .9356E+00,.9674E+00,.1015E+01,.1067E+01/
4240 data ((a_asyy(i,j,4),i=1,mby),j=1,nrh) / &
4241 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4242 & .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
4243 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4244 & .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
4245 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4246 & .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
4247 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4248 & .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
4249 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4250 & .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
4251 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4252 & .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
4253 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4254 & .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
4255 & .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
4256 & .6963E+00,.6754E+00,.6626E+00,.6622E+00/
4257 !c ********************************************************
4258 !c Data statements for T&L 1.0 micron dust aerosol sw bnd 1
4259 !c ********************************************************
4260 data ((a_ssay(i,j,5),i=1,mby),j=1,nrh) / &
4261 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4262 & .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
4263 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4264 & .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
4265 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4266 & .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
4267 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4268 & .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
4269 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4270 & .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
4271 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4272 & .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
4273 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4274 & .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
4275 & .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
4276 & .7317E+00,.7920E+00,.8629E+00,.9255E+00/
4277 data ((a_exty(i,j,5),i=1,mby),j=1,nrh) / &
4278 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4279 & .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
4280 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4281 & .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
4282 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4283 & .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
4284 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4285 & .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
4286 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4287 & .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
4288 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4289 & .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
4290 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4291 & .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
4292 & .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
4293 & .9700E+00,.9848E+00,.1008E+01,.1040E+01/
4294 data ((a_asyy(i,j,5),i=1,mby),j=1,nrh) / &
4295 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4296 & .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
4297 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4298 & .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
4299 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4300 & .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
4301 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4302 & .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
4303 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4304 & .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
4305 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4306 & .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
4307 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4308 & .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
4309 & .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
4310 & .7970E+00,.7654E+00,.7285E+00,.6931E+00/
4311 !c ********************************************************
4312 !c Data statements for T&L 2.0 micron dust aerosol sw bnd 1
4313 !c ********************************************************
4314 data ((a_ssay(i,j,6),i=1,mby),j=1,nrh) / &
4315 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4316 & .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
4317 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4318 & .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
4319 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4320 & .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
4321 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4322 & .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
4323 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4324 & .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
4325 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4326 & .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
4327 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4328 & .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
4329 & .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
4330 & .6403E+00,.6988E+00,.7839E+00,.8715E+00/
4331 data ((a_exty(i,j,6),i=1,mby),j=1,nrh) / &
4332 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4333 & .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
4334 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4335 & .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
4336 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4337 & .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
4338 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4339 & .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
4340 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4341 & .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
4342 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4343 & .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
4344 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4345 & .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
4346 & .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
4347 & .9831E+00,.9916E+00,.1004E+01,.1019E+01/
4348 data ((a_asyy(i,j,6),i=1,mby),j=1,nrh) / &
4349 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4350 & .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
4351 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4352 & .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
4353 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4354 & .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
4355 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4356 & .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
4357 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4358 & .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
4359 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4360 & .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
4361 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4362 & .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
4363 & .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
4364 & .8745E+00,.8466E+00,.8097E+00,.7725E+00/
4365 !c ********************************************************
4366 !c Data statements for T&L 4.0 micron dust aerosol sw bnd 1
4367 !c ********************************************************
4368 data ((a_ssay(i,j,7),i=1,mby),j=1,nrh) / &
4369 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4370 & .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
4371 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4372 & .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
4373 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4374 & .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
4375 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4376 & .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
4377 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4378 & .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
4379 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4380 & .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
4381 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4382 & .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
4383 & .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
4384 & .5775E+00,.6141E+00,.6914E+00,.7949E+00/
4385 data ((a_exty(i,j,7),i=1,mby),j=1,nrh) / &
4386 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4387 & .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
4388 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4389 & .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
4390 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4391 & .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
4392 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4393 & .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
4394 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4395 & .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
4396 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4397 & .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
4398 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4399 & .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
4400 & .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
4401 & .9894E+00,.9948E+00,.1002E+01,.1012E+01/
4402 data ((a_asyy(i,j,7),i=1,mby),j=1,nrh) / &
4403 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4404 & .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
4405 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4406 & .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
4407 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4408 & .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
4409 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4410 & .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
4411 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4412 & .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
4413 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4414 & .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
4415 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4416 & .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
4417 & .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
4418 & .9204E+00,.9026E+00,.8702E+00,.8309E+00/
4419 !c ********************************************************
4420 !c Data statements for T&L 8.0 micron dust aerosol sw bnd 1
4421 !c ********************************************************
4422 data ((a_ssay(i,j,8),i=1,mby),j=1,nrh) / &
4423 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4424 & .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
4425 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4426 & .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
4427 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4428 & .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
4429 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4430 & .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
4431 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4432 & .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
4433 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4434 & .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
4435 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4436 & .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
4437 & .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
4438 & .5542E+00,.5663E+00,.6106E+00,.6996E+00/
4439 data ((a_exty(i,j,8),i=1,mby),j=1,nrh) / &
4440 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4441 & .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
4442 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4443 & .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
4444 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4445 & .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
4446 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4447 & .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
4448 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4449 & .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
4450 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4451 & .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
4452 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4453 & .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
4454 & .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
4455 & .9932E+00,.9967E+00,.1002E+01,.1007E+01/
4456 data ((a_asyy(i,j,8),i=1,mby),j=1,nrh) / &
4457 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4458 & .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
4459 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4460 & .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
4461 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4462 & .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
4463 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4464 & .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
4465 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4466 & .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
4467 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4468 & .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
4469 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4470 & .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
4471 & .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
4472 & .9385E+00,.9327E+00,.9136E+00,.8795E+00/
4474 !=====================================================================
4475 !OPAC Y
4476 !-----------------------------------------------------------
4477 !9) inso Insoluble
4478 data ((a_exty(i,j, 9 ),i=1,mby), j=1,1 ) / &
4479 & 0.9429E+00,0.9453E+00,0.9513E+00,0.9558E+00,0.9595E+00,0.9650E+00, &
4480 & 0.9753E+00,0.9866E+00,0.9992E+00,0.1015E+01/
4481 data ((a_ssay(i,j, 9 ),i=1,mby), j=1,1 ) / &
4482 & 0.4624E+00,0.5098E+00,0.6053E+00,0.6511E+00,0.6674E+00,0.6750E+00, &
4483 & 0.6918E+00,0.7100E+00,0.7289E+00,0.7486E+00/
4484 data ((a_asyy(i,j, 9 ),i=1,mby), j=1,1 ) / &
4485 & 0.9788E+00,0.9585E+00,0.9122E+00,0.8872E+00,0.8773E+00,0.8720E+00, &
4486 & 0.8597E+00,0.8458E+00,0.8317E+00,0.8163E+00/
4487 !-----------------------------------------------------------
4488 !10) waso Water Soluble (8 RH%)
4489 data ((a_exty(i,j,10 ),i=1,mby), j=1,8 ) / &
4490 & 0.2636E+01,0.2534E+01,0.2300E+01,0.2142E+01,0.2022E+01,0.1846E+01, &
4491 & 0.1535E+01,0.1261E+01,0.1015E+01,0.7892E+00, &
4492 & 0.2564E+01,0.2466E+01,0.2240E+01,0.2089E+01,0.1975E+01,0.1808E+01, &
4493 & 0.1513E+01,0.1253E+01,0.1015E+01,0.7959E+00, &
4494 & 0.2500E+01,0.2407E+01,0.2193E+01,0.2049E+01,0.1940E+01,0.1781E+01, &
4495 & 0.1498E+01,0.1246E+01,0.1014E+01,0.8001E+00, &
4496 & 0.2434E+01,0.2346E+01,0.2144E+01,0.2008E+01,0.1904E+01,0.1754E+01, &
4497 & 0.1482E+01,0.1240E+01,0.1014E+01,0.8042E+00, &
4498 & 0.2291E+01,0.2215E+01,0.2039E+01,0.1920E+01,0.1829E+01,0.1694E+01, &
4499 & 0.1448E+01,0.1225E+01,0.1013E+01,0.8130E+00, &
4500 & 0.2121E+01,0.2059E+01,0.1914E+01,0.1815E+01,0.1738E+01,0.1623E+01, &
4501 & 0.1407E+01,0.1208E+01,0.1012E+01,0.8240E+00, &
4502 & 0.1896E+01,0.1852E+01,0.1746E+01,0.1673E+01,0.1614E+01,0.1525E+01, &
4503 & 0.1350E+01,0.1182E+01,0.1011E+01,0.8404E+00, &
4504 & 0.1752E+01,0.1718E+01,0.1638E+01,0.1581E+01,0.1534E+01,0.1460E+01, &
4505 & 0.1311E+01,0.1165E+01,0.1010E+01,0.8518E+00/
4506 data ((a_ssay(i,j,10 ),i=1,mby), j=1,8 ) / &
4507 & 0.6646E+00,0.7653E+00,0.8981E+00,0.9419E+00,0.9569E+00,0.9666E+00, &
4508 & 0.9685E+00,0.9688E+00,0.9633E+00,0.9558E+00, &
4509 & 0.7687E+00,0.8417E+00,0.9345E+00,0.9639E+00,0.9735E+00,0.9796E+00, &
4510 & 0.9808E+00,0.9810E+00,0.9776E+00,0.9730E+00, &
4511 & 0.8036E+00,0.8665E+00,0.9456E+00,0.9704E+00,0.9784E+00,0.9835E+00, &
4512 & 0.9844E+00,0.9847E+00,0.9820E+00,0.9782E+00, &
4513 & 0.8288E+00,0.8845E+00,0.9538E+00,0.9751E+00,0.9819E+00,0.9861E+00, &
4514 & 0.9871E+00,0.9873E+00,0.9850E+00,0.9820E+00, &
4515 & 0.8696E+00,0.9126E+00,0.9655E+00,0.9816E+00,0.9868E+00,0.9900E+00, &
4516 & 0.9907E+00,0.9909E+00,0.9895E+00,0.9874E+00, &
4517 & 0.9009E+00,0.9345E+00,0.9749E+00,0.9869E+00,0.9906E+00,0.9929E+00, &
4518 & 0.9935E+00,0.9938E+00,0.9928E+00,0.9915E+00, &
4519 & 0.9319E+00,0.9553E+00,0.9831E+00,0.9913E+00,0.9939E+00,0.9954E+00, &
4520 & 0.9959E+00,0.9961E+00,0.9956E+00,0.9949E+00, &
4521 & 0.9465E+00,0.9651E+00,0.9870E+00,0.9934E+00,0.9954E+00,0.9966E+00, &
4522 & 0.9970E+00,0.9972E+00,0.9968E+00,0.9964E+00/
4523 data ((a_asyy(i,j,10 ),i=1,mby), j=1,8 ) / &
4524 & 0.7099E+00,0.6998E+00,0.6762E+00,0.6623E+00,0.6551E+00,0.6486E+00, &
4525 & 0.6386E+00,0.6267E+00,0.6143E+00,0.5985E+00, &
4526 & 0.7400E+00,0.7344E+00,0.7212E+00,0.7131E+00,0.7084E+00,0.7033E+00, &
4527 & 0.6946E+00,0.6841E+00,0.6722E+00,0.6570E+00, &
4528 & 0.7487E+00,0.7443E+00,0.7339E+00,0.7276E+00,0.7241E+00,0.7201E+00, &
4529 & 0.7118E+00,0.7021E+00,0.6904E+00,0.6755E+00, &
4530 & 0.7554E+00,0.7517E+00,0.7427E+00,0.7373E+00,0.7343E+00,0.7310E+00, &
4531 & 0.7239E+00,0.7151E+00,0.7042E+00,0.6902E+00, &
4532 & 0.7629E+00,0.7609E+00,0.7561E+00,0.7529E+00,0.7507E+00,0.7478E+00, &
4533 & 0.7426E+00,0.7349E+00,0.7254E+00,0.7123E+00, &
4534 & 0.7685E+00,0.7678E+00,0.7659E+00,0.7644E+00,0.7633E+00,0.7615E+00, &
4535 & 0.7576E+00,0.7512E+00,0.7433E+00,0.7320E+00, &
4536 & 0.7721E+00,0.7725E+00,0.7736E+00,0.7740E+00,0.7738E+00,0.7732E+00, &
4537 & 0.7715E+00,0.7669E+00,0.7612E+00,0.7518E+00, &
4538 & 0.7749E+00,0.7755E+00,0.7768E+00,0.7777E+00,0.7784E+00,0.7789E+00, &
4539 & 0.7779E+00,0.7750E+00,0.7701E+00,0.7619E+00/
4540 !-----------------------------------------------------------
4541 !11) soot Soot
4542 data ((a_exty(i,j,11 ),i=1,mby), j=1,1 ) / &
4543 & 0.2564E+01,0.2504E+01,0.2357E+01,0.2233E+01,0.2108E+01,0.1900E+01, &
4544 & 0.1552E+01,0.1267E+01,0.1017E+01,0.8078E+00/
4545 data ((a_ssay(i,j,11 ),i=1,mby), j=1,1 ) / &
4546 & 0.3009E+00,0.3045E+00,0.3124E+00,0.3138E+00,0.3091E+00,0.2954E+00, &
4547 & 0.2666E+00,0.2384E+00,0.2102E+00,0.1789E+00/
4548 data ((a_asyy(i,j,11 ),i=1,mby), j=1,1 ) / &
4549 & 0.5324E+00,0.5169E+00,0.4811E+00,0.4589E+00,0.4449E+00,0.4272E+00, &
4550 & 0.3957E+00,0.3664E+00,0.3375E+00,0.3079E+00/
4551 !-----------------------------------------------------------
4552 !12) ssam Sea Salt (Accumulation Mode) (8 RH%)
4553 data ((a_exty(i,j,12 ),i=1,mby), j=1,8 ) / &
4554 & 0.8629E+00,0.8715E+00,0.8930E+00,0.9073E+00,0.9173E+00,0.9311E+00, &
4555 & 0.9576E+00,0.9787E+00,0.9977E+00,0.1004E+01, &
4556 & 0.8793E+00,0.8838E+00,0.8954E+00,0.9047E+00,0.9137E+00,0.9279E+00, &
4557 & 0.9519E+00,0.9771E+00,0.9989E+00,0.1019E+01, &
4558 & 0.8777E+00,0.8831E+00,0.8965E+00,0.9062E+00,0.9141E+00,0.9262E+00, &
4559 & 0.9497E+00,0.9737E+00,0.9984E+00,0.1021E+01, &
4560 & 0.8839E+00,0.8886E+00,0.9002E+00,0.9086E+00,0.9155E+00,0.9268E+00, &
4561 & 0.9508E+00,0.9735E+00,0.9991E+00,0.1024E+01, &
4562 & 0.8990E+00,0.9021E+00,0.9098E+00,0.9160E+00,0.9219E+00,0.9322E+00, &
4563 & 0.9531E+00,0.9738E+00,0.9984E+00,0.1025E+01, &
4564 & 0.9067E+00,0.9113E+00,0.9224E+00,0.9293E+00,0.9335E+00,0.9397E+00, &
4565 & 0.9585E+00,0.9766E+00,0.9990E+00,0.1023E+01, &
4566 & 0.9296E+00,0.9329E+00,0.9409E+00,0.9461E+00,0.9497E+00,0.9550E+00, &
4567 & 0.9668E+00,0.9813E+00,0.9994E+00,0.1018E+01, &
4568 & 0.9437E+00,0.9462E+00,0.9524E+00,0.9566E+00,0.9596E+00,0.9641E+00, &
4569 & 0.9729E+00,0.9851E+00,0.9998E+00,0.1013E+01/
4570 data ((a_ssay(i,j,12 ),i=1,mby), j=1,8 ) / &
4571 & 0.9998E+00,0.9998E+00,0.9998E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
4572 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4573 & 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4574 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4575 & 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4576 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4577 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4578 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4579 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4580 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4581 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4582 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4583 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4584 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4585 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4586 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01/
4587 data ((a_asyy(i,j,12 ),i=1,mby), j=1,8 ) / &
4588 & 0.7300E+00,0.7254E+00,0.7146E+00,0.7078E+00,0.7037E+00,0.6998E+00, &
4589 & 0.6978E+00,0.6951E+00,0.6925E+00,0.6965E+00, &
4590 & 0.7850E+00,0.7850E+00,0.7846E+00,0.7830E+00,0.7798E+00,0.7750E+00, &
4591 & 0.7740E+00,0.7708E+00,0.7710E+00,0.7724E+00, &
4592 & 0.8029E+00,0.8004E+00,0.7945E+00,0.7909E+00,0.7889E+00,0.7866E+00, &
4593 & 0.7831E+00,0.7799E+00,0.7783E+00,0.7800E+00, &
4594 & 0.8050E+00,0.8040E+00,0.8015E+00,0.7996E+00,0.7980E+00,0.7950E+00, &
4595 & 0.7895E+00,0.7869E+00,0.7840E+00,0.7844E+00, &
4596 & 0.8178E+00,0.8169E+00,0.8146E+00,0.8127E+00,0.8108E+00,0.8072E+00, &
4597 & 0.8002E+00,0.7963E+00,0.7933E+00,0.7912E+00, &
4598 & 0.8304E+00,0.8287E+00,0.8246E+00,0.8224E+00,0.8216E+00,0.8198E+00, &
4599 & 0.8116E+00,0.8061E+00,0.8009E+00,0.7985E+00, &
4600 & 0.8380E+00,0.8380E+00,0.8378E+00,0.8367E+00,0.8345E+00,0.8309E+00, &
4601 & 0.8271E+00,0.8189E+00,0.8136E+00,0.8086E+00, &
4602 & 0.8448E+00,0.8449E+00,0.8450E+00,0.8444E+00,0.8431E+00,0.8406E+00, &
4603 & 0.8373E+00,0.8299E+00,0.8244E+00,0.8185E+00/
4604 !-----------------------------------------------------------
4605 !13) sscm Sea Salt (Coarse Mode) (8 RH%)
4606 data ((a_exty(i,j,13 ),i=1,mby), j=1,8 ) / &
4607 & 0.9630E+00,0.9648E+00,0.9695E+00,0.9730E+00,0.9758E+00,0.9790E+00, &
4608 & 0.9821E+00,0.9899E+00,0.9980E+00,0.1007E+01, &
4609 & 0.9727E+00,0.9743E+00,0.9783E+00,0.9809E+00,0.9829E+00,0.9856E+00, &
4610 & 0.9907E+00,0.9950E+00,0.9993E+00,0.1006E+01, &
4611 & 0.9761E+00,0.9773E+00,0.9805E+00,0.9827E+00,0.9844E+00,0.9866E+00, &
4612 & 0.9897E+00,0.9943E+00,0.9997E+00,0.1006E+01, &
4613 & 0.9762E+00,0.9780E+00,0.9824E+00,0.9849E+00,0.9862E+00,0.9877E+00, &
4614 & 0.9924E+00,0.9962E+00,0.1000E+01,0.1007E+01, &
4615 & 0.9811E+00,0.9821E+00,0.9844E+00,0.9861E+00,0.9874E+00,0.9893E+00, &
4616 & 0.9931E+00,0.9972E+00,0.1000E+01,0.1005E+01, &
4617 & 0.9831E+00,0.9837E+00,0.9852E+00,0.9861E+00,0.9868E+00,0.9880E+00, &
4618 & 0.9925E+00,0.9962E+00,0.9997E+00,0.1004E+01, &
4619 & 0.9858E+00,0.9865E+00,0.9882E+00,0.9894E+00,0.9904E+00,0.9918E+00, &
4620 & 0.9948E+00,0.9969E+00,0.9997E+00,0.1003E+01, &
4621 & 0.9901E+00,0.9891E+00,0.9872E+00,0.9870E+00,0.9887E+00,0.9911E+00, &
4622 & 0.9895E+00,0.9966E+00,0.9997E+00,0.1002E+01/
4623 data ((a_ssay(i,j,13 ),i=1,mby), j=1,8 ) / &
4624 & 0.9974E+00,0.9980E+00,0.9990E+00,0.9994E+00,0.9996E+00,0.9998E+00, &
4625 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4626 & 0.9995E+00,0.9995E+00,0.9995E+00,0.9997E+00,0.9999E+00,0.1000E+01, &
4627 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4628 & 0.9994E+00,0.9995E+00,0.9997E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
4629 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4630 & 0.9994E+00,0.9995E+00,0.9997E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
4631 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4632 & 0.9996E+00,0.9997E+00,0.9998E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
4633 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4634 & 0.9998E+00,0.9998E+00,0.9998E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
4635 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4636 & 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4637 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4638 & 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4639 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01/
4640 data ((a_asyy(i,j,13 ),i=1,mby), j=1,8 ) / &
4641 & 0.8085E+00,0.8092E+00,0.8108E+00,0.8106E+00,0.8085E+00,0.8049E+00, &
4642 & 0.8045E+00,0.8017E+00,0.7964E+00,0.7932E+00, &
4643 & 0.8452E+00,0.8456E+00,0.8467E+00,0.8476E+00,0.8486E+00,0.8498E+00, &
4644 & 0.8505E+00,0.8504E+00,0.8469E+00,0.8464E+00, &
4645 & 0.8483E+00,0.8481E+00,0.8480E+00,0.8486E+00,0.8500E+00,0.8530E+00, &
4646 & 0.8581E+00,0.8557E+00,0.8506E+00,0.8505E+00, &
4647 & 0.8373E+00,0.8422E+00,0.8535E+00,0.8586E+00,0.8582E+00,0.8542E+00, &
4648 & 0.8541E+00,0.8559E+00,0.8570E+00,0.8549E+00, &
4649 & 0.8441E+00,0.8465E+00,0.8523E+00,0.8548E+00,0.8546E+00,0.8539E+00, &
4650 & 0.8614E+00,0.8626E+00,0.8604E+00,0.8586E+00, &
4651 & 0.8390E+00,0.8405E+00,0.8443E+00,0.8471E+00,0.8495E+00,0.8536E+00, &
4652 & 0.8641E+00,0.8666E+00,0.8629E+00,0.8652E+00, &
4653 & 0.8385E+00,0.8383E+00,0.8382E+00,0.8405E+00,0.8455E+00,0.8545E+00, &
4654 & 0.8586E+00,0.8622E+00,0.8680E+00,0.8681E+00, &
4655 & 0.8070E+00,0.8121E+00,0.8244E+00,0.8326E+00,0.8384E+00,0.8465E+00, &
4656 & 0.8575E+00,0.8605E+00,0.8671E+00,0.8673E+00/
4657 !-----------------------------------------------------------
4658 !14) minm Mineral Dust (Nucleation Mode)
4659 data ((a_exty(i,j,14 ),i=1,mby), j=1,1 ) / &
4660 & 0.1013E+01,0.1007E+01,0.9897E+00,0.9760E+00,0.9624E+00,0.9367E+00, &
4661 & 0.8702E+00,0.7911E+00,0.6970E+00,0.5919E+00/
4662 data ((a_ssay(i,j,14 ),i=1,mby), j=1,1 ) / &
4663 & 0.7841E+00,0.7925E+00,0.8134E+00,0.8331E+00,0.8543E+00,0.8839E+00, &
4664 & 0.9211E+00,0.9491E+00,0.9647E+00,0.9740E+00/
4665 data ((a_asyy(i,j,14 ),i=1,mby), j=1,1 ) / &
4666 & 0.7398E+00,0.7359E+00,0.7260E+00,0.7185E+00,0.7118E+00,0.7018E+00, &
4667 & 0.6876E+00,0.6759E+00,0.6649E+00,0.6521E+00/
4668 !-----------------------------------------------------------
4669 !15) miam Mineral Dust (Accumulation Mode)
4670 data ((a_exty(i,j,15 ),i=1,mby), j=1,1 ) / &
4671 & 0.8958E+00,0.8998E+00,0.9097E+00,0.9170E+00,0.9230E+00,0.9325E+00, &
4672 & 0.9520E+00,0.9736E+00,0.9984E+00,0.1028E+01/
4673 data ((a_ssay(i,j,15 ),i=1,mby), j=1,1 ) / &
4674 & 0.5676E+00,0.5719E+00,0.5844E+00,0.6014E+00,0.6254E+00,0.6655E+00, &
4675 & 0.7403E+00,0.8148E+00,0.8711E+00,0.9093E+00/
4676 data ((a_asyy(i,j,15 ),i=1,mby), j=1,1 ) / &
4677 & 0.9144E+00,0.9086E+00,0.8938E+00,0.8802E+00,0.8654E+00,0.8411E+00, &
4678 & 0.8007E+00,0.7640E+00,0.7372E+00,0.7162E+00/
4679 !-----------------------------------------------------------
4680 !16) micm Mineral Dust (Coarse Mode)
4681 data ((a_exty(i,j,16 ),i=1,mby), j=1,1 ) / &
4682 & 0.9717E+00,0.9730E+00,0.9761E+00,0.9783E+00,0.9801E+00,0.9828E+00, &
4683 & 0.9880E+00,0.9935E+00,0.9996E+00,0.1007E+01/
4684 data ((a_ssay(i,j,16 ),i=1,mby), j=1,1 ) / &
4685 & 0.5462E+00,0.5457E+00,0.5448E+00,0.5454E+00,0.5477E+00,0.5523E+00, &
4686 & 0.5714E+00,0.6059E+00,0.6601E+00,0.7118E+00/
4687 data ((a_asyy(i,j,16 ),i=1,mby), j=1,1 ) / &
4688 & 0.9433E+00,0.9447E+00,0.9478E+00,0.9490E+00,0.9485E+00,0.9466E+00, &
4689 & 0.9380E+00,0.9212E+00,0.8973E+00,0.8741E+00/
4690 !-----------------------------------------------------------
4691 !17) mitr Mineral Dust (Transported Mode)
4692 data ((a_exty(i,j,17 ),i=1,mby), j=1,1 ) / &
4693 & 0.9243E+00,0.9273E+00,0.9348E+00,0.9403E+00,0.9447E+00,0.9516E+00, &
4694 & 0.9657E+00,0.9810E+00,0.9986E+00,0.1019E+01/
4695 data ((a_ssay(i,j,17 ),i=1,mby), j=1,1 ) / &
4696 & 0.5535E+00,0.5553E+00,0.5615E+00,0.5724E+00,0.5898E+00,0.6205E+00, &
4697 & 0.6873E+00,0.7635E+00,0.8289E+00,0.8763E+00/
4698 data ((a_asyy(i,j,17 ),i=1,mby), j=1,1 ) / &
4699 & 0.9371E+00,0.9340E+00,0.9257E+00,0.9168E+00,0.9057E+00,0.8860E+00, &
4700 & 0.8473E+00,0.8087E+00,0.7784E+00,0.7532E+00/
4701 !-----------------------------------------------------------
4702 !18) suso Sulfate Droplets (8 RH%)
4703 data ((a_exty(i,j,18 ),i=1,mby), j=1,8 ) / &
4704 & 0.1618E+01,0.1603E+01,0.1566E+01,0.1534E+01,0.1500E+01,0.1438E+01, &
4705 & 0.1299E+01,0.1155E+01,0.1009E+01,0.8521E+00, &
4706 & 0.1357E+01,0.1352E+01,0.1341E+01,0.1329E+01,0.1315E+01,0.1285E+01, &
4707 & 0.1207E+01,0.1115E+01,0.1006E+01,0.8812E+00, &
4708 & 0.1272E+01,0.1271E+01,0.1268E+01,0.1263E+01,0.1255E+01,0.1235E+01, &
4709 & 0.1175E+01,0.1100E+01,0.1006E+01,0.8928E+00, &
4710 & 0.1210E+01,0.1211E+01,0.1215E+01,0.1215E+01,0.1211E+01,0.1198E+01, &
4711 & 0.1152E+01,0.1089E+01,0.1005E+01,0.9023E+00, &
4712 & 0.1120E+01,0.1125E+01,0.1137E+01,0.1143E+01,0.1144E+01,0.1139E+01, &
4713 & 0.1112E+01,0.1069E+01,0.1004E+01,0.9180E+00, &
4714 & 0.1033E+01,0.1040E+01,0.1057E+01,0.1067E+01,0.1073E+01,0.1077E+01, &
4715 & 0.1070E+01,0.1047E+01,0.1002E+01,0.9381E+00, &
4716 & 0.9487E+00,0.9569E+00,0.9770E+00,0.9906E+00,0.1000E+01,0.1012E+01, &
4717 & 0.1022E+01,0.1020E+01,0.1001E+01,0.9637E+00, &
4718 & 0.9078E+00,0.9155E+00,0.9348E+00,0.9483E+00,0.9585E+00,0.9724E+00, &
4719 & 0.9917E+00,0.1002E+01,0.1000E+01,0.9817E+00/
4720 data ((a_ssay(i,j,18 ),i=1,mby), j=1,8 ) / &
4721 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4722 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4723 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4724 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4725 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4726 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4727 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4728 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4729 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4730 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4731 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4732 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4733 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4734 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4735 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
4736 & 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01/
4737 data ((a_asyy(i,j,18 ),i=1,mby), j=1,8 ) / &
4738 & 0.6955E+00,0.6978E+00,0.7034E+00,0.7076E+00,0.7112E+00,0.7165E+00, &
4739 & 0.7227E+00,0.7231E+00,0.7172E+00,0.7080E+00, &
4740 & 0.7408E+00,0.7444E+00,0.7532E+00,0.7586E+00,0.7617E+00,0.7650E+00, &
4741 & 0.7706E+00,0.7717E+00,0.7690E+00,0.7634E+00, &
4742 & 0.7498E+00,0.7529E+00,0.7606E+00,0.7656E+00,0.7690E+00,0.7729E+00, &
4743 & 0.7779E+00,0.7797E+00,0.7779E+00,0.7743E+00, &
4744 & 0.7559E+00,0.7590E+00,0.7664E+00,0.7709E+00,0.7734E+00,0.7762E+00, &
4745 & 0.7818E+00,0.7840E+00,0.7837E+00,0.7803E+00, &
4746 & 0.7601E+00,0.7631E+00,0.7703E+00,0.7748E+00,0.7776E+00,0.7810E+00, &
4747 & 0.7867E+00,0.7894E+00,0.7900E+00,0.7891E+00, &
4748 & 0.7657E+00,0.7684E+00,0.7749E+00,0.7789E+00,0.7814E+00,0.7842E+00, &
4749 & 0.7890E+00,0.7928E+00,0.7948E+00,0.7949E+00, &
4750 & 0.7749E+00,0.7765E+00,0.7802E+00,0.7825E+00,0.7836E+00,0.7853E+00, &
4751 & 0.7906E+00,0.7940E+00,0.7975E+00,0.7987E+00, &
4752 & 0.7795E+00,0.7808E+00,0.7838E+00,0.7856E+00,0.7865E+00,0.7876E+00, &
4753 & 0.7909E+00,0.7937E+00,0.7967E+00,0.7995E+00/
4754 !=====================================================================
4755 end module aerosol2
4758 !===========================================================
4759 ! block data opac_extinctions
4760 module opac_ext
4761 ! common /opac_ext/ wl(24) ,edat(24,8,9:18)
4762 implicit none
4763 integer, private :: i, j
4764 real :: wl(24) ,edat(24,8,9:18)
4765 data wl / &
4766 & 0.2500E+00,0.3000E+00,0.3500E+00,0.4000E+00,0.4500E+00,0.5000E+00, &
4767 & 0.5500E+00,0.6000E+00,0.6500E+00,0.7000E+00,0.7500E+00,0.8000E+00, &
4768 & 0.9000E+00,0.1000E+01,0.1250E+01,0.1500E+01,0.1750E+01,0.2000E+01, &
4769 & 0.2500E+01,0.3000E+01,0.3200E+01,0.3390E+01,0.3500E+01,0.3750E+01/
4770 !-----------------------------------------------------------
4771 !9) inso Insoluble
4772 data (( edat(i,j, 9),i=1,24), j=1,1 ) / &
4773 & 0.9477E+00,0.9572E+00,0.9667E+00,0.9748E+00,0.9839E+00,0.9916E+00, &
4774 & 0.1000E+01,0.1008E+01,0.1016E+01,0.1024E+01,0.1031E+01,0.1038E+01, &
4775 & 0.1052E+01,0.1064E+01,0.1093E+01,0.1105E+01,0.1088E+01,0.1012E+01, &
4776 & 0.7983E+00,0.6625E+00,0.7897E+00,0.8403E+00,0.8668E+00,0.8205E+00/
4777 !-----------------------------------------------------------
4778 !10) waso Water Soluble (8 RH%)
4779 data (( edat(i,j,10),i=1,24), j=1,8 ) / &
4780 & 0.2438E+01,0.2095E+01,0.1793E+01,0.1539E+01,0.1326E+01,0.1148E+01, &
4781 & 0.1000E+01,0.8739E+00,0.7689E+00,0.6782E+00,0.6032E+00,0.5249E+00, &
4782 & 0.4251E+00,0.3497E+00,0.2191E+00,0.1520E+00,0.9186E-01,0.4897E-01, &
4783 & 0.3146E-01,0.2746E-01,0.1577E-01,0.1314E-01,0.1167E-01,0.9260E-02, &
4784 & 0.2373E+01,0.2044E+01,0.1758E+01,0.1516E+01,0.1314E+01,0.1144E+01, &
4785 & 0.1000E+01,0.8785E+00,0.7759E+00,0.6882E+00,0.6135E+00,0.5395E+00, &
4786 & 0.4380E+00,0.3605E+00,0.2271E+00,0.1560E+00,0.9755E-01,0.5793E-01, &
4787 & 0.3256E-01,0.1309E+00,0.5573E-01,0.2602E-01,0.1914E-01,0.1332E-01, &
4788 & 0.2319E+01,0.2006E+01,0.1733E+01,0.1501E+01,0.1306E+01,0.1140E+01, &
4789 & 0.1000E+01,0.8812E+00,0.7803E+00,0.6942E+00,0.6199E+00,0.5477E+00, &
4790 & 0.4458E+00,0.3676E+00,0.2326E+00,0.1597E+00,0.1014E+00,0.6249E-01, &
4791 & 0.3361E-01,0.1628E+00,0.6956E-01,0.3125E-01,0.2246E-01,0.1529E-01, &
4792 & 0.2263E+01,0.1967E+01,0.1708E+01,0.1485E+01,0.1298E+01,0.1137E+01, &
4793 & 0.1000E+01,0.8840E+00,0.7847E+00,0.7002E+00,0.6264E+00,0.5557E+00, &
4794 & 0.4536E+00,0.3748E+00,0.2386E+00,0.1639E+00,0.1054E+00,0.6684E-01, &
4795 & 0.3483E-01,0.1857E+00,0.8036E-01,0.3571E-01,0.2545E-01,0.1714E-01, &
4796 & 0.2143E+01,0.1884E+01,0.1653E+01,0.1451E+01,0.1279E+01,0.1130E+01, &
4797 & 0.1000E+01,0.8897E+00,0.7942E+00,0.7128E+00,0.6405E+00,0.5724E+00, &
4798 & 0.4705E+00,0.3910E+00,0.2521E+00,0.1741E+00,0.1146E+00,0.7589E-01, &
4799 & 0.3791E-01,0.2186E+00,0.9814E-01,0.4402E-01,0.3134E-01,0.2095E-01, &
4800 & 0.2000E+01,0.1785E+01,0.1588E+01,0.1410E+01,0.1257E+01,0.1120E+01, &
4801 & 0.1000E+01,0.8968E+00,0.8062E+00,0.7286E+00,0.6585E+00,0.5932E+00, &
4802 & 0.4922E+00,0.4122E+00,0.2707E+00,0.1887E+00,0.1272E+00,0.8739E-01, &
4803 & 0.4252E-01,0.2441E+00,0.1154E+00,0.5345E-01,0.3848E-01,0.2582E-01, &
4804 & 0.1809E+01,0.1650E+01,0.1497E+01,0.1353E+01,0.1224E+01,0.1106E+01, &
4805 & 0.1000E+01,0.9072E+00,0.8240E+00,0.7520E+00,0.6856E+00,0.6241E+00, &
4806 & 0.5252E+00,0.4454E+00,0.3007E+00,0.2134E+00,0.1481E+00,0.1055E+00, &
4807 & 0.5081E-01,0.2683E+00,0.1372E+00,0.6728E-01,0.4955E-01,0.3371E-01, &
4808 & 0.1686E+01,0.1563E+01,0.1437E+01,0.1314E+01,0.1202E+01,0.1097E+01, &
4809 & 0.1000E+01,0.9142E+00,0.8366E+00,0.7687E+00,0.7051E+00,0.6462E+00, &
4810 & 0.5496E+00,0.4702E+00,0.3238E+00,0.2331E+00,0.1648E+00,0.1196E+00, &
4811 & 0.5785E-01,0.2815E+00,0.1521E+00,0.7776E-01,0.5825E-01,0.4012E-01/
4812 !-----------------------------------------------------------
4813 !11) soot Soot
4814 data (( edat(i,j,11),i=1,24), j=1,1 ) / &
4815 & 0.2447E+01,0.2188E+01,0.1837E+01,0.1555E+01,0.1331E+01,0.1153E+01, &
4816 & 0.1000E+01,0.8818E+00,0.7906E+00,0.7082E+00,0.6445E+00,0.5904E+00, &
4817 & 0.5087E+00,0.4453E+00,0.3412E+00,0.2767E+00,0.2367E+00,0.2055E+00, &
4818 & 0.1639E+00,0.1398E+00,0.1284E+00,0.1218E+00,0.1189E+00,0.1105E+00/
4819 !-----------------------------------------------------------
4820 !12) ssam Sea Salt (Accumulation Mode) (8 RH%)
4821 data (( edat(i,j,12),i=1,24), j=1,8 ) / &
4822 & 0.8801E+00,0.9114E+00,0.9354E+00,0.9580E+00,0.9733E+00,0.9887E+00, &
4823 & 0.1000E+01,0.1002E+01,0.1005E+01,0.1003E+01,0.9963E+00,0.9846E+00, &
4824 & 0.9618E+00,0.9232E+00,0.8315E+00,0.7230E+00,0.6190E+00,0.5382E+00, &
4825 & 0.3864E+00,0.4589E+00,0.3172E+00,0.2808E+00,0.2656E+00,0.2284E+00, &
4826 & 0.8883E+00,0.9080E+00,0.9321E+00,0.9508E+00,0.9715E+00,0.9866E+00, &
4827 & 0.1000E+01,0.1013E+01,0.1021E+01,0.1026E+01,0.1030E+01,0.1030E+01, &
4828 & 0.1023E+01,0.1009E+01,0.9498E+00,0.8710E+00,0.7792E+00,0.6931E+00, &
4829 & 0.4881E+00,0.6444E+00,0.6217E+00,0.5226E+00,0.4772E+00,0.4012E+00, &
4830 & 0.8884E+00,0.9093E+00,0.9300E+00,0.9493E+00,0.9672E+00,0.9853E+00, &
4831 & 0.1000E+01,0.1012E+01,0.1023E+01,0.1031E+01,0.1036E+01,0.1040E+01, &
4832 & 0.1041E+01,0.1032E+01,0.9874E+00,0.9212E+00,0.8368E+00,0.7534E+00, &
4833 & 0.5404E+00,0.6945E+00,0.6969E+00,0.5975E+00,0.5486E+00,0.4654E+00, &
4834 & 0.8932E+00,0.9113E+00,0.9305E+00,0.9508E+00,0.9671E+00,0.9850E+00, &
4835 & 0.1000E+01,0.1016E+01,0.1025E+01,0.1035E+01,0.1044E+01,0.1050E+01, &
4836 & 0.1054E+01,0.1052E+01,0.1020E+01,0.9637E+00,0.8874E+00,0.8075E+00, &
4837 & 0.5909E+00,0.7366E+00,0.7591E+00,0.6629E+00,0.6126E+00,0.5246E+00, &
4838 & 0.9051E+00,0.9182E+00,0.9355E+00,0.9528E+00,0.9682E+00,0.9843E+00, &
4839 & 0.1000E+01,0.1014E+01,0.1028E+01,0.1040E+01,0.1050E+01,0.1059E+01, &
4840 & 0.1072E+01,0.1077E+01,0.1070E+01,0.1036E+01,0.9774E+00,0.9089E+00, &
4841 & 0.6961E+00,0.8117E+00,0.8691E+00,0.7870E+00,0.7377E+00,0.6452E+00, &
4842 & 0.9158E+00,0.9311E+00,0.9419E+00,0.9586E+00,0.9717E+00,0.9857E+00, &
4843 & 0.1000E+01,0.1015E+01,0.1025E+01,0.1037E+01,0.1052E+01,0.1062E+01, &
4844 & 0.1080E+01,0.1094E+01,0.1109E+01,0.1098E+01,0.1064E+01,0.1013E+01, &
4845 & 0.8218E+00,0.8883E+00,0.9782E+00,0.9207E+00,0.8777E+00,0.7878E+00, &
4846 & 0.9361E+00,0.9476E+00,0.9567E+00,0.9668E+00,0.9761E+00,0.9905E+00, &
4847 & 0.1000E+01,0.1010E+01,0.1019E+01,0.1030E+01,0.1041E+01,0.1051E+01, &
4848 & 0.1075E+01,0.1090E+01,0.1126E+01,0.1144E+01,0.1141E+01,0.1122E+01, &
4849 & 0.9894E+00,0.9762E+00,0.1094E+01,0.1079E+01,0.1052E+01,0.9811E+00, &
4850 & 0.9487E+00,0.9578E+00,0.9655E+00,0.9729E+00,0.9804E+00,0.9933E+00, &
4851 & 0.1000E+01,0.1008E+01,0.1014E+01,0.1023E+01,0.1033E+01,0.1042E+01, &
4852 & 0.1064E+01,0.1079E+01,0.1119E+01,0.1148E+01,0.1164E+01,0.1166E+01, &
4853 & 0.1091E+01,0.1025E+01,0.1148E+01,0.1162E+01,0.1150E+01,0.1102E+01/
4854 !-----------------------------------------------------------
4855 !13) sscm Sea Salt (Coarse Mode) (8 RH%)
4856 data (( edat(i,j,13),i=1,24), j=1,8 ) / &
4857 & 0.9667E+00,0.9741E+00,0.9797E+00,0.9810E+00,0.9885E+00,0.9930E+00, &
4858 & 0.1000E+01,0.9993E+00,0.1010E+01,0.1015E+01,0.1013E+01,0.1015E+01, &
4859 & 0.1029E+01,0.1039E+01,0.1062E+01,0.1075E+01,0.1107E+01,0.1123E+01, &
4860 & 0.1170E+01,0.1175E+01,0.1208E+01,0.1222E+01,0.1228E+01,0.1241E+01, &
4861 & 0.9759E+00,0.9817E+00,0.9864E+00,0.9907E+00,0.9941E+00,0.9969E+00, &
4862 & 0.1000E+01,0.1001E+01,0.1008E+01,0.1011E+01,0.1014E+01,0.1016E+01, &
4863 & 0.1023E+01,0.1027E+01,0.1041E+01,0.1060E+01,0.1073E+01,0.1093E+01, &
4864 & 0.1134E+01,0.1094E+01,0.1129E+01,0.1156E+01,0.1167E+01,0.1188E+01, &
4865 & 0.9786E+00,0.9834E+00,0.9872E+00,0.9894E+00,0.9929E+00,0.9969E+00, &
4866 & 0.1000E+01,0.1003E+01,0.1006E+01,0.1010E+01,0.1013E+01,0.1014E+01, &
4867 & 0.1019E+01,0.1028E+01,0.1040E+01,0.1051E+01,0.1070E+01,0.1082E+01, &
4868 & 0.1121E+01,0.1083E+01,0.1116E+01,0.1140E+01,0.1151E+01,0.1172E+01, &
4869 & 0.9798E+00,0.9855E+00,0.9882E+00,0.9925E+00,0.9953E+00,0.9978E+00, &
4870 & 0.1000E+01,0.1005E+01,0.1007E+01,0.1010E+01,0.1015E+01,0.1014E+01, &
4871 & 0.1021E+01,0.1023E+01,0.1040E+01,0.1051E+01,0.1064E+01,0.1078E+01, &
4872 & 0.1113E+01,0.1079E+01,0.1109E+01,0.1130E+01,0.1141E+01,0.1159E+01, &
4873 & 0.9830E+00,0.9866E+00,0.9899E+00,0.9929E+00,0.9965E+00,0.9983E+00, &
4874 & 0.1000E+01,0.1003E+01,0.1006E+01,0.1009E+01,0.1012E+01,0.1014E+01, &
4875 & 0.1018E+01,0.1024E+01,0.1035E+01,0.1042E+01,0.1054E+01,0.1065E+01, &
4876 & 0.1097E+01,0.1069E+01,0.1095E+01,0.1111E+01,0.1120E+01,0.1136E+01, &
4877 & 0.9843E+00,0.9864E+00,0.9885E+00,0.9925E+00,0.9954E+00,0.9977E+00, &
4878 & 0.1000E+01,0.1002E+01,0.1005E+01,0.1006E+01,0.1010E+01,0.1010E+01, &
4879 & 0.1015E+01,0.1016E+01,0.1029E+01,0.1038E+01,0.1044E+01,0.1056E+01, &
4880 & 0.1078E+01,0.1060E+01,0.1080E+01,0.1093E+01,0.1100E+01,0.1112E+01, &
4881 & 0.9872E+00,0.9898E+00,0.9923E+00,0.9948E+00,0.9966E+00,0.9977E+00, &
4882 & 0.1000E+01,0.1002E+01,0.1004E+01,0.1002E+01,0.1007E+01,0.1009E+01, &
4883 & 0.1013E+01,0.1016E+01,0.1025E+01,0.1032E+01,0.1040E+01,0.1046E+01, &
4884 & 0.1060E+01,0.1052E+01,0.1066E+01,0.1075E+01,0.1079E+01,0.1087E+01, &
4885 & 0.9882E+00,0.9875E+00,0.9913E+00,0.9877E+00,0.9953E+00,0.9983E+00, &
4886 & 0.1000E+01,0.1001E+01,0.1003E+01,0.1004E+01,0.1006E+01,0.1007E+01, &
4887 & 0.1010E+01,0.1013E+01,0.1020E+01,0.1026E+01,0.1032E+01,0.1038E+01, &
4888 & 0.1049E+01,0.1044E+01,0.1056E+01,0.1063E+01,0.1066E+01,0.1071E+01/
4889 !-----------------------------------------------------------
4890 !14) minm Mineral Dust (Nucleation Mode)
4891 data (( edat(i,j,14),i=1,24), j=1,1 ) / &
4892 & 0.1000E+01,0.9711E+00,0.9279E+00,0.8725E+00,0.8129E+00,0.7512E+00, &
4893 & 0.6916E+00,0.6347E+00,0.5817E+00,0.5327E+00,0.4879E+00,0.4470E+00, &
4894 & 0.3760E+00,0.3175E+00,0.2129E+00,0.1474E+00,0.1051E+00,0.7735E-01, &
4895 & 0.4556E-01,0.3771E-01,0.2699E-01,0.2199E-01,0.1993E-01,0.1462E-01/
4896 !-----------------------------------------------------------
4897 !15) miam Mineral Dust (Accumulation Mode)
4898 data (( edat(i,j,15),i=1,24), j=1,1 ) / &
4899 & 0.9037E+00,0.9193E+00,0.9354E+00,0.9513E+00,0.9682E+00,0.9837E+00, &
4900 & 0.1000E+01,0.1015E+01,0.1031E+01,0.1045E+01,0.1056E+01,0.1069E+01, &
4901 & 0.1088E+01,0.1103E+01,0.1117E+01,0.1105E+01,0.1074E+01,0.1030E+01, &
4902 & 0.9115E+00,0.7974E+00,0.7466E+00,0.7089E+00,0.6875E+00,0.6277E+00/
4903 !-----------------------------------------------------------
4904 !16) micm Mineral Dust (Coarse Mode)
4905 data (( edat(i,j,16),i=1,24), j=1,1 ) / &
4906 & 0.9742E+00,0.9790E+00,0.9836E+00,0.9878E+00,0.9922E+00,0.9959E+00, &
4907 & 0.1000E+01,0.1004E+01,0.1008E+01,0.1012E+01,0.1014E+01,0.1018E+01, &
4908 & 0.1026E+01,0.1032E+01,0.1048E+01,0.1065E+01,0.1082E+01,0.1096E+01, &
4909 & 0.1128E+01,0.1151E+01,0.1167E+01,0.1178E+01,0.1184E+01,0.1199E+01/
4910 !-----------------------------------------------------------
4911 !17) mitr Mineral Dust (Transported Mode)
4912 data (( edat(i,j,17),i=1,24), j=1,1 ) / &
4913 & 0.9303E+00,0.9420E+00,0.9537E+00,0.9652E+00,0.9773E+00,0.9879E+00, &
4914 & 0.1000E+01,0.1010E+01,0.1021E+01,0.1032E+01,0.1042E+01,0.1052E+01, &
4915 & 0.1073E+01,0.1089E+01,0.1124E+01,0.1145E+01,0.1158E+01,0.1155E+01, &
4916 & 0.1123E+01,0.1056E+01,0.1031E+01,0.1010E+01,0.9970E+00,0.9592E+00/
4917 !-----------------------------------------------------------
4918 !18) suso Sulfate Droplets (8 RH%)
4919 data (( edat(i,j,18),i=1,24), j=1,8 ) / &
4920 & 0.1589E+01,0.1522E+01,0.1418E+01,0.1303E+01,0.1190E+01,0.1092E+01, &
4921 & 0.1000E+01,0.9143E+00,0.8376E+00,0.7654E+00,0.6996E+00,0.6399E+00, &
4922 & 0.5385E+00,0.4523E+00,0.2965E+00,0.1989E+00,0.1377E+00,0.9764E-01, &
4923 & 0.4830E-01,0.9007E-01,0.1102E+00,0.1189E+00,0.1158E+00,0.9204E-01, &
4924 & 0.1348E+01,0.1324E+01,0.1275E+01,0.1210E+01,0.1140E+01,0.1070E+01, &
4925 & 0.1000E+01,0.9327E+00,0.8690E+00,0.8095E+00,0.7523E+00,0.6989E+00, &
4926 & 0.6053E+00,0.5239E+00,0.3671E+00,0.2634E+00,0.1894E+00,0.1396E+00, &
4927 & 0.6786E-01,0.2235E+00,0.1501E+00,0.1073E+00,0.9444E-01,0.7255E-01, &
4928 & 0.1270E+01,0.1260E+01,0.1228E+01,0.1178E+01,0.1121E+01,0.1062E+01, &
4929 & 0.1000E+01,0.9397E+00,0.8817E+00,0.8269E+00,0.7733E+00,0.7227E+00, &
4930 & 0.6326E+00,0.5533E+00,0.3966E+00,0.2903E+00,0.2118E+00,0.1581E+00, &
4931 & 0.7746E-01,0.2542E+00,0.1694E+00,0.1142E+00,0.9794E-01,0.7432E-01, &
4932 & 0.1213E+01,0.1214E+01,0.1193E+01,0.1154E+01,0.1107E+01,0.1055E+01, &
4933 & 0.1000E+01,0.9457E+00,0.8920E+00,0.8410E+00,0.7904E+00,0.7420E+00, &
4934 & 0.6550E+00,0.5774E+00,0.4212E+00,0.3129E+00,0.2309E+00,0.1740E+00, &
4935 & 0.8606E-01,0.2758E+00,0.1859E+00,0.1223E+00,0.1035E+00,0.7800E-01, &
4936 & 0.1130E+01,0.1144E+01,0.1137E+01,0.1114E+01,0.1082E+01,0.1044E+01, &
4937 & 0.1000E+01,0.9549E+00,0.9094E+00,0.8652E+00,0.8201E+00,0.7764E+00, &
4938 & 0.6957E+00,0.6218E+00,0.4674E+00,0.3562E+00,0.2682E+00,0.2055E+00, &
4939 & 0.1039E+00,0.3110E+00,0.2181E+00,0.1419E+00,0.1185E+00,0.8881E-01, &
4940 & 0.1047E+01,0.1070E+01,0.1078E+01,0.1072E+01,0.1055E+01,0.1030E+01, &
4941 & 0.1000E+01,0.9671E+00,0.9313E+00,0.8955E+00,0.8577E+00,0.8197E+00, &
4942 & 0.7476E+00,0.6795E+00,0.5295E+00,0.4157E+00,0.3210E+00,0.2510E+00, &
4943 & 0.1311E+00,0.3533E+00,0.2636E+00,0.1744E+00,0.1455E+00,0.1094E+00, &
4944 & 0.9649E+00,0.9946E+00,0.1015E+01,0.1023E+01,0.1023E+01,0.1014E+01, &
4945 & 0.1000E+01,0.9820E+00,0.9595E+00,0.9353E+00,0.9080E+00,0.8792E+00, &
4946 & 0.8213E+00,0.7633E+00,0.6247E+00,0.5105E+00,0.4084E+00,0.3287E+00, &
4947 & 0.1810E+00,0.4156E+00,0.3391E+00,0.2356E+00,0.1991E+00,0.1520E+00, &
4948 & 0.9232E+00,0.9524E+00,0.9764E+00,0.9920E+00,0.1001E+01,0.1004E+01, &
4949 & 0.1000E+01,0.9924E+00,0.9792E+00,0.9644E+00,0.9463E+00,0.9258E+00, &
4950 & 0.8810E+00,0.8331E+00,0.7091E+00,0.5986E+00,0.4932E+00,0.4068E+00, &
4951 & 0.2352E+00,0.4729E+00,0.4135E+00,0.3016E+00,0.2589E+00,0.2015E+00/
4952 end module opac_ext
4954 !=============================================================
4955 ! block data tegen_lacis_ext
4956 module mineral_ext
4957 implicit none
4958 ! common /mineral_ext/ wl(24) ,dat(24,4:8)
4959 real :: wl(24) ,dat(24,4:8)
4961 data wl / &
4962 & 0.30, 0.35, 0.40, 0.45, 0.50, 0.55, &
4963 & 0.60, 0.65, 0.70, 0.80, 1.00, 1.25, &
4964 & 1.50, 2.00, 2.51, 2.61, 2.83, 2.96, &
4965 & 3.04, 3.26, 3.47, 3.69, 3.90, 4.11/
4967 data dat/ &
4968 ! 4
4969 & 8.78E-01,9.06E-01,9.36E-01,9.67E-01,1.00E+00,1.03E+00, &
4970 & 1.06E+00,1.08E+00,1.09E+00,1.09E+00,1.02E+00,8.70E-01, &
4971 & 7.04E-01,4.36E-01,2.08E-01,1.95E-01,1.91E-01,1.73E-01, &
4972 & 1.51E-01,1.35E-01,9.41E-02,7.95E-02,6.45E-02,5.36E-02, &
4973 ! 5
4974 & 9.41E-01,9.56E-01,9.70E-01,9.85E-01,1.00E+00,1.02E+00, &
4975 & 1.03E+00,1.05E+00,1.07E+00,1.10E+00,1.18E+00,1.25E+00, &
4976 & 1.27E+00,1.19E+00,8.64E-01,8.36E-01,7.68E-01,7.25E-01, &
4977 & 6.93E-01,6.92E-01,5.44E-01,4.96E-01,4.41E-01,3.93E-01, &
4978 ! 6
4979 & 9.65E-01,9.75E-01,9.83E-01,9.92E-01,1.00E+00,1.01E+00, &
4980 & 1.02E+00,1.02E+00,1.03E+00,1.05E+00,1.08E+00,1.12E+00, &
4981 & 1.17E+00,1.27E+00,1.34E+00,1.34E+00,1.29E+00,1.29E+00, &
4982 & 1.30E+00,1.33E+00,1.27E+00,1.24E+00,1.21E+00,1.17E+00, &
4983 ! 7
4984 & 9.78E-01,9.84E-01,9.89E-01,9.95E-01,1.00E+00,1.00E+00, &
4985 & 1.01E+00,1.01E+00,1.02E+00,1.03E+00,1.05E+00,1.07E+00, &
4986 & 1.09E+00,1.13E+00,1.19E+00,1.20E+00,1.21E+00,1.22E+00, &
4987 & 1.24E+00,1.25E+00,1.29E+00,1.31E+00,1.34E+00,1.36E+00, &
4988 ! 8
4989 & 9.86E-01,9.90E-01,9.93E-01,9.97E-01,1.00E+00,1.00E+00, &
4990 & 1.01E+00,1.01E+00,1.01E+00,1.02E+00,1.03E+00,1.04E+00, &
4991 & 1.05E+00,1.08E+00,1.10E+00,1.11E+00,1.11E+00,1.12E+00, &
4992 & 1.12E+00,1.13E+00,1.14E+00,1.15E+00,1.17E+00,1.18E+00 /
4994 end module mineral_ext
4995 !=============================================================
4996 ! block data dalmedia_ext
4997 module dalm_ext
4998 implicit none
4999 ! common /dalm_ext/ wl(24) ,dat(24,8,3)
5000 real :: wl(24) ,dat(24,8,3)
5001 data wl / &
5002 & 0.30, 0.35, 0.40, 0.45, 0.50, 0.55, &
5003 & 0.60, 0.65, 0.70, 0.75, 0.80, 0.90, &
5004 & 1.00, 1.25, 1.50, 1.75, 2.00, 2.50, &
5005 & 3.00, 3.20, 3.39, 3.50, 3.78, 4.00/
5006 data dat/ &
5007 ! 1
5008 & 2.07E-04,2.08E-04,2.08E-04,2.07E-04,2.07E-04,2.08E-04, &
5009 & 2.09E-04,2.11E-04,2.12E-04,2.12E-04,2.12E-04,2.09E-04, &
5010 & 2.04E-04,1.90E-04,1.79E-04,1.71E-04,1.67E-04,1.63E-04, &
5011 & 1.72E-04,1.69E-04,1.62E-04,1.66E-04,1.67E-04,1.67E-04, &
5012 & 2.45E-04,2.46E-04,2.45E-04,2.44E-04,2.43E-04,2.43E-04, &
5013 & 2.44E-04,2.45E-04,2.46E-04,2.44E-04,2.43E-04,2.38E-04, &
5014 & 2.31E-04,2.14E-04,2.01E-04,1.91E-04,1.85E-04,1.79E-04, &
5015 & 1.90E-04,1.87E-04,1.83E-04,1.83E-04,1.84E-04,1.84E-04, &
5016 & 3.52E-04,3.50E-04,3.50E-04,3.51E-04,3.50E-04,3.47E-04, &
5017 & 3.47E-04,3.47E-04,3.49E-04,3.50E-04,3.51E-04,3.51E-04, &
5018 & 3.48E-04,3.28E-04,3.10E-04,2.92E-04,2.80E-04,2.63E-04, &
5019 & 2.85E-04,2.82E-04,2.71E-04,2.68E-04,2.65E-04,2.65E-04, &
5020 & 7.98E-04,7.93E-04,7.87E-04,7.86E-04,7.82E-04,7.80E-04, &
5021 & 7.83E-04,7.86E-04,7.86E-04,7.84E-04,7.82E-04,7.83E-04, &
5022 & 7.90E-04,8.10E-04,8.05E-04,7.79E-04,7.47E-04,6.70E-04, &
5023 & 7.23E-04,7.47E-04,7.11E-04,6.94E-04,6.68E-04,6.55E-04, &
5024 & 1.14E-03,1.12E-03,1.12E-03,1.11E-03,1.11E-03,1.11E-03, &
5025 & 1.11E-03,1.11E-03,1.11E-03,1.11E-03,1.11E-03,1.11E-03, &
5026 & 1.11E-03,1.13E-03,1.15E-03,1.14E-03,1.11E-03,9.98E-04, &
5027 & 1.05E-03,1.10E-03,1.06E-03,1.04E-03,9.94E-04,9.67E-04, &
5028 & 1.69E-03,1.67E-03,1.66E-03,1.64E-03,1.64E-03,1.63E-03, &
5029 & 1.63E-03,1.62E-03,1.62E-03,1.61E-03,1.62E-03,1.63E-03, &
5030 & 1.63E-03,1.62E-03,1.65E-03,1.68E-03,1.67E-03,1.54E-03, &
5031 & 1.56E-03,1.65E-03,1.64E-03,1.61E-03,1.53E-03,1.49E-03, &
5032 & 2.88E-03,2.87E-03,2.86E-03,2.83E-03,2.82E-03,2.80E-03, &
5033 & 2.78E-03,2.76E-03,2.74E-03,2.76E-03,2.75E-03,2.74E-03, &
5034 & 2.74E-03,2.76E-03,2.75E-03,2.78E-03,2.83E-03,2.79E-03, &
5035 & 2.69E-03,2.83E-03,2.89E-03,2.88E-03,2.81E-03,2.73E-03, &
5036 & 4.24E-03,4.27E-03,4.26E-03,4.26E-03,4.24E-03,4.21E-03, &
5037 & 4.18E-03,4.16E-03,4.14E-03,4.13E-03,4.11E-03,4.09E-03, &
5038 & 4.09E-03,4.06E-03,4.09E-03,4.08E-03,4.10E-03,4.22E-03, &
5039 & 4.02E-03,4.16E-03,4.26E-03,4.30E-03,4.31E-03,4.25E-03, &
5040 ! 2
5041 & 1.76E-05,1.57E-05,1.40E-05,1.25E-05,1.11E-05,9.95E-06, &
5042 & 8.91E-06,8.01E-06,7.21E-06,6.53E-06,5.78E-06,4.79E-06, &
5043 & 4.05E-06,2.66E-06,1.46E-06,1.02E-06,1.33E-06,4.35E-07, &
5044 & 3.49E-07,2.36E-07,2.02E-07,1.90E-07,1.54E-07,1.39E-07, &
5045 & 1.76E-05,1.57E-05,1.40E-05,1.25E-05,1.11E-05,9.95E-06, &
5046 & 8.91E-06,8.01E-06,7.21E-06,6.53E-06,5.79E-06,4.80E-06, &
5047 & 4.05E-06,2.66E-06,1.46E-06,1.02E-06,1.33E-06,4.37E-07, &
5048 & 3.50E-07,2.38E-07,2.03E-07,1.91E-07,1.55E-07,1.40E-07, &
5049 & 1.89E-05,1.69E-05,1.50E-05,1.34E-05,1.19E-05,1.07E-05, &
5050 & 9.57E-06,8.61E-06,7.75E-06,7.02E-06,6.23E-06,5.17E-06, &
5051 & 4.36E-06,2.87E-06,1.59E-06,1.12E-06,1.40E-06,4.73E-07, &
5052 & 5.67E-07,3.34E-07,2.44E-07,2.23E-07,1.77E-07,1.59E-07, &
5053 & 2.54E-05,2.27E-05,2.03E-05,1.81E-05,1.62E-05,1.45E-05, &
5054 & 1.31E-05,1.18E-05,1.06E-05,9.64E-06,8.61E-06,7.17E-06, &
5055 & 6.06E-06,4.01E-06,2.35E-06,1.65E-06,1.81E-06,6.73E-07, &
5056 & 1.72E-06,8.68E-07,4.78E-07,4.04E-07,3.02E-07,2.66E-07, &
5057 & 3.71E-05,3.35E-05,3.01E-05,2.71E-05,2.44E-05,2.20E-05, &
5058 & 1.99E-05,1.80E-05,1.64E-05,1.49E-05,1.35E-05,1.13E-05, &
5059 & 9.58E-06,6.42E-06,4.02E-06,2.84E-06,2.68E-06,1.11E-06, &
5060 & 4.01E-06,2.02E-06,1.01E-06,8.25E-07,5.90E-07,5.07E-07, &
5061 & 4.64E-05,4.22E-05,3.82E-05,3.46E-05,3.13E-05,2.83E-05, &
5062 & 2.57E-05,2.34E-05,2.14E-05,1.95E-05,1.77E-05,1.49E-05, &
5063 & 1.27E-05,8.61E-06,5.57E-06,3.96E-06,3.51E-06,1.52E-06, &
5064 & 5.97E-06,3.08E-06,1.54E-06,1.24E-06,8.75E-07,7.43E-07, &
5065 & 5.89E-05,5.40E-05,4.93E-05,4.50E-05,4.10E-05,3.73E-05, &
5066 & 3.41E-05,3.12E-05,2.86E-05,2.62E-05,2.39E-05,2.03E-05, &
5067 & 1.74E-05,1.20E-05,7.99E-06,5.74E-06,4.85E-06,2.21E-06, &
5068 & 8.84E-06,4.73E-06,2.40E-06,1.94E-06,1.38E-06,1.16E-06, &
5069 & 7.31E-05,6.77E-05,6.22E-05,5.72E-05,5.24E-05,4.80E-05, &
5070 & 4.41E-05,4.05E-05,3.73E-05,3.44E-05,3.15E-05,2.70E-05, &
5071 & 2.32E-05,1.62E-05,1.11E-05,8.06E-06,6.61E-06,3.11E-06, &
5072 & 1.23E-05,6.85E-06,3.56E-06,2.88E-06,2.05E-06,1.72E-06, &
5073 ! 3
5074 & 1.16E-05,1.03E-05,9.18E-06,8.17E-06,7.28E-06,6.49E-06, &
5075 & 5.81E-06,5.22E-06,4.70E-06,4.25E-06,3.77E-06,3.13E-06, &
5076 & 2.64E-06,1.74E-06,9.67E-07,6.83E-07,8.71E-07,3.00E-07, &
5077 & 2.42E-07,1.67E-07,1.44E-07,1.35E-07,1.11E-07,1.00E-07, &
5078 & 1.16E-05,1.03E-05,9.20E-06,8.18E-06,7.28E-06,6.50E-06, &
5079 & 5.82E-06,5.23E-06,4.70E-06,4.26E-06,3.78E-06,3.13E-06, &
5080 & 2.64E-06,1.74E-06,9.69E-07,6.85E-07,8.72E-07,3.02E-07, &
5081 & 2.44E-07,1.68E-07,1.45E-07,1.36E-07,1.12E-07,1.01E-07, &
5082 & 1.25E-05,1.11E-05,9.88E-06,8.79E-06,7.83E-06,6.98E-06, &
5083 & 6.25E-06,5.62E-06,5.06E-06,4.58E-06,4.07E-06,3.38E-06, &
5084 & 2.85E-06,1.88E-06,1.06E-06,7.49E-07,9.23E-07,3.28E-07, &
5085 & 3.90E-07,2.32E-07,1.72E-07,1.58E-07,1.28E-07,1.15E-07, &
5086 & 1.68E-05,1.49E-05,1.33E-05,1.19E-05,1.06E-05,9.48E-06, &
5087 & 8.51E-06,7.66E-06,6.92E-06,6.27E-06,5.61E-06,4.67E-06, &
5088 & 3.94E-06,2.61E-06,1.55E-06,1.09E-06,1.18E-06,4.55E-07, &
5089 & 1.14E-06,5.75E-07,3.19E-07,2.71E-07,2.05E-07,1.81E-07, &
5090 & 2.45E-05,2.20E-05,1.97E-05,1.77E-05,1.59E-05,1.43E-05, &
5091 & 1.29E-05,1.17E-05,1.06E-05,9.67E-06,8.71E-06,7.30E-06, &
5092 & 6.19E-06,4.15E-06,2.60E-06,1.85E-06,1.73E-06,7.27E-07, &
5093 & 2.63E-06,1.31E-06,6.55E-07,5.33E-07,3.82E-07,3.28E-07, &
5094 & 3.08E-05,2.78E-05,2.51E-05,2.26E-05,2.05E-05,1.85E-05, &
5095 & 1.67E-05,1.52E-05,1.39E-05,1.26E-05,1.15E-05,9.65E-06, &
5096 & 8.21E-06,5.55E-06,3.60E-06,2.56E-06,2.26E-06,9.87E-07, &
5097 & 3.93E-06,2.00E-06,9.86E-07,7.92E-07,5.59E-07,4.75E-07, &
5098 & 3.98E-05,3.62E-05,3.28E-05,2.98E-05,2.70E-05,2.45E-05, &
5099 & 2.23E-05,2.04E-05,1.86E-05,1.71E-05,1.55E-05,1.32E-05, &
5100 & 1.12E-05,7.70E-06,5.14E-06,3.68E-06,3.10E-06,1.40E-06, &
5101 & 5.86E-06,3.06E-06,1.52E-06,1.22E-06,8.51E-07,7.16E-07, &
5102 & 4.99E-05,4.58E-05,4.18E-05,3.81E-05,3.48E-05,3.17E-05, &
5103 & 2.90E-05,2.66E-05,2.44E-05,2.24E-05,2.06E-05,1.75E-05, &
5104 & 1.51E-05,1.04E-05,7.15E-06,5.15E-06,4.20E-06,1.95E-06, &
5105 & 8.20E-06,4.44E-06,2.24E-06,1.79E-06,1.25E-06,1.05E-06/
5107 end module dalm_ext
5108 !------------------------------------------------------------
5110 ! block data aerosol_convolve5
5111 module aot_spect_5 !mark
5112 implicit none
5113 ! common /aot_spect_5/ wlo(5,15) , hkas(5,15) ,sflx(5,15)
5114 real :: wlo(5,15) , hkas(5,15) ,sflx(5,15)
5115 data wlo / &
5116 & 0.1794,0.1878,0.1970,0.2073,0.2186, &
5117 & 0.2265,0.2301,0.2339,0.2378,0.2418, &
5118 & 0.2475,0.2551,0.2632,0.2717,0.2809, &
5119 & 0.2869,0.2894,0.2920,0.2946,0.2972, &
5120 & 0.3008,0.3053,0.3100,0.3149,0.3199, &
5121 & 0.3257,0.3323,0.3391,0.3462,0.3537, &
5122 & 0.3642,0.3783,0.3935,0.4100,0.4279, &
5123 & 0.4429,0.4539,0.4656,0.4778,0.4908, &
5124 & 0.5059,0.5233,0.5419,0.5620,0.5836, &
5125 & 0.6033,0.6206,0.6389,0.6583,0.6789, &
5126 & 0.7236,0.8026,0.9009,1.0267,1.1933, &
5127 & 1.3414,1.4358,1.5444,1.6708,1.8198, &
5128 & 1.9512,2.0513,2.1622,2.2857,2.4242, &
5129 & 2.5740,2.7360,2.9197,3.1299,3.3727, &
5130 & 3.5524,3.6430,3.7383,3.8388,3.9448/
5132 data hkas / &
5133 & 1.9732E-02,8.2461E-03,1.9433E-02,2.5239E-01,7.0020E-01, &
5134 & 1.7698E-01,1.9552E-01,1.8982E-01,2.0086E-01,2.3681E-01, &
5135 & 6.1144E-02,9.1518E-02,2.0913E-01,3.0821E-01,3.3000E-01, &
5136 & 1.1853E-01,1.6684E-01,2.5436E-01,2.2410E-01,2.3617E-01, &
5137 & 1.3174E-01,1.8637E-01,2.1818E-01,2.1883E-01,2.4487E-01, &
5138 & 1.6818E-01,1.9811E-01,1.7183E-01,2.1417E-01,2.4771E-01, &
5139 & 1.3629E-01,1.4266E-01,1.6518E-01,2.7083E-01,2.8504E-01, &
5140 & 1.6885E-01,1.9578E-01,2.0319E-01,2.1598E-01,2.1620E-01, &
5141 & 1.7878E-01,1.8362E-01,1.9993E-01,2.1178E-01,2.2589E-01, &
5142 & 1.9345E-01,1.9568E-01,2.0132E-01,2.0166E-01,2.0789E-01, &
5143 & 1.9354E-01,2.0025E-01,2.0400E-01,2.0302E-01,1.9919E-01, &
5144 & 2.1754E-01,2.1221E-01,2.0669E-01,1.9305E-01,1.7051E-01, &
5145 & 2.3672E-01,2.1723E-01,1.9925E-01,1.8215E-01,1.6466E-01, &
5146 & 2.4692E-01,2.2312E-01,1.9962E-01,1.7636E-01,1.5398E-01, &
5147 & 2.2023E-01,2.0999E-01,1.9844E-01,1.9036E-01,1.8098E-01/
5149 data sflx / &
5150 & 1.4056E-02,5.8741E-03,1.3843E-02,1.7979E-01,4.9878E-01, &
5151 & 1.5997E-01,1.7673E-01,1.7157E-01,1.8156E-01,2.1404E-01, &
5152 & 4.0480E-01,6.0590E-01,1.3845E+00,2.0405E+00,2.1848E+00, &
5153 & 7.6075E-01,1.0708E+00,1.6325E+00,1.4383E+00,1.5157E+00, &
5154 & 2.1362E+00,3.0220E+00,3.5377E+00,3.5483E+00,3.9706E+00, &
5155 & 5.6607E+00,6.6683E+00,5.7836E+00,7.2089E+00,8.3378E+00, &
5156 & 1.4768E+01,1.5458E+01,1.7899E+01,2.9348E+01,3.0887E+01, &
5157 & 1.9903E+01,2.3078E+01,2.3950E+01,2.5459E+01,2.5484E+01, &
5158 & 3.2273E+01,3.3147E+01,3.6093E+01,3.8232E+01,4.0778E+01, &
5159 & 2.9661E+01,3.0003E+01,3.0869E+01,3.0920E+01,3.1876E+01, &
5160 & 9.5588E+01,9.8903E+01,1.0076E+02,1.0027E+02,9.8377E+01, &
5161 & 3.3902E+01,3.3072E+01,3.2211E+01,3.0086E+01,2.6573E+01, &
5162 & 1.2208E+01,1.1203E+01,1.0275E+01,9.3939E+00,8.4915E+00, &
5163 & 7.0905E+00,6.4071E+00,5.7325E+00,5.0645E+00,4.4219E+00, &
5164 & 1.2380E+00,1.1805E+00,1.1155E+00,1.0701E+00,1.0173E+00/
5166 end module aot_spect_5
5167 !----------------------------------------------------------------
5168 ! block data aerosol_convolve_25
5169 module aot_spect_25
5170 implicit none
5171 ! common /aot_spect_25/ wlo(25,15) , hkas(25,15) ,sflx(25,15)
5172 real wlo_25(25,15) , hkas_25(25,15) ,sflx_25(25,15)
5173 data wlo_25 / &
5174 & 0.1762,0.1778,0.1794,0.1810,0.1826, &
5175 & 0.1843,0.1860,0.1878,0.1896,0.1914, &
5176 & 0.1932,0.1951,0.1970,0.1990,0.2010, &
5177 & 0.2030,0.2051,0.2073,0.2094,0.2116, &
5178 & 0.2139,0.2162,0.2186,0.2210,0.2235, &
5179 & 0.2251,0.2258,0.2265,0.2272,0.2279, &
5180 & 0.2287,0.2294,0.2301,0.2309,0.2316, &
5181 & 0.2324,0.2332,0.2339,0.2347,0.2355, &
5182 & 0.2362,0.2370,0.2378,0.2386,0.2394, &
5183 & 0.2402,0.2410,0.2418,0.2427,0.2435, &
5184 & 0.2446,0.2461,0.2475,0.2490,0.2505, &
5185 & 0.2520,0.2535,0.2551,0.2567,0.2583, &
5186 & 0.2599,0.2615,0.2632,0.2648,0.2665, &
5187 & 0.2682,0.2700,0.2717,0.2735,0.2753, &
5188 & 0.2772,0.2790,0.2809,0.2828,0.2847, &
5189 & 0.2860,0.2865,0.2869,0.2874,0.2879, &
5190 & 0.2884,0.2889,0.2894,0.2899,0.2904, &
5191 & 0.2910,0.2915,0.2920,0.2925,0.2930, &
5192 & 0.2935,0.2940,0.2946,0.2951,0.2956, &
5193 & 0.2961,0.2966,0.2972,0.2977,0.2982, &
5194 & 0.2991,0.3000,0.3009,0.3018,0.3027, &
5195 & 0.3036,0.3045,0.3054,0.3064,0.3073, &
5196 & 0.3082,0.3092,0.3101,0.3111,0.3120, &
5197 & 0.3130,0.3140,0.3150,0.3159,0.3169, &
5198 & 0.3179,0.3189,0.3199,0.3210,0.3220, &
5199 & 0.3232,0.3245,0.3258,0.3271,0.3284, &
5200 & 0.3297,0.3310,0.3323,0.3337,0.3350, &
5201 & 0.3364,0.3378,0.3392,0.3406,0.3420, &
5202 & 0.3434,0.3448,0.3463,0.3477,0.3492, &
5203 & 0.3507,0.3522,0.3537,0.3552,0.3567, &
5204 & 0.3590,0.3617,0.3643,0.3671,0.3698, &
5205 & 0.3726,0.3755,0.3784,0.3813,0.3843, &
5206 & 0.3874,0.3905,0.3936,0.3968,0.4000, &
5207 & 0.4033,0.4067,0.4101,0.4135,0.4170, &
5208 & 0.4206,0.4243,0.4280,0.4317,0.4356, &
5209 & 0.4387,0.4408,0.4429,0.4451,0.4473, &
5210 & 0.4495,0.4518,0.4540,0.4563,0.4586, &
5211 & 0.4609,0.4633,0.4656,0.4680,0.4705, &
5212 & 0.4729,0.4754,0.4779,0.4804,0.4830, &
5213 & 0.4855,0.4881,0.4908,0.4934,0.4961, &
5214 & 0.4996,0.5029,0.5062,0.5096,0.5130, &
5215 & 0.5165,0.5200,0.5236,0.5272,0.5309, &
5216 & 0.5346,0.5383,0.5422,0.5460,0.5500, &
5217 & 0.5540,0.5580,0.5621,0.5663,0.5705, &
5218 & 0.5748,0.5792,0.5836,0.5881,0.5927, &
5219 & 0.5969,0.6002,0.6035,0.6069,0.6103, &
5220 & 0.6137,0.6172,0.6207,0.6243,0.6279, &
5221 & 0.6316,0.6352,0.6390,0.6428,0.6466, &
5222 & 0.6504,0.6544,0.6583,0.6623,0.6664, &
5223 & 0.6705,0.6747,0.6789,0.6832,0.6875, &
5224 & 0.6962,0.7096,0.7236,0.7381,0.7532, &
5225 & 0.7690,0.7854,0.8026,0.8205,0.8392, &
5226 & 0.8588,0.8794,0.9009,0.9235,0.9473, &
5227 & 0.9724,0.9988,1.0267,1.0562,1.0874, &
5228 & 1.1206,1.1558,1.1933,1.2333,1.2762, &
5229 & 1.3070,1.3240,1.3414,1.3592,1.3776, &
5230 & 1.3965,1.4158,1.4358,1.4562,1.4773, &
5231 & 1.4990,1.5214,1.5444,1.5681,1.5926, &
5232 & 1.6179,1.6439,1.6708,1.6987,1.7274, &
5233 & 1.7572,1.7879,1.8198,1.8529,1.8871, &
5234 & 1.9139,1.9324,1.9512,1.9704,1.9900, &
5235 & 2.0101,2.0305,2.0513,2.0725,2.0942, &
5236 & 2.1164,2.1390,2.1622,2.1858,2.2099, &
5237 & 2.2346,2.2599,2.2857,2.3121,2.3392, &
5238 & 2.3669,2.3952,2.4242,2.4540,2.4845, &
5239 & 2.5145,2.5439,2.5740,2.6048,2.6364, &
5240 & 2.6688,2.7020,2.7360,2.7709,2.8066, &
5241 & 2.8433,2.8810,2.9197,2.9595,3.0003, &
5242 & 3.0423,3.0855,3.1299,3.1756,3.2227, &
5243 & 3.2712,3.3212,3.3727,3.4258,3.4807, &
5244 & 3.5174,3.5348,3.5524,3.5702,3.5881, &
5245 & 3.6062,3.6245,3.6430,3.6617,3.6805, &
5246 & 3.6996,3.7189,3.7383,3.7580,3.7779, &
5247 & 3.7979,3.8183,3.8388,3.8595,3.8805, &
5248 & 3.9017,3.9231,3.9448,3.9667,3.9888/
5250 data hkas_25 / &
5251 & 5.2799E-03,5.0829E-03,4.6490E-03,4.0241E-03,3.4829E-03, &
5252 & 2.8976E-03,2.3480E-03,1.8516E-03,1.3749E-03,9.3841E-04, &
5253 & 5.9685E-04,3.2885E-04,1.3047E-04,2.2220E-05,5.5991E-03, &
5254 & 2.7673E-02,3.1899E-02,3.7975E-02,4.7693E-02,8.3620E-02, &
5255 & 1.1867E-01,1.4080E-01,1.2000E-01,1.8402E-01,1.6904E-01, &
5256 & 5.0121E-02,4.9452E-02,4.6279E-02,4.0956E-02,3.7858E-02, &
5257 & 2.6053E-02,3.0795E-02,4.6226E-02,3.7153E-02,3.5560E-02, &
5258 & 4.7180E-02,3.7850E-02,4.0573E-02,4.5254E-02,3.5590E-02, &
5259 & 3.0742E-02,4.1064E-02,4.1940E-02,4.0586E-02,4.7516E-02, &
5260 & 3.2378E-02,4.4837E-02,3.5456E-02,3.5664E-02,4.2917E-02, &
5261 & 1.6466E-02,1.5248E-02,1.2129E-02,1.2876E-02,1.0915E-02, &
5262 & 1.5288E-02,1.2174E-02,1.1518E-02,1.5566E-02,2.3291E-02, &
5263 & 3.5784E-02,2.7197E-02,2.5602E-02,2.8189E-02,6.8271E-02, &
5264 & 7.4253E-02,7.6509E-02,7.4379E-02,7.6454E-02,6.3299E-02, &
5265 & 4.4999E-02,7.9458E-02,5.3948E-02,3.1778E-02,9.4411E-02, &
5266 & 2.9705E-02,2.9759E-02,2.6074E-02,1.4967E-02,7.4578E-03, &
5267 & 2.3107E-02,3.1405E-02,3.1772E-02,3.8404E-02,2.7981E-02, &
5268 & 2.5950E-02,3.7908E-02,4.2120E-02,5.6514E-02,6.0159E-02, &
5269 & 5.4489E-02,5.7136E-02,5.3536E-02,4.5756E-02,5.3907E-02, &
5270 & 5.1124E-02,4.7270E-02,5.0278E-02,5.2757E-02,5.0463E-02, &
5271 & 3.0474E-02,3.1978E-02,2.5582E-02,3.1001E-02,2.6341E-02, &
5272 & 2.9467E-02,2.5155E-02,3.6947E-02,4.1472E-02,3.9135E-02, &
5273 & 3.7515E-02,3.9334E-02,4.3622E-02,4.5644E-02,3.7261E-02, &
5274 & 3.9516E-02,6.1067E-02,4.4004E-02,4.7490E-02,4.7719E-02, &
5275 & 5.4569E-02,3.5377E-02,5.9282E-02,4.1212E-02,4.8834E-02, &
5276 & 3.3110E-02,2.7957E-02,2.4541E-02,3.1640E-02,3.8452E-02, &
5277 & 4.3699E-02,3.7692E-02,4.5887E-02,3.6735E-02,4.2471E-02, &
5278 & 4.0508E-02,4.0549E-02,3.1263E-02,3.2911E-02,3.6471E-02, &
5279 & 4.0021E-02,3.6207E-02,4.0685E-02,3.9095E-02,4.8464E-02, &
5280 & 4.7468E-02,4.8137E-02,5.3969E-02,4.7248E-02,5.4817E-02, &
5281 & 2.4834E-02,2.1951E-02,2.6050E-02,2.7710E-02,3.4553E-02, &
5282 & 3.1715E-02,2.9451E-02,2.7336E-02,3.6347E-02,3.1034E-02, &
5283 & 2.3427E-02,2.7237E-02,3.7576E-02,2.6206E-02,3.2126E-02, &
5284 & 5.2125E-02,5.2807E-02,5.1698E-02,5.6664E-02,5.8765E-02, &
5285 & 6.0530E-02,5.9962E-02,5.9826E-02,5.6824E-02,5.3245E-02, &
5286 & 2.9942E-02,3.4314E-02,3.1576E-02,3.4169E-02,3.6263E-02, &
5287 & 3.5425E-02,3.8424E-02,4.0153E-02,3.9218E-02,3.9656E-02, &
5288 & 4.1712E-02,4.0169E-02,4.1568E-02,4.1185E-02,4.1190E-02, &
5289 & 4.2675E-02,4.1942E-02,4.2627E-02,4.4241E-02,4.5120E-02, &
5290 & 4.5103E-02,4.4734E-02,3.9963E-02,4.4448E-02,4.4182E-02, &
5291 & 3.6238E-02,3.5264E-02,3.4319E-02,3.6506E-02,3.6858E-02, &
5292 & 3.7418E-02,3.5769E-02,3.4340E-02,3.7866E-02,3.7059E-02, &
5293 & 4.0566E-02,3.8579E-02,4.0826E-02,3.9780E-02,4.1088E-02, &
5294 & 4.1249E-02,4.2418E-02,4.2017E-02,4.2620E-02,4.3139E-02, &
5295 & 4.3749E-02,4.5394E-02,4.5299E-02,4.6414E-02,4.5227E-02, &
5296 & 3.7723E-02,3.8411E-02,3.8671E-02,3.8195E-02,3.9511E-02, &
5297 & 3.9418E-02,3.9055E-02,3.8240E-02,3.9599E-02,3.9985E-02, &
5298 & 3.9300E-02,4.0631E-02,3.9929E-02,4.0581E-02,4.0475E-02, &
5299 & 4.0624E-02,4.0457E-02,4.1359E-02,3.7988E-02,4.1377E-02, &
5300 & 4.1472E-02,4.1668E-02,4.1660E-02,4.1838E-02,4.1834E-02, &
5301 & 3.8155E-02,3.8333E-02,3.8502E-02,3.9057E-02,3.9013E-02, &
5302 & 3.9461E-02,3.9758E-02,4.0111E-02,4.0243E-02,4.0392E-02, &
5303 & 3.9720E-02,4.0458E-02,4.1065E-02,4.1312E-02,4.1326E-02, &
5304 & 4.1240E-02,4.1154E-02,4.0773E-02,4.0305E-02,4.0042E-02, &
5305 & 4.0018E-02,4.0038E-02,3.9956E-02,3.9901E-02,3.9668E-02, &
5306 & 4.4043E-02,4.3956E-02,4.3412E-02,4.2920E-02,4.2591E-02, &
5307 & 4.2487E-02,4.2451E-02,4.2278E-02,4.1980E-02,4.1849E-02, &
5308 & 4.1556E-02,4.1621E-02,4.1312E-02,4.0978E-02,4.0676E-02, &
5309 & 4.0101E-02,3.9593E-02,3.8711E-02,3.8058E-02,3.7376E-02, &
5310 & 3.6255E-02,3.5384E-02,3.4555E-02,3.3467E-02,3.2390E-02, &
5311 & 4.9085E-02,4.8014E-02,4.7452E-02,4.6084E-02,4.6143E-02, &
5312 & 4.5126E-02,4.4490E-02,4.3771E-02,4.2825E-02,4.1722E-02, &
5313 & 4.0817E-02,4.0346E-02,3.9877E-02,3.8934E-02,3.8461E-02, &
5314 & 3.8034E-02,3.7265E-02,3.6323E-02,3.5726E-02,3.5049E-02, &
5315 & 3.4210E-02,3.3481E-02,3.2891E-02,3.2285E-02,3.1588E-02, &
5316 & 5.1217E-02,5.0595E-02,4.9284E-02,4.8233E-02,4.7849E-02, &
5317 & 4.6488E-02,4.5516E-02,4.4685E-02,4.3738E-02,4.2612E-02, &
5318 & 4.1889E-02,4.0913E-02,3.9819E-02,3.8998E-02,3.8111E-02, &
5319 & 3.7139E-02,3.6048E-02,3.5235E-02,3.4379E-02,3.3489E-02, &
5320 & 3.2579E-02,3.1537E-02,3.0736E-02,2.9824E-02,2.9085E-02, &
5321 & 4.5112E-02,4.4731E-02,4.4278E-02,4.3820E-02,4.3350E-02, &
5322 & 4.2925E-02,4.2577E-02,4.2229E-02,4.1713E-02,4.1188E-02, &
5323 & 4.0646E-02,4.0021E-02,3.9857E-02,3.8890E-02,3.8999E-02, &
5324 & 3.8626E-02,3.8315E-02,3.7974E-02,3.7671E-02,3.7171E-02, &
5325 & 3.6752E-02,3.6471E-02,3.6046E-02,3.5548E-02,3.5090E-02/
5327 data sflx_25/ &
5328 & 3.3009E-03,3.1778E-03,2.9065E-03,2.5158E-03,2.1775E-03, &
5329 & 1.8116E-03,1.4679E-03,1.1576E-03,8.5959E-04,5.8668E-04, &
5330 & 3.7314E-04,2.0560E-04,8.1568E-05,1.3892E-05,3.5005E-03, &
5331 & 1.7301E-02,1.9943E-02,2.3742E-02,2.9817E-02,5.2278E-02, &
5332 & 7.4193E-02,8.8026E-02,7.5023E-02,1.1505E-01,1.0568E-01, &
5333 & 4.4282E-02,4.3691E-02,4.0888E-02,3.6184E-02,3.3448E-02, &
5334 & 2.3018E-02,2.7208E-02,4.0841E-02,3.2825E-02,3.1417E-02, &
5335 & 4.1683E-02,3.3441E-02,3.5846E-02,3.9982E-02,3.1444E-02, &
5336 & 2.7161E-02,3.6280E-02,3.7054E-02,3.5858E-02,4.1981E-02, &
5337 & 2.8606E-02,3.9614E-02,3.1325E-02,3.1509E-02,3.7918E-02, &
5338 & 1.0101E-01,9.3537E-02,7.4402E-02,7.8986E-02,6.6956E-02, &
5339 & 9.3786E-02,7.4679E-02,7.0655E-02,9.5489E-02,1.4288E-01, &
5340 & 2.1951E-01,1.6683E-01,1.5705E-01,1.7292E-01,4.1880E-01, &
5341 & 4.5550E-01,4.6934E-01,4.5627E-01,4.6900E-01,3.8830E-01, &
5342 & 2.7604E-01,4.8743E-01,3.3094E-01,1.9494E-01,5.7915E-01, &
5343 & 1.7599E-01,1.7631E-01,1.5448E-01,8.8671E-02,4.4184E-02, &
5344 & 1.3690E-01,1.8606E-01,1.8824E-01,2.2753E-01,1.6577E-01, &
5345 & 1.5374E-01,2.2459E-01,2.4955E-01,3.3482E-01,3.5642E-01, &
5346 & 3.2283E-01,3.3851E-01,3.1718E-01,2.7109E-01,3.1938E-01, &
5347 & 3.0289E-01,2.8005E-01,2.9787E-01,3.1256E-01,2.9897E-01, &
5348 & 4.7450E-01,4.9792E-01,3.9834E-01,4.8271E-01,4.1015E-01, &
5349 & 4.5883E-01,3.9168E-01,5.7529E-01,6.4574E-01,6.0936E-01, &
5350 & 5.8414E-01,6.1246E-01,6.7922E-01,7.1071E-01,5.8018E-01, &
5351 & 6.1529E-01,9.5085E-01,6.8518E-01,7.3945E-01,7.4301E-01, &
5352 & 8.4968E-01,5.5085E-01,9.2306E-01,6.4171E-01,7.6037E-01, &
5353 & 1.0836E+00,9.1500E-01,8.0321E-01,1.0356E+00,1.2585E+00, &
5354 & 1.4302E+00,1.2336E+00,1.5018E+00,1.2023E+00,1.3900E+00, &
5355 & 1.3258E+00,1.3271E+00,1.0232E+00,1.0772E+00,1.1937E+00, &
5356 & 1.3099E+00,1.1850E+00,1.3316E+00,1.2795E+00,1.5862E+00, &
5357 & 1.5536E+00,1.5755E+00,1.7664E+00,1.5464E+00,1.7941E+00, &
5358 & 2.6150E+00,2.3115E+00,2.7431E+00,2.9179E+00,3.6384E+00, &
5359 & 3.3396E+00,3.1012E+00,2.8785E+00,3.8273E+00,3.2679E+00, &
5360 & 2.4668E+00,2.8681E+00,3.9567E+00,2.7595E+00,3.3828E+00, &
5361 & 5.4888E+00,5.5606E+00,5.4437E+00,5.9667E+00,6.1879E+00, &
5362 & 6.3738E+00,6.3140E+00,6.2996E+00,5.9836E+00,5.6067E+00, &
5363 & 3.4766E+00,3.9842E+00,3.6664E+00,3.9674E+00,4.2105E+00, &
5364 & 4.1133E+00,4.4615E+00,4.6622E+00,4.5536E+00,4.6045E+00, &
5365 & 4.8432E+00,4.6640E+00,4.8265E+00,4.7820E+00,4.7826E+00, &
5366 & 4.9550E+00,4.8700E+00,4.9494E+00,5.1368E+00,5.2390E+00, &
5367 & 5.2370E+00,5.1941E+00,4.6402E+00,5.1609E+00,5.1301E+00, &
5368 & 6.4948E+00,6.3201E+00,6.1509E+00,6.5429E+00,6.6059E+00, &
5369 & 6.7062E+00,6.4108E+00,6.1545E+00,6.7865E+00,6.6419E+00, &
5370 & 7.2704E+00,6.9142E+00,7.3170E+00,7.1295E+00,7.3641E+00, &
5371 & 7.3928E+00,7.6024E+00,7.5305E+00,7.6385E+00,7.7317E+00, &
5372 & 7.8410E+00,8.1357E+00,8.1187E+00,8.3186E+00,8.1057E+00, &
5373 & 5.7948E+00,5.9004E+00,5.9404E+00,5.8673E+00,6.0694E+00, &
5374 & 6.0551E+00,5.9994E+00,5.8742E+00,6.0830E+00,6.1422E+00, &
5375 & 6.0369E+00,6.2414E+00,6.1336E+00,6.2338E+00,6.2175E+00, &
5376 & 6.2403E+00,6.2148E+00,6.3533E+00,5.8355E+00,6.3561E+00, &
5377 & 6.3706E+00,6.4007E+00,6.3995E+00,6.4268E+00,6.4263E+00, &
5378 & 1.8893E+01,1.8981E+01,1.9065E+01,1.9339E+01,1.9317E+01, &
5379 & 1.9539E+01,1.9686E+01,1.9861E+01,1.9927E+01,2.0000E+01, &
5380 & 1.9668E+01,2.0033E+01,2.0333E+01,2.0456E+01,2.0463E+01, &
5381 & 2.0420E+01,2.0378E+01,2.0189E+01,1.9958E+01,1.9827E+01, &
5382 & 1.9815E+01,1.9825E+01,1.9784E+01,1.9757E+01,1.9642E+01, &
5383 & 6.9768E+00,6.9631E+00,6.8768E+00,6.7990E+00,6.7469E+00, &
5384 & 6.7303E+00,6.7247E+00,6.6973E+00,6.6500E+00,6.6293E+00, &
5385 & 6.5828E+00,6.5933E+00,6.5442E+00,6.4914E+00,6.4434E+00, &
5386 & 6.3523E+00,6.2719E+00,6.1322E+00,6.0288E+00,5.9207E+00, &
5387 & 5.7431E+00,5.6052E+00,5.4739E+00,5.3015E+00,5.1310E+00, &
5388 & 2.6183E+00,2.5612E+00,2.5312E+00,2.4582E+00,2.4613E+00, &
5389 & 2.4071E+00,2.3732E+00,2.3348E+00,2.2844E+00,2.2255E+00, &
5390 & 2.1772E+00,2.1521E+00,2.1271E+00,2.0768E+00,2.0516E+00, &
5391 & 2.0288E+00,1.9878E+00,1.9375E+00,1.9057E+00,1.8696E+00, &
5392 & 1.8248E+00,1.7859E+00,1.7544E+00,1.7221E+00,1.6850E+00, &
5393 & 1.5186E+00,1.5002E+00,1.4613E+00,1.4301E+00,1.4187E+00, &
5394 & 1.3784E+00,1.3496E+00,1.3249E+00,1.2968E+00,1.2635E+00, &
5395 & 1.2420E+00,1.2131E+00,1.1806E+00,1.1563E+00,1.1300E+00, &
5396 & 1.1012E+00,1.0688E+00,1.0447E+00,1.0193E+00,9.9296E-01, &
5397 & 9.6597E-01,9.3507E-01,9.1134E-01,8.8430E-01,8.6237E-01, &
5398 & 2.6980E-01,2.6752E-01,2.6481E-01,2.6207E-01,2.5926E-01, &
5399 & 2.5672E-01,2.5464E-01,2.5256E-01,2.4947E-01,2.4633E-01, &
5400 & 2.4309E-01,2.3935E-01,2.3837E-01,2.3259E-01,2.3324E-01, &
5401 & 2.3101E-01,2.2915E-01,2.2711E-01,2.2530E-01,2.2231E-01, &
5402 & 2.1980E-01,2.1812E-01,2.1558E-01,2.1260E-01,2.0986E-01/
5404 end module aot_spect_25
5405 !-----------------------------------------------------------------------
5407 !-------------------------------------------------------------------------------
5408 ! new data for nongray gas absorption
5409 !-------------------------------------------------------------------------------
5410 module band_new
5411 implicit none
5412 integer, private :: i, j, k
5413 ! block data ckd1_new
5414 !c *********************************************************************
5415 !c hk is the interval in the g (cumulative probability) space from 0 to
5416 !c one. fko3 is the corresponding ozone absorption coefficient in units
5417 !c of (cm-atm)**-1 (Fu, 1991). The spectral region is from 50000 cm**-1
5418 !c to 14500 cm**-1.
5419 !c *********************************************************************
5420 ! common /band1_new/ hk(10), fko3(10)
5421 real hk_1_new(10), fko3_1_new(10)
5422 data hk_1_new / .24, .16, .24, .28, .03, &
5423 & .016, .01, .008, .008, .008 /
5424 data fko3_1_new / .2204e-08,.1207e-01,.4537e-01,.1032e+00,.1740e+00, &
5425 & .1210e+01,.7367e+01,.2050e+02,.8100e+02,.2410e+03 /
5427 ! block data ckd2_new
5428 !c *********************************************************************
5429 !c hk is the interval in the g (cumulative probability) space from 0
5430 !c to one. coeh2o is the coefficient to calculate the H2O absorption
5431 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
5432 !c pressures, and eight cumulative probabilities ( Fu, 1991 ). The
5433 !c spectral region is from 14500 to 7700 cm**-1.
5434 !c in this block data, Z.F. has added coefficients for O2 and Water vapor
5435 !c continuum absorption in Jun,2003.
5436 !c *********************************************************************
5437 ! common /band2_new/ hk(12),coehh22(3,11,12),coeo2(3,11,12) &
5438 ! ,coeh2o(3,11,12)
5439 real hk_2_new(12),coehh22_2_new(3,11,12),coeo2_2_new(3,11,12) &
5440 & ,coeh2o_2_new(3,11,12)
5441 data hk_2_new /8.13791e-02,1.71362e-01,2.22259e-01,2.22259e-01, &
5442 & 1.71362e-01,8.13791e-02,4.28311e-03,9.01904e-03, &
5443 & 1.16978e-02,1.16978e-02,9.01904e-03,4.28311e-03/
5444 data ( ( coehh22_2_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
5445 &-.1821E+02,-.1407E+02,-.1108E+02,-.8593E+01,-.6067E+01,-.3578E+01, &
5446 &-.2358E+01,-.2027E+01,-.1428E+01,-.4851E+00,0.9785E+00,0.3279E+01, &
5447 &-.1775E+02,-.1361E+02,-.1062E+02,-.8141E+01,-.5667E+01,-.3321E+01, &
5448 &-.2164E+01,-.1850E+01,-.1285E+01,-.3751E+00,0.1043E+01,0.3303E+01, &
5449 &-.1729E+02,-.1315E+02,-.1016E+02,-.7684E+01,-.5263E+01,-.3047E+01, &
5450 &-.1950E+01,-.1647E+01,-.1117E+01,-.2376E+00,0.1122E+01,0.3332E+01, &
5451 &-.1683E+02,-.1269E+02,-.9698E+01,-.7231E+01,-.4862E+01,-.2759E+01, &
5452 &-.1717E+01,-.1436E+01,-.9149E+00,-.8219E-01,0.1243E+01,0.3375E+01, &
5453 &-.1636E+02,-.1223E+02,-.9238E+01,-.6779E+01,-.4470E+01,-.2452E+01, &
5454 &-.1468E+01,-.1204E+01,-.6986E+00,0.9617E-01,0.1358E+01,0.3457E+01, &
5455 &-.1590E+02,-.1177E+02,-.8780E+01,-.6333E+01,-.4088E+01,-.2141E+01, &
5456 &-.1215E+01,-.9557E+00,-.4736E+00,0.2885E+00,0.1475E+01,0.3482E+01, &
5457 &-.1545E+02,-.1131E+02,-.8325E+01,-.5897E+01,-.3725E+01,-.1835E+01, &
5458 &-.9593E+00,-.7167E+00,-.2586E+00,0.4937E+00,0.1604E+01,0.3545E+01, &
5459 &-.1498E+02,-.1085E+02,-.7870E+01,-.5470E+01,-.3376E+01,-.1538E+01, &
5460 &-.7021E+00,-.4709E+00,-.3576E-01,0.6926E+00,0.1718E+01,0.3590E+01, &
5461 &-.1452E+02,-.1039E+02,-.7421E+01,-.5067E+01,-.3050E+01,-.1252E+01, &
5462 &-.4701E+00,-.2477E+00,0.1768E+00,0.8375E+00,0.1814E+01,0.3606E+01, &
5463 &-.1406E+02,-.9927E+01,-.6986E+01,-.4696E+01,-.2753E+01,-.9814E+00, &
5464 &-.2519E+00,-.4112E-01,0.3549E+00,0.9703E+00,0.1910E+01,0.3559E+01, &
5465 &-.1360E+02,-.9472E+01,-.6574E+01,-.4359E+01,-.2487E+01,-.7404E+00, &
5466 &-.4451E-01,0.1383E+00,0.4923E+00,0.1085E+01,0.2017E+01,0.3453E+01/
5467 data ( ( coehh22_2_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
5468 &-.2168E-01,-.7137E-02,-.2046E-02,-.6012E-03,0.1375E-02,0.3989E-02, &
5469 &0.4886E-02,0.4990E-02,0.4812E-02,0.4351E-02,0.3974E-02,0.2008E-02, &
5470 &-.2166E-01,-.7155E-02,-.2041E-02,-.6029E-03,0.1182E-02,0.3206E-02, &
5471 &0.4093E-02,0.4055E-02,0.3902E-02,0.3741E-02,0.3299E-02,0.1692E-02, &
5472 &-.2167E-01,-.7142E-02,-.2036E-02,-.5894E-03,0.1002E-02,0.2573E-02, &
5473 &0.3263E-02,0.3213E-02,0.3053E-02,0.3087E-02,0.2730E-02,0.1736E-02, &
5474 &-.2168E-01,-.7141E-02,-.2031E-02,-.5649E-03,0.8002E-03,0.1931E-02, &
5475 &0.2491E-02,0.2393E-02,0.2325E-02,0.2442E-02,0.2186E-02,0.1413E-02, &
5476 &-.2168E-01,-.7137E-02,-.2017E-02,-.5129E-03,0.6594E-03,0.1419E-02, &
5477 &0.1780E-02,0.1713E-02,0.1783E-02,0.1866E-02,0.1721E-02,0.1210E-02, &
5478 &-.2168E-01,-.7136E-02,-.2008E-02,-.4597E-03,0.5986E-03,0.8626E-03, &
5479 &0.1188E-02,0.1271E-02,0.1314E-02,0.1275E-02,0.1135E-02,0.7870E-03, &
5480 &-.2166E-01,-.7154E-02,-.1977E-02,-.3950E-03,0.6628E-03,0.5570E-03, &
5481 &0.8196E-03,0.8767E-03,0.9092E-03,0.7797E-03,0.6736E-03,0.4020E-03, &
5482 &-.2167E-01,-.7135E-02,-.1937E-02,-.3398E-03,0.7607E-03,0.2372E-03, &
5483 &0.6595E-03,0.6433E-03,0.5461E-03,0.4611E-03,0.3156E-03,-.1029E-03, &
5484 &-.2168E-01,-.7130E-02,-.1861E-02,-.2656E-03,0.8627E-03,0.4753E-04, &
5485 &0.4097E-03,0.3685E-03,0.3269E-03,0.3406E-03,0.2222E-03,-.1134E-03, &
5486 &-.2166E-01,-.7098E-02,-.1766E-02,-.1544E-03,0.8606E-03,-.1285E-03, &
5487 &0.5824E-04,0.2334E-03,0.1791E-03,0.1358E-03,-.3466E-04,-.1864E-03, &
5488 &-.2166E-01,-.7058E-02,-.1687E-02,-.1018E-04,0.8420E-03,-.1835E-03, &
5489 &-.1922E-03,-.7330E-04,0.3881E-04,-.8928E-04,-.1939E-04,-.7279E-04/
5490 data ( ( coehh22_2_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
5491 &0.5345E-05,0.3912E-04,0.2748E-04,0.1444E-05,-.4212E-05,-.2604E-05, &
5492 &-.2211E-05,-.3476E-05,-.2656E-05,-.6117E-05,-.7721E-05,0.9503E-05, &
5493 &0.5435E-05,0.3922E-04,0.2701E-04,0.7721E-06,-.4266E-05,-.1224E-05, &
5494 &-.1462E-05,-.3870E-05,-.1057E-06,-.5089E-05,-.6126E-05,0.7750E-05, &
5495 &0.5355E-05,0.3916E-04,0.2726E-04,0.5206E-06,-.3851E-05,0.1578E-05, &
5496 &0.9728E-06,-.3372E-05,0.1778E-05,-.2598E-05,-.3351E-06,0.2366E-05, &
5497 &0.5353E-05,0.3921E-04,0.2713E-04,0.4761E-07,-.4572E-05,0.5006E-05, &
5498 &0.8988E-07,0.1673E-05,0.9565E-06,-.3223E-06,-.5420E-05,-.1326E-05, &
5499 &0.5364E-05,0.3905E-04,0.2694E-04,-.2245E-06,-.3170E-05,0.4342E-05, &
5500 &0.3347E-06,0.8541E-06,-.4142E-06,0.1542E-05,-.7389E-06,-.6179E-05, &
5501 &0.5346E-05,0.3909E-04,0.2676E-04,0.5793E-07,-.1923E-05,0.4991E-05, &
5502 &-.4133E-06,-.4665E-06,0.1344E-05,0.3320E-05,0.1297E-05,0.1052E-05, &
5503 &0.5435E-05,0.3914E-04,0.2615E-04,-.5951E-07,-.2672E-06,0.4456E-05, &
5504 &0.2792E-06,0.1402E-05,0.4331E-05,0.7323E-07,-.1674E-05,0.1962E-05, &
5505 &0.5355E-05,0.3917E-04,0.2610E-04,0.8890E-06,0.1079E-05,0.3992E-05, &
5506 &-.2672E-06,0.2250E-05,0.3658E-05,-.3284E-05,-.3928E-06,0.3088E-05, &
5507 &0.5352E-05,0.3905E-04,0.2578E-04,0.1128E-05,0.2670E-05,0.2115E-05, &
5508 &0.4263E-05,0.1726E-05,0.1125E-05,0.9597E-07,-.1567E-05,0.3222E-05, &
5509 &0.5711E-05,0.3895E-04,0.2695E-04,0.2255E-05,0.2170E-05,0.1602E-05, &
5510 &0.3974E-05,0.2949E-05,0.8487E-06,0.6461E-06,0.4729E-05,0.4043E-06, &
5511 &0.5705E-05,0.3824E-04,0.2761E-04,0.2485E-05,0.1433E-05,0.2177E-05, &
5512 &0.2933E-05,0.5048E-05,0.5340E-05,0.1356E-05,0.4762E-05,-.4439E-06/
5513 data ( ( coeo2_2_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
5514 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2516E+02, &
5515 &-.2171E+02,-.2105E+02,-.1975E+02,-.1772E+02,-.1573E+02,-.1210E+02, &
5516 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2471E+02, &
5517 &-.2126E+02,-.2060E+02,-.1932E+02,-.1732E+02,-.1534E+02,-.1185E+02, &
5518 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2424E+02, &
5519 &-.2080E+02,-.2015E+02,-.1889E+02,-.1692E+02,-.1495E+02,-.1159E+02, &
5520 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2378E+02, &
5521 &-.2034E+02,-.1970E+02,-.1847E+02,-.1652E+02,-.1455E+02,-.1136E+02, &
5522 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2332E+02, &
5523 &-.1989E+02,-.1925E+02,-.1805E+02,-.1613E+02,-.1413E+02,-.1108E+02, &
5524 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2286E+02, &
5525 &-.1945E+02,-.1881E+02,-.1763E+02,-.1573E+02,-.1369E+02,-.1074E+02, &
5526 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2240E+02, &
5527 &-.1900E+02,-.1837E+02,-.1723E+02,-.1534E+02,-.1326E+02,-.1044E+02, &
5528 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2194E+02, &
5529 &-.1857E+02,-.1795E+02,-.1683E+02,-.1495E+02,-.1283E+02,-.1015E+02, &
5530 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2149E+02, &
5531 &-.1816E+02,-.1753E+02,-.1644E+02,-.1454E+02,-.1244E+02,-.9817E+01, &
5532 &-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2104E+02, &
5533 &-.1778E+02,-.1713E+02,-.1606E+02,-.1413E+02,-.1206E+02,-.9475E+01, &
5534 &-.4604E+02,-.4601E+02,-.4595E+02,-.4588E+02,-.4583E+02,-.2055E+02, &
5535 &-.1738E+02,-.1672E+02,-.1566E+02,-.1373E+02,-.1170E+02,-.9193E+01/
5536 data ( ( coeo2_2_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
5537 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1366E-01, &
5538 &0.7135E-02,0.4556E-02,0.4852E-02,0.2572E-02,0.4399E-03,0.2910E-02, &
5539 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1367E-01, &
5540 &0.7211E-02,0.4590E-02,0.4885E-02,0.2295E-02,-.1277E-03,0.1699E-02, &
5541 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1367E-01, &
5542 &0.7271E-02,0.4660E-02,0.4926E-02,0.2230E-02,-.6077E-03,0.9087E-03, &
5543 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1368E-01, &
5544 &0.7344E-02,0.4702E-02,0.4860E-02,0.2109E-02,-.7692E-03,0.4872E-03, &
5545 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1370E-01, &
5546 &0.7449E-02,0.4758E-02,0.4803E-02,0.2056E-02,-.9399E-03,0.4198E-03, &
5547 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1371E-01, &
5548 &0.7573E-02,0.4859E-02,0.4630E-02,0.1992E-02,-.1122E-02,0.8852E-05, &
5549 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1375E-01, &
5550 &0.7719E-02,0.4959E-02,0.4513E-02,0.1875E-02,-.1294E-02,-.2601E-03, &
5551 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1378E-01, &
5552 &0.7919E-02,0.5059E-02,0.4343E-02,0.1973E-02,-.1403E-02,-.4933E-03, &
5553 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1384E-01, &
5554 &0.8042E-02,0.5232E-02,0.4213E-02,0.2020E-02,-.1381E-02,-.6582E-03, &
5555 &-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1398E-01, &
5556 &0.8357E-02,0.5262E-02,0.4275E-02,0.1935E-02,-.1254E-02,-.4774E-03, &
5557 &-.4161E-06,-.2011E-05,-.4578E-05,-.7456E-05,-.1002E-04,0.1418E-01, &
5558 &0.8342E-02,0.5315E-02,0.3932E-02,0.1758E-02,-.9858E-03,-.7214E-03/
5559 data ( ( coeo2_2_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
5560 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2417E-04, &
5561 &-.4086E-04,-.1231E-04,-.2747E-04,-.2066E-04,0.1113E-04,0.9287E-05, &
5562 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2432E-04, &
5563 &-.4252E-04,-.1328E-04,-.2484E-04,-.2011E-04,0.9843E-05,-.5839E-06, &
5564 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2428E-04, &
5565 &-.4226E-04,-.1416E-04,-.2158E-04,-.1958E-04,0.1067E-04,-.3985E-05, &
5566 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2461E-04, &
5567 &-.4324E-04,-.1462E-04,-.1828E-04,-.2116E-04,0.1271E-04,0.5814E-05, &
5568 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2463E-04, &
5569 &-.4351E-04,-.1427E-04,-.1314E-04,-.2016E-04,0.1150E-04,0.9943E-06, &
5570 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2504E-04, &
5571 &-.4237E-04,-.1326E-04,-.1001E-04,-.2134E-04,0.8825E-05,0.6250E-06, &
5572 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2576E-04, &
5573 &-.4232E-04,-.1489E-04,-.5905E-05,-.1889E-04,0.4480E-05,0.1725E-05, &
5574 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2656E-04, &
5575 &-.4117E-04,-.1467E-04,-.4666E-05,-.1198E-04,0.6646E-06,0.9255E-05, &
5576 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2700E-04, &
5577 &-.3805E-04,-.1800E-04,-.2492E-05,-.1327E-04,0.2149E-05,0.9164E-05, &
5578 &-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2826E-04, &
5579 &-.3420E-04,-.2047E-04,0.3207E-05,-.1336E-04,-.2036E-05,0.2122E-05, &
5580 &0.1261E-08,0.6305E-08,0.1513E-07,0.2711E-07,0.3468E-07,-.2569E-04, &
5581 &-.2710E-04,-.1924E-04,0.1073E-04,-.1587E-04,-.3022E-05,0.5785E-05/
5582 data ( ( coeh2o_2_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
5583 &-.4596E+02,-.2279E+02,-.1864E+02,-.1594E+02,-.1336E+02,-.1074E+02, &
5584 &-.9509E+01,-.9178E+01,-.8577E+01,-.7633E+01,-.6165E+01,-.3864E+01, &
5585 &-.4596E+02,-.2233E+02,-.1818E+02,-.1549E+02,-.1296E+02,-.1049E+02, &
5586 &-.9317E+01,-.9003E+01,-.8437E+01,-.7522E+01,-.6104E+01,-.3846E+01, &
5587 &-.4596E+02,-.2187E+02,-.1772E+02,-.1503E+02,-.1256E+02,-.1022E+02, &
5588 &-.9105E+01,-.8800E+01,-.8267E+01,-.7388E+01,-.6024E+01,-.3818E+01, &
5589 &-.4596E+02,-.2141E+02,-.1726E+02,-.1458E+02,-.1216E+02,-.9934E+01, &
5590 &-.8875E+01,-.8592E+01,-.8070E+01,-.7231E+01,-.5905E+01,-.3772E+01, &
5591 &-.4596E+02,-.2095E+02,-.1680E+02,-.1412E+02,-.1177E+02,-.9636E+01, &
5592 &-.8631E+01,-.8362E+01,-.7849E+01,-.7055E+01,-.5789E+01,-.3683E+01, &
5593 &-.4596E+02,-.2049E+02,-.1634E+02,-.1368E+02,-.1139E+02,-.9329E+01, &
5594 &-.8381E+01,-.8118E+01,-.7629E+01,-.6865E+01,-.5673E+01,-.3663E+01, &
5595 &-.4596E+02,-.2003E+02,-.1589E+02,-.1324E+02,-.1103E+02,-.9034E+01, &
5596 &-.8126E+01,-.7881E+01,-.7413E+01,-.6661E+01,-.5548E+01,-.3604E+01, &
5597 &-.4596E+02,-.1957E+02,-.1543E+02,-.1282E+02,-.1068E+02,-.8753E+01, &
5598 &-.7877E+01,-.7639E+01,-.7194E+01,-.6462E+01,-.5431E+01,-.3559E+01, &
5599 &-.4596E+02,-.1911E+02,-.1498E+02,-.1242E+02,-.1035E+02,-.8478E+01, &
5600 &-.7651E+01,-.7421E+01,-.6991E+01,-.6320E+01,-.5337E+01,-.3544E+01, &
5601 &-.4596E+02,-.1864E+02,-.1455E+02,-.1205E+02,-.1006E+02,-.8228E+01, &
5602 &-.7446E+01,-.7227E+01,-.6820E+01,-.6193E+01,-.5246E+01,-.3590E+01, &
5603 &-.4596E+02,-.1818E+02,-.1415E+02,-.1173E+02,-.9797E+01,-.8011E+01, &
5604 &-.7262E+01,-.7069E+01,-.6690E+01,-.6085E+01,-.5139E+01,-.3699E+01/
5605 data ( ( coeh2o_2_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
5606 &-.1547E-04,0.5600E-02,0.2620E-02,0.7216E-03,0.2127E-02,0.4178E-02, &
5607 &0.4942E-02,0.5022E-02,0.4865E-02,0.4364E-02,0.3928E-02,0.2032E-02, &
5608 &-.1547E-04,0.5585E-02,0.2619E-02,0.7277E-03,0.1927E-02,0.3428E-02, &
5609 &0.4165E-02,0.4110E-02,0.3921E-02,0.3774E-02,0.3313E-02,0.1773E-02, &
5610 &-.1547E-04,0.5600E-02,0.2626E-02,0.7344E-03,0.1729E-02,0.2840E-02, &
5611 &0.3350E-02,0.3289E-02,0.3081E-02,0.3093E-02,0.2778E-02,0.1820E-02, &
5612 &-.1547E-04,0.5601E-02,0.2635E-02,0.7589E-03,0.1535E-02,0.2250E-02, &
5613 &0.2581E-02,0.2472E-02,0.2365E-02,0.2492E-02,0.2252E-02,0.1356E-02, &
5614 &-.1547E-04,0.5600E-02,0.2643E-02,0.8161E-03,0.1329E-02,0.1773E-02, &
5615 &0.1904E-02,0.1792E-02,0.1826E-02,0.1918E-02,0.1714E-02,0.1239E-02, &
5616 &-.1547E-04,0.5601E-02,0.2663E-02,0.8765E-03,0.1206E-02,0.1293E-02, &
5617 &0.1344E-02,0.1350E-02,0.1367E-02,0.1310E-02,0.1119E-02,0.8026E-03, &
5618 &-.1547E-04,0.5585E-02,0.2695E-02,0.9617E-03,0.1197E-02,0.9559E-03, &
5619 &0.1008E-02,0.9791E-03,0.9892E-03,0.7806E-03,0.6872E-03,0.3329E-03, &
5620 &-.1547E-04,0.5602E-02,0.2762E-02,0.1039E-02,0.1277E-02,0.7514E-03, &
5621 &0.8401E-03,0.8117E-03,0.6529E-03,0.5337E-03,0.3562E-03,-.8344E-04, &
5622 &-.1547E-04,0.5613E-02,0.2901E-02,0.1132E-02,0.1326E-02,0.6222E-03, &
5623 &0.6984E-03,0.6159E-03,0.5078E-03,0.4187E-03,0.2222E-03,-.2135E-04, &
5624 &-.5341E-05,0.5806E-02,0.3142E-02,0.1240E-02,0.1435E-02,0.5730E-03, &
5625 &0.5152E-03,0.5664E-03,0.3897E-03,0.2327E-03,0.6928E-04,-.1874E-03, &
5626 &-.1214E-05,0.5878E-02,0.3387E-02,0.1470E-02,0.1494E-02,0.6158E-03, &
5627 &0.3543E-03,0.4093E-03,0.3208E-03,0.1312E-03,0.2899E-04,0.3038E-04/
5628 data ( ( coeh2o_2_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
5629 &-.9206E-07,-.2814E-04,-.1404E-04,-.5340E-05,-.6889E-05,-.3128E-05, &
5630 &-.2556E-05,-.3281E-05,-.2707E-05,-.5780E-05,-.9518E-05,0.8739E-05, &
5631 &-.9206E-07,-.2836E-04,-.1414E-04,-.5943E-05,-.6749E-05,-.1934E-05, &
5632 &-.1748E-05,-.3216E-05,0.1165E-05,-.5499E-05,-.6411E-05,0.8325E-05, &
5633 &-.9206E-07,-.2806E-04,-.1418E-04,-.6399E-05,-.6072E-05,-.2554E-06, &
5634 &0.5296E-06,-.3495E-05,0.1765E-05,-.2036E-05,-.9355E-06,0.4405E-05, &
5635 &-.9206E-07,-.2803E-04,-.1418E-04,-.6912E-05,-.5556E-05,0.3016E-05, &
5636 &-.5880E-07,0.1122E-05,0.2206E-05,-.1350E-05,-.4414E-05,-.9245E-06, &
5637 &-.9206E-07,-.2827E-04,-.1435E-04,-.7685E-05,-.5245E-05,0.3400E-05, &
5638 &0.5464E-06,0.6018E-06,-.9525E-06,0.2221E-05,-.1612E-05,-.1015E-04, &
5639 &-.9206E-07,-.2811E-04,-.1466E-04,-.7855E-05,-.2958E-05,0.2385E-05, &
5640 &0.3030E-06,-.2801E-06,0.1434E-05,0.4181E-05,0.1494E-05,0.2618E-05, &
5641 &-.9206E-07,-.2846E-04,-.1513E-04,-.7776E-05,-.4817E-06,0.1369E-05, &
5642 &-.8504E-06,0.5702E-06,0.2181E-05,0.1196E-05,0.8812E-07,0.7878E-06, &
5643 &-.9206E-07,-.2815E-04,-.1581E-04,-.7683E-05,-.1405E-05,0.2806E-05, &
5644 &-.1846E-05,0.8688E-06,0.2422E-05,-.4146E-05,-.1866E-06,0.3171E-05, &
5645 &-.9206E-07,-.2826E-04,-.1619E-04,-.7683E-05,-.6600E-06,-.9242E-06, &
5646 &0.1720E-05,0.1522E-06,0.4729E-09,-.4315E-06,-.1367E-05,0.3501E-05, &
5647 &-.3279E-07,-.2706E-04,-.1617E-04,-.6712E-05,-.6983E-07,-.1014E-05, &
5648 &0.1544E-05,0.4504E-06,-.8275E-06,-.8392E-06,0.4323E-05,0.1294E-05, &
5649 &-.1702E-07,-.2656E-04,-.1525E-04,-.6871E-05,-.9906E-06,-.2592E-05, &
5650 &0.6030E-06,0.1797E-05,0.1264E-05,-.1128E-05,0.3285E-05,-.3950E-06/
5652 ! block data ckd3_new
5653 !c *********************************************************************
5654 !c hk is the interval in the g (cumulative probability) space from 0
5655 !c to one. coeh2o is the coefficient to calculate the H2O absorption
5656 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
5657 !c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
5658 !c spectral region is from 7700 to 5250 cm**-1.
5659 !c in this block data, Z.F. has added the coefficients for water vapor
5660 !c continuum absorption in Jun,2003.
5661 !c *********************************************************************
5662 ! common /band3_new/ hk(12), coehh32(3,11,12),coeh2o(3,11,12)
5663 real hk_3_new(12), coehh32_3_new(3,11,12),coeh2o_3_new(3,11,12)
5664 data hk_3_new / .34, .11, .1, .09, .12, .1, &
5665 & .06, .04, .026, .01, .0035, .0005 /
5666 ! .509474E+02 .164830E+02 .149845E+02 .134861E+02 .179814E+02
5667 ! .149845E+02 .899071E+01 .599381E+01 .389597E+01 .149845E+01
5668 ! .524458E+00 .749226E-01
5669 data ( ( coehh32_3_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
5670 &-.1140E+02,-.7525E+01,-.5814E+01,-.4555E+01,-.3175E+01,-.1977E+01, &
5671 &-.7382E+00,0.5912E+00,0.2334E+01,0.4617E+01,0.7094E+01,0.9666E+01, &
5672 &-.1094E+02,-.7078E+01,-.5382E+01,-.4132E+01,-.2755E+01,-.1568E+01, &
5673 &-.3533E+00,0.9220E+00,0.2592E+01,0.4754E+01,0.7102E+01,0.9641E+01, &
5674 &-.1048E+02,-.6629E+01,-.4948E+01,-.3712E+01,-.2330E+01,-.1149E+01, &
5675 &0.3496E-01,0.1275E+01,0.2866E+01,0.4924E+01,0.7135E+01,0.9589E+01, &
5676 &-.1002E+02,-.6183E+01,-.4512E+01,-.3288E+01,-.1907E+01,-.7307E+00, &
5677 &0.4287E+00,0.1624E+01,0.3172E+01,0.5106E+01,0.7176E+01,0.9479E+01, &
5678 &-.9558E+01,-.5743E+01,-.4084E+01,-.2869E+01,-.1483E+01,-.3089E+00, &
5679 &0.8212E+00,0.1986E+01,0.3462E+01,0.5289E+01,0.7259E+01,0.9382E+01, &
5680 &-.9098E+01,-.5309E+01,-.3658E+01,-.2454E+01,-.1062E+01,0.1055E+00, &
5681 &0.1213E+01,0.2328E+01,0.3752E+01,0.5488E+01,0.7330E+01,0.9255E+01, &
5682 &-.8641E+01,-.4890E+01,-.3242E+01,-.2047E+01,-.6454E+00,0.5097E+00, &
5683 &0.1591E+01,0.2676E+01,0.4022E+01,0.5656E+01,0.7384E+01,0.9047E+01, &
5684 &-.8181E+01,-.4477E+01,-.2827E+01,-.1641E+01,-.2362E+00,0.9046E+00, &
5685 &0.1957E+01,0.3004E+01,0.4284E+01,0.5793E+01,0.7383E+01,0.8799E+01, &
5686 &-.7728E+01,-.4082E+01,-.2422E+01,-.1241E+01,0.1437E+00,0.1289E+01, &
5687 &0.2302E+01,0.3309E+01,0.4496E+01,0.5935E+01,0.7325E+01,0.8520E+01, &
5688 &-.7281E+01,-.3706E+01,-.2027E+01,-.8608E+00,0.4995E+00,0.1652E+01, &
5689 &0.2638E+01,0.3588E+01,0.4673E+01,0.6047E+01,0.7160E+01,0.8173E+01, &
5690 &-.6853E+01,-.3338E+01,-.1666E+01,-.5031E+00,0.8245E+00,0.2002E+01, &
5691 &0.2935E+01,0.3822E+01,0.4822E+01,0.6086E+01,0.7027E+01,0.7818E+01/
5692 data ( ( coehh32_3_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
5693 &-.7679E-02,0.3238E-02,0.2987E-02,0.4249E-02,0.2901E-02,0.2167E-02, &
5694 &0.2925E-02,0.4139E-02,0.4569E-02,0.4988E-02,0.2235E-02,-.2988E-02, &
5695 &-.7672E-02,0.3240E-02,0.2947E-02,0.4053E-02,0.2792E-02,0.1865E-02, &
5696 &0.2479E-02,0.3235E-02,0.3444E-02,0.3847E-02,0.2077E-02,-.2416E-02, &
5697 &-.7657E-02,0.3285E-02,0.2898E-02,0.3815E-02,0.2685E-02,0.1547E-02, &
5698 &0.1957E-02,0.2503E-02,0.2512E-02,0.2851E-02,0.1523E-02,-.2436E-02, &
5699 &-.7653E-02,0.3272E-02,0.2828E-02,0.3586E-02,0.2559E-02,0.1270E-02, &
5700 &0.1506E-02,0.1783E-02,0.1874E-02,0.1916E-02,0.6173E-03,-.2229E-02, &
5701 &-.7644E-02,0.3255E-02,0.2799E-02,0.3353E-02,0.2412E-02,0.1022E-02, &
5702 &0.1142E-02,0.1176E-02,0.1232E-02,0.7776E-03,0.5063E-03,-.1687E-02, &
5703 &-.7629E-02,0.3208E-02,0.2691E-02,0.3142E-02,0.2284E-02,0.8112E-03, &
5704 &0.8972E-03,0.8189E-03,0.1037E-02,0.2834E-03,0.2208E-03,-.1248E-02, &
5705 &-.7609E-02,0.3139E-02,0.2643E-02,0.2867E-02,0.2195E-02,0.6214E-03, &
5706 &0.6478E-03,0.4260E-03,0.6003E-03,0.1406E-03,-.3815E-03,-.1049E-02, &
5707 &-.7565E-02,0.3033E-02,0.2552E-02,0.2605E-02,0.2090E-02,0.4360E-03, &
5708 &0.4645E-03,0.1280E-03,0.1882E-03,-.1575E-03,-.2542E-03,-.1080E-02, &
5709 &-.7502E-02,0.2877E-02,0.2437E-02,0.2260E-02,0.2037E-02,0.2618E-03, &
5710 &0.2812E-03,0.3817E-05,-.6310E-04,-.4294E-03,-.3730E-03,-.9895E-03, &
5711 &-.7360E-02,0.2690E-02,0.2325E-02,0.1874E-02,0.2181E-02,0.1173E-03, &
5712 &0.1688E-03,-.1824E-03,-.2441E-03,-.4165E-03,-.5805E-03,-.1071E-02, &
5713 &-.7419E-02,0.2390E-02,0.2052E-02,0.1433E-02,0.2322E-02,-.5471E-04, &
5714 &-.8958E-04,-.4855E-03,-.4562E-03,-.2567E-03,-.5348E-03,-.1002E-02/
5715 data ( ( coehh32_3_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
5716 &0.9895E-04,0.1450E-04,0.5622E-05,0.5376E-05,-.8133E-05,0.5208E-05, &
5717 &0.7027E-05,0.4079E-05,0.6760E-05,0.6037E-05,-.2982E-04,0.1999E-04, &
5718 &0.9861E-04,0.1400E-04,0.7647E-05,0.5797E-05,-.9515E-05,0.6399E-05, &
5719 &0.4014E-05,0.4009E-05,0.5595E-05,0.8374E-05,-.2634E-04,0.3155E-05, &
5720 &0.9873E-04,0.1548E-04,0.9527E-05,0.7551E-05,-.1049E-04,0.5886E-05, &
5721 &0.2869E-05,0.1650E-05,0.2065E-05,0.3039E-05,-.1560E-04,0.1586E-05, &
5722 &0.9865E-04,0.1597E-04,0.9778E-05,0.8495E-05,-.1036E-04,0.5484E-05, &
5723 &0.1870E-05,0.3864E-05,-.4029E-05,0.6126E-05,0.3827E-06,0.6381E-05, &
5724 &0.9837E-04,0.1728E-04,0.1055E-04,0.1035E-04,-.9879E-05,0.3760E-05, &
5725 &0.1997E-05,0.7611E-06,-.2375E-05,0.5047E-05,0.4114E-05,0.5342E-05, &
5726 &0.9825E-04,0.1851E-04,0.1077E-04,0.1276E-04,-.1006E-04,0.4149E-05, &
5727 &0.7659E-07,0.4621E-05,-.5107E-05,-.8457E-07,-.5272E-05,-.9818E-05, &
5728 &0.9775E-04,0.2145E-04,0.1051E-04,0.1497E-04,-.1139E-04,0.4828E-05, &
5729 &0.6559E-07,0.1238E-05,-.3051E-06,0.1022E-05,-.7287E-05,-.1105E-05, &
5730 &0.9753E-04,0.2363E-04,0.9890E-05,0.1762E-04,-.1153E-04,0.4872E-05, &
5731 &0.6813E-06,0.1176E-05,-.1294E-05,0.5104E-05,-.3532E-05,0.1211E-05, &
5732 &0.9744E-04,0.2527E-04,0.9979E-05,0.1488E-04,-.7563E-05,0.2296E-05, &
5733 &0.1495E-05,0.3083E-05,-.1193E-05,-.2592E-05,-.2489E-05,-.1576E-05, &
5734 &0.9857E-04,0.2671E-04,0.7247E-05,0.1459E-04,-.7584E-05,0.3192E-05, &
5735 &0.9343E-06,0.2911E-05,0.6984E-06,-.3093E-05,0.7175E-05,0.1806E-05, &
5736 &0.9841E-04,0.2755E-04,0.6758E-05,0.1372E-04,-.8803E-05,0.2412E-05, &
5737 &0.2694E-05,0.2623E-05,0.1088E-05,-.2540E-05,0.2750E-05,0.5326E-05/
5738 data ( ( coeh2o_3_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
5739 &-.1960E+02,-.1506E+02,-.1330E+02,-.1196E+02,-.1062E+02,-.9237E+01, &
5740 &-.7918E+01,-.6564E+01,-.4814E+01,-.2530E+01,-.4914E-01,0.2527E+01, &
5741 &-.1914E+02,-.1462E+02,-.1287E+02,-.1154E+02,-.1020E+02,-.8835E+01, &
5742 &-.7538E+01,-.6234E+01,-.4559E+01,-.2391E+01,-.3750E-01,0.2503E+01, &
5743 &-.1868E+02,-.1417E+02,-.1243E+02,-.1112E+02,-.9776E+01,-.8422E+01, &
5744 &-.7149E+01,-.5884E+01,-.4283E+01,-.2223E+01,-.9588E-02,0.2436E+01, &
5745 &-.1822E+02,-.1372E+02,-.1200E+02,-.1070E+02,-.9358E+01,-.8009E+01, &
5746 &-.6756E+01,-.5535E+01,-.3976E+01,-.2055E+01,0.3032E-01,0.2334E+01, &
5747 &-.1776E+02,-.1328E+02,-.1157E+02,-.1028E+02,-.8937E+01,-.7592E+01, &
5748 &-.6369E+01,-.5176E+01,-.3687E+01,-.1860E+01,0.1086E+00,0.2239E+01, &
5749 &-.1730E+02,-.1285E+02,-.1115E+02,-.9859E+01,-.8522E+01,-.7183E+01, &
5750 &-.5983E+01,-.4832E+01,-.3403E+01,-.1658E+01,0.1877E+00,0.2117E+01, &
5751 &-.1684E+02,-.1243E+02,-.1074E+02,-.9457E+01,-.8110E+01,-.6787E+01, &
5752 &-.5607E+01,-.4489E+01,-.3131E+01,-.1493E+01,0.2193E+00,0.1909E+01, &
5753 &-.1638E+02,-.1203E+02,-.1034E+02,-.9054E+01,-.7703E+01,-.6400E+01, &
5754 &-.5251E+01,-.4168E+01,-.2872E+01,-.1353E+01,0.2209E+00,0.1654E+01, &
5755 &-.1593E+02,-.1165E+02,-.9951E+01,-.8662E+01,-.7319E+01,-.6031E+01, &
5756 &-.4908E+01,-.3864E+01,-.2661E+01,-.1215E+01,0.1747E+00,0.1373E+01, &
5757 &-.1548E+02,-.1129E+02,-.9578E+01,-.8296E+01,-.6966E+01,-.5686E+01, &
5758 &-.4591E+01,-.3591E+01,-.2486E+01,-.1100E+01,0.9648E-02,0.1023E+01, &
5759 &-.1505E+02,-.1095E+02,-.9232E+01,-.7959E+01,-.6652E+01,-.5370E+01, &
5760 &-.4311E+01,-.3366E+01,-.2341E+01,-.1065E+01,-.1163E+00,0.6636E+00/
5761 data ( ( coeh2o_3_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
5762 &0.1080E-01,0.8671E-02,0.6771E-02,0.6413E-02,0.4659E-02,0.3332E-02, &
5763 &0.3277E-02,0.4236E-02,0.4596E-02,0.4920E-02,0.2400E-02,-.2756E-02, &
5764 &0.1081E-01,0.8741E-02,0.6754E-02,0.6296E-02,0.4472E-02,0.3015E-02, &
5765 &0.2806E-02,0.3375E-02,0.3436E-02,0.3821E-02,0.2081E-02,-.2471E-02, &
5766 &0.1081E-01,0.8808E-02,0.6738E-02,0.6140E-02,0.4280E-02,0.2661E-02, &
5767 &0.2328E-02,0.2561E-02,0.2459E-02,0.2849E-02,0.1478E-02,-.2399E-02, &
5768 &0.1082E-01,0.8903E-02,0.6681E-02,0.5968E-02,0.4090E-02,0.2404E-02, &
5769 &0.1916E-02,0.1893E-02,0.1906E-02,0.1952E-02,0.5999E-03,-.2229E-02, &
5770 &0.1083E-01,0.8941E-02,0.6605E-02,0.5787E-02,0.3912E-02,0.2213E-02, &
5771 &0.1585E-02,0.1285E-02,0.1237E-02,0.7659E-03,0.4732E-03,-.1905E-02, &
5772 &0.1084E-01,0.8980E-02,0.6585E-02,0.5613E-02,0.3766E-02,0.2044E-02, &
5773 &0.1267E-02,0.9222E-03,0.1021E-02,0.2873E-03,0.1324E-03,-.1448E-02, &
5774 &0.1086E-01,0.9037E-02,0.6487E-02,0.5388E-02,0.3604E-02,0.1876E-02, &
5775 &0.1078E-02,0.6028E-03,0.6251E-03,0.1348E-03,-.4624E-03,-.1049E-02, &
5776 &0.1090E-01,0.9083E-02,0.6433E-02,0.5211E-02,0.3471E-02,0.1746E-02, &
5777 &0.9677E-03,0.3372E-03,0.2223E-03,-.1395E-03,-.1094E-03,-.1187E-02, &
5778 &0.1099E-01,0.9106E-02,0.6376E-02,0.4992E-02,0.3354E-02,0.1630E-02, &
5779 &0.7864E-03,0.2293E-03,0.3187E-04,-.3573E-03,-.3777E-03,-.1101E-02, &
5780 &0.1134E-01,0.9243E-02,0.6320E-02,0.4852E-02,0.3349E-02,0.1655E-02, &
5781 &0.7483E-03,0.2039E-04,-.1645E-03,-.4325E-03,-.5380E-03,-.1237E-02, &
5782 &0.1151E-01,0.9333E-02,0.6267E-02,0.4616E-02,0.3376E-02,0.1607E-02, &
5783 &0.6461E-03,-.2321E-03,-.3088E-03,-.2537E-03,-.5030E-03,-.1011E-02/
5784 data ( ( coeh2o_3_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
5785 &-.2773E-04,-.3392E-04,-.2223E-04,-.1340E-04,-.6529E-05,-.1665E-06, &
5786 &0.4989E-05,0.3707E-05,0.6941E-05,0.6886E-05,-.3258E-04,0.1605E-04, &
5787 &-.2813E-04,-.3300E-04,-.2007E-04,-.1154E-04,-.7740E-05,0.6775E-06, &
5788 &0.2897E-05,0.3420E-05,0.6556E-05,0.5507E-05,-.2749E-04,0.2148E-05, &
5789 &-.2809E-04,-.3275E-04,-.1888E-04,-.1024E-04,-.7943E-05,-.3963E-06, &
5790 &0.2122E-06,0.2035E-05,0.2235E-05,0.3933E-05,-.1529E-04,0.5763E-05, &
5791 &-.2800E-04,-.3250E-04,-.1684E-04,-.9307E-05,-.8034E-05,-.1375E-05, &
5792 &-.2132E-05,0.2970E-05,-.4042E-05,0.9740E-05,0.2458E-05,0.8648E-05, &
5793 &-.2806E-04,-.3208E-04,-.1568E-04,-.9145E-05,-.8411E-05,-.3020E-05, &
5794 &-.1413E-05,0.9127E-07,-.3237E-05,0.3945E-05,0.5646E-05,0.2986E-05, &
5795 &-.2830E-04,-.3068E-04,-.1482E-04,-.8674E-05,-.8443E-05,-.3934E-05, &
5796 &-.1612E-05,0.2413E-05,-.3550E-05,-.6469E-06,-.5963E-05,-.1346E-04, &
5797 &-.2883E-04,-.3028E-04,-.1561E-04,-.6705E-05,-.1033E-04,-.3342E-05, &
5798 &-.3678E-05,0.1166E-07,0.1137E-06,0.1105E-05,-.2647E-06,-.1105E-05, &
5799 &-.2925E-04,-.2750E-04,-.1669E-04,-.5725E-05,-.1279E-04,-.3634E-05, &
5800 &-.2847E-05,0.7495E-06,-.6587E-06,0.3086E-05,0.7682E-06,0.1455E-05, &
5801 &-.2996E-04,-.2666E-04,-.1496E-04,-.7764E-05,-.1307E-04,-.5851E-05, &
5802 &-.2315E-05,0.1180E-05,-.1360E-05,-.3718E-05,-.1349E-06,-.1873E-05, &
5803 &-.2948E-04,-.2562E-04,-.1348E-04,-.7023E-05,-.1216E-04,-.7633E-05, &
5804 &-.2033E-05,0.1950E-05,-.6272E-06,-.3702E-05,0.5905E-05,0.1447E-05, &
5805 &-.2863E-04,-.2574E-04,-.1508E-04,-.7480E-05,-.1153E-04,-.7744E-05, &
5806 &0.9411E-06,0.1926E-05,0.1190E-05,-.2848E-05,-.1600E-05,0.9887E-05/
5808 ! block data ckd4_new
5809 !c *********************************************************************
5810 !c hk is the interval in the g (cumulative probability) space from 0
5811 !c to one. coeh2o is the coefficient to calculate the H2O absorption
5812 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
5813 !c pressures, and seven cumulative probabilities ( Fu, 1991 ). The
5814 !c spectral region is from 5250 to 4000 cm**-1.
5815 !c in this block data, Z.F. has added the coefficients for CO2, CO, and
5816 !c water vapor continuum absorption in Jun,2003.
5817 !c *********************************************************************
5818 ! common /band4_new/hk(20),coehh42(3,11,20),coeco2(3,11,20),coeco(3,11) &
5819 ! ,coeh2o(3,11,20)
5820 real hk_4_new(20),coehh42_4_new(3,11,20),coeco2_4_new(3,11,20), &
5821 & coeco_4_new(3,11),coeh2o_4_new(3,11,20)
5822 data hk_4_new /8.13791E-02,0.171362,0.222259,0.222259,0.171362, &
5823 & 8.13791E-02,8.77986E-04,2.00395E-03,3.03796E-03, &
5824 & 3.93008E-03,4.63846E-03,5.12996E-03,5.38160E-03, &
5825 & 5.38160E-03,5.12996E-03,4.63846E-03,3.93008E-03, &
5826 & 3.03796E-03,2.00395E-03,8.77986E-04/
5827 data ( ( coehh42_4_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
5828 &-.1059E+02,-.1006E+02,-.9085E+01,-.6921E+01,-.4346E+01,-.2053E+01, &
5829 &-.9700E+00,-.9080E+00,-.7921E+00,-.6280E+00,-.4134E+00,-.1395E+00, &
5830 &0.2112E+00,0.6492E+00,0.1147E+01,0.1906E+01,0.2740E+01,0.4002E+01, &
5831 &0.5611E+01,0.8101E+01,-.1013E+02,-.9606E+01,-.8628E+01,-.6482E+01, &
5832 &-.3962E+01,-.1702E+01,-.6681E+00,-.6004E+00,-.4818E+00,-.3260E+00, &
5833 &-.1152E+00,0.1656E+00,0.5207E+00,0.9282E+00,0.1430E+01,0.2159E+01, &
5834 &0.3014E+01,0.4178E+01,0.5686E+01,0.8104E+01,-.9666E+01,-.9143E+01, &
5835 &-.8166E+01,-.6042E+01,-.3563E+01,-.1337E+01,-.3297E+00,-.2723E+00, &
5836 &-.1627E+00,-.2127E-02,0.2080E+00,0.5053E+00,0.8329E+00,0.1248E+01, &
5837 &0.1737E+01,0.2409E+01,0.3242E+01,0.4307E+01,0.5759E+01,0.8158E+01, &
5838 &-.9206E+01,-.8682E+01,-.7706E+01,-.5605E+01,-.3170E+01,-.9765E+00, &
5839 &0.1098E-01,0.6984E-01,0.1728E+00,0.3387E+00,0.5600E+00,0.8342E+00, &
5840 &0.1168E+01,0.1573E+01,0.2072E+01,0.2687E+01,0.3461E+01,0.4470E+01, &
5841 &0.5823E+01,0.8122E+01,-.8745E+01,-.8222E+01,-.7248E+01,-.5174E+01, &
5842 &-.2782E+01,-.6221E+00,0.3791E+00,0.4282E+00,0.5328E+00,0.6929E+00, &
5843 &0.9055E+00,0.1170E+01,0.1504E+01,0.1920E+01,0.2403E+01,0.2953E+01, &
5844 &0.3729E+01,0.4647E+01,0.5941E+01,0.8096E+01,-.8285E+01,-.7761E+01, &
5845 &-.6793E+01,-.4753E+01,-.2395E+01,-.2536E+00,0.7605E+00,0.8090E+00, &
5846 &0.8938E+00,0.1037E+01,0.1244E+01,0.1517E+01,0.1851E+01,0.2249E+01, &
5847 &0.2719E+01,0.3207E+01,0.3958E+01,0.4861E+01,0.6126E+01,0.7980E+01, &
5848 &-.7826E+01,-.7305E+01,-.6349E+01,-.4348E+01,-.2028E+01,0.1151E+00, &
5849 &0.1104E+01,0.1158E+01,0.1256E+01,0.1394E+01,0.1591E+01,0.1872E+01, &
5850 &0.2188E+01,0.2554E+01,0.2989E+01,0.3500E+01,0.4182E+01,0.5051E+01, &
5851 &0.6259E+01,0.7866E+01,-.7365E+01,-.6844E+01,-.5906E+01,-.3946E+01, &
5852 &-.1673E+01,0.4781E+00,0.1462E+01,0.1516E+01,0.1610E+01,0.1743E+01, &
5853 &0.1925E+01,0.2178E+01,0.2482E+01,0.2837E+01,0.3242E+01,0.3751E+01, &
5854 &0.4390E+01,0.5180E+01,0.6277E+01,0.7674E+01,-.6905E+01,-.6387E+01, &
5855 &-.5476E+01,-.3556E+01,-.1344E+01,0.8318E+00,0.1780E+01,0.1837E+01, &
5856 &0.1933E+01,0.2066E+01,0.2228E+01,0.2448E+01,0.2739E+01,0.3084E+01, &
5857 &0.3495E+01,0.4001E+01,0.4558E+01,0.5315E+01,0.6291E+01,0.7482E+01, &
5858 &-.6446E+01,-.5933E+01,-.5061E+01,-.3187E+01,-.1022E+01,0.1175E+01, &
5859 &0.2044E+01,0.2096E+01,0.2201E+01,0.2341E+01,0.2497E+01,0.2705E+01, &
5860 &0.2967E+01,0.3307E+01,0.3735E+01,0.4209E+01,0.4730E+01,0.5379E+01, &
5861 &0.6225E+01,0.7265E+01,-.5998E+01,-.5485E+01,-.4650E+01,-.2856E+01, &
5862 &-.7081E+00,0.1480E+01,0.2292E+01,0.2343E+01,0.2434E+01,0.2565E+01, &
5863 &0.2745E+01,0.2947E+01,0.3206E+01,0.3521E+01,0.3911E+01,0.4372E+01, &
5864 &0.4866E+01,0.5390E+01,0.6151E+01,0.6998E+01/
5865 data ( ( coehh42_4_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
5866 &-.1686E-01,-.1495E-01,-.6958E-02,0.1929E-02,0.6756E-02,0.6773E-02, &
5867 &0.7527E-02,0.7564E-02,0.7523E-02,0.7354E-02,0.7233E-02,0.7332E-02, &
5868 &0.7428E-02,0.7961E-02,0.8650E-02,0.8533E-02,0.9158E-02,0.8485E-02, &
5869 &0.9356E-02,0.7225E-02,-.1686E-01,-.1497E-01,-.6942E-02,0.1907E-02, &
5870 &0.6514E-02,0.6267E-02,0.6897E-02,0.6977E-02,0.7040E-02,0.6954E-02, &
5871 &0.6723E-02,0.6728E-02,0.7165E-02,0.7471E-02,0.7648E-02,0.7649E-02, &
5872 &0.8113E-02,0.6896E-02,0.8976E-02,0.6126E-02,-.1686E-01,-.1495E-01, &
5873 &-.6923E-02,0.1859E-02,0.6233E-02,0.5923E-02,0.6185E-02,0.6298E-02, &
5874 &0.6495E-02,0.6609E-02,0.6545E-02,0.6524E-02,0.6819E-02,0.6764E-02, &
5875 &0.6654E-02,0.7157E-02,0.7238E-02,0.5959E-02,0.7561E-02,0.4312E-02, &
5876 &-.1686E-01,-.1494E-01,-.6895E-02,0.1817E-02,0.5942E-02,0.5493E-02, &
5877 &0.6054E-02,0.6100E-02,0.6215E-02,0.6398E-02,0.6618E-02,0.6199E-02, &
5878 &0.6455E-02,0.6214E-02,0.5865E-02,0.6472E-02,0.6639E-02,0.5397E-02, &
5879 &0.6081E-02,0.5363E-02,-.1686E-01,-.1493E-01,-.6888E-02,0.1785E-02, &
5880 &0.5641E-02,0.5328E-02,0.5932E-02,0.5924E-02,0.5913E-02,0.6076E-02, &
5881 &0.6245E-02,0.6044E-02,0.5884E-02,0.5806E-02,0.5469E-02,0.5944E-02, &
5882 &0.5384E-02,0.4482E-02,0.4742E-02,0.4400E-02,-.1686E-01,-.1492E-01, &
5883 &-.6890E-02,0.1669E-02,0.5318E-02,0.5178E-02,0.5663E-02,0.5657E-02, &
5884 &0.5620E-02,0.5650E-02,0.5925E-02,0.5845E-02,0.5468E-02,0.5578E-02, &
5885 &0.5364E-02,0.5421E-02,0.4804E-02,0.4654E-02,0.5170E-02,0.4096E-02, &
5886 &-.1685E-01,-.1492E-01,-.6926E-02,0.1572E-02,0.5116E-02,0.5131E-02, &
5887 &0.5408E-02,0.5409E-02,0.5461E-02,0.5484E-02,0.5455E-02,0.5428E-02, &
5888 &0.5391E-02,0.5258E-02,0.4741E-02,0.4750E-02,0.4390E-02,0.4749E-02, &
5889 &0.4977E-02,0.3296E-02,-.1685E-01,-.1489E-01,-.6974E-02,0.1415E-02, &
5890 &0.4745E-02,0.5066E-02,0.5375E-02,0.5369E-02,0.5248E-02,0.5174E-02, &
5891 &0.5074E-02,0.5260E-02,0.5230E-02,0.4768E-02,0.4736E-02,0.4192E-02, &
5892 &0.4103E-02,0.4969E-02,0.4945E-02,0.4193E-02,-.1684E-01,-.1485E-01, &
5893 &-.7176E-02,0.1146E-02,0.4580E-02,0.4956E-02,0.5185E-02,0.5109E-02, &
5894 &0.5084E-02,0.4812E-02,0.4606E-02,0.4576E-02,0.4754E-02,0.4523E-02, &
5895 &0.4452E-02,0.3939E-02,0.4254E-02,0.4827E-02,0.4612E-02,0.3346E-02, &
5896 &-.1676E-01,-.1484E-01,-.7457E-02,0.9431E-03,0.4583E-02,0.4910E-02, &
5897 &0.4708E-02,0.4745E-02,0.4669E-02,0.4511E-02,0.4329E-02,0.4111E-02, &
5898 &0.4380E-02,0.4498E-02,0.4055E-02,0.4142E-02,0.4058E-02,0.4817E-02, &
5899 &0.4007E-02,0.4288E-02,-.1667E-01,-.1487E-01,-.7891E-02,0.5511E-03, &
5900 &0.4589E-02,0.4397E-02,0.3882E-02,0.3931E-02,0.4068E-02,0.4260E-02, &
5901 &0.4260E-02,0.3976E-02,0.3757E-02,0.3894E-02,0.4240E-02,0.4461E-02, &
5902 &0.4182E-02,0.4058E-02,0.3568E-02,0.3295E-02/
5903 data ( ( coehh42_4_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
5904 &0.8719E-05,0.3152E-04,0.9387E-04,0.2700E-04,0.5308E-05,-.7286E-05, &
5905 &-.9901E-05,-.1065E-04,-.1214E-04,-.1259E-04,-.6202E-05,-.3291E-05, &
5906 &-.8684E-05,-.7201E-05,0.8522E-05,-.1956E-04,0.4919E-05,-.2685E-04, &
5907 &-.2245E-04,-.4342E-04,0.8040E-05,0.3134E-04,0.9385E-04,0.2804E-04, &
5908 &0.9804E-05,-.6042E-05,0.2345E-05,-.7401E-06,-.5213E-05,-.4646E-05, &
5909 &-.4379E-05,-.6253E-05,-.1368E-04,-.8247E-05,0.1722E-05,-.2231E-04, &
5910 &-.1394E-04,-.2746E-04,-.3332E-04,-.3498E-04,0.8456E-05,0.3128E-04, &
5911 &0.9340E-04,0.2996E-04,0.8999E-05,-.5482E-05,0.3744E-05,0.3982E-05, &
5912 &0.1368E-05,-.1608E-05,-.3430E-05,-.1283E-04,-.1160E-04,-.1210E-04, &
5913 &-.1016E-06,-.1830E-04,-.9311E-05,-.2056E-04,-.2352E-04,-.2314E-04, &
5914 &0.8600E-05,0.3118E-04,0.9319E-04,0.3020E-04,0.1066E-04,-.5770E-05, &
5915 &0.2359E-05,0.2942E-05,0.3937E-05,-.2328E-05,-.7884E-05,-.1238E-04, &
5916 &-.8395E-05,-.1025E-04,-.1413E-04,-.1782E-04,-.2784E-05,-.1649E-04, &
5917 &-.7734E-05,-.2976E-04,0.8741E-05,0.3111E-04,0.9298E-04,0.3115E-04, &
5918 &0.1174E-04,-.1947E-05,-.5477E-05,-.6249E-06,0.1779E-05,-.1587E-05, &
5919 &-.6940E-05,-.7399E-05,-.6058E-05,-.1735E-04,-.2104E-04,-.7474E-05, &
5920 &-.1182E-04,-.6828E-05,-.4701E-06,-.4709E-04,0.8759E-05,0.3085E-04, &
5921 &0.9296E-04,0.3282E-04,0.1019E-04,-.3588E-05,-.1257E-04,-.9429E-05, &
5922 &-.2057E-05,0.7564E-06,-.2274E-05,-.8163E-05,-.1011E-04,-.1911E-04, &
5923 &-.2398E-04,0.7761E-05,-.1771E-04,-.2819E-04,-.2294E-04,-.2335E-04, &
5924 &0.8000E-05,0.3064E-04,0.9416E-04,0.3569E-04,0.1276E-04,-.4103E-05, &
5925 &-.1243E-04,-.1056E-04,-.7823E-05,-.2462E-05,-.1494E-05,-.1442E-04, &
5926 &-.1914E-04,-.1664E-04,-.1548E-04,-.6351E-05,-.2185E-04,-.2480E-04, &
5927 &-.3726E-04,-.2906E-04,0.8548E-05,0.3012E-04,0.9494E-04,0.3683E-04, &
5928 &0.1404E-04,-.3293E-05,-.1665E-04,-.1670E-04,-.1434E-04,-.9419E-05, &
5929 &-.6369E-05,-.1321E-04,-.1427E-04,-.1231E-04,-.6201E-05,-.9664E-05, &
5930 &-.2175E-04,-.1135E-04,-.3686E-04,-.2543E-04,0.8691E-05,0.2988E-04, &
5931 &0.9581E-04,0.3853E-04,0.1653E-04,-.3232E-05,-.1481E-04,-.1755E-04, &
5932 &-.1914E-04,-.1633E-04,-.7166E-05,-.5494E-05,-.1207E-04,-.9202E-05, &
5933 &-.1221E-04,-.2493E-04,-.1622E-04,-.1623E-04,-.2624E-04,-.2272E-04, &
5934 &0.1032E-04,0.2902E-04,0.9786E-04,0.4246E-04,0.2006E-04,-.7937E-05, &
5935 &-.1656E-05,-.4060E-05,-.1023E-04,-.1558E-04,-.8886E-05,-.6339E-05, &
5936 &-.6686E-05,-.1247E-04,-.2124E-04,-.2543E-04,-.1466E-04,-.1779E-04, &
5937 &-.1139E-04,-.1877E-04,0.1439E-04,0.2795E-04,0.9614E-04,0.4879E-04, &
5938 &0.2421E-04,-.4735E-05,0.2733E-05,0.8715E-06,-.2560E-05,-.8553E-05, &
5939 &-.1460E-04,-.1124E-04,-.1194E-04,-.1263E-04,-.9623E-05,-.1722E-04, &
5940 &-.2157E-04,-.1558E-04,-.1516E-04,-.1386E-04/
5941 data ( ( coeco2_4_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
5942 &-.4603E+02,-.4594E+02,-.2412E+02,-.1620E+02,-.1177E+02,-.9585E+01, &
5943 &-.8622E+01,-.8562E+01,-.8456E+01,-.8309E+01,-.8107E+01,-.7852E+01, &
5944 &-.7537E+01,-.7141E+01,-.6645E+01,-.5994E+01,-.5163E+01,-.4117E+01, &
5945 &-.2456E+01,-.3656E+00,-.4603E+02,-.4594E+02,-.2366E+02,-.1574E+02, &
5946 &-.1138E+02,-.9217E+01,-.8297E+01,-.8243E+01,-.8148E+01,-.8011E+01, &
5947 &-.7826E+01,-.7537E+01,-.7217E+01,-.6864E+01,-.6334E+01,-.5711E+01, &
5948 &-.4914E+01,-.3989E+01,-.2392E+01,-.3673E+00,-.4603E+02,-.4594E+02, &
5949 &-.2320E+02,-.1528E+02,-.1099E+02,-.8825E+01,-.7972E+01,-.7919E+01, &
5950 &-.7826E+01,-.7678E+01,-.7475E+01,-.7208E+01,-.6897E+01,-.6536E+01, &
5951 &-.6027E+01,-.5422E+01,-.4695E+01,-.3791E+01,-.2191E+01,-.4829E+00, &
5952 &-.4603E+02,-.4594E+02,-.2274E+02,-.1483E+02,-.1060E+02,-.8450E+01, &
5953 &-.7620E+01,-.7570E+01,-.7472E+01,-.7334E+01,-.7150E+01,-.6892E+01, &
5954 &-.6558E+01,-.6202E+01,-.5732E+01,-.5138E+01,-.4473E+01,-.3516E+01, &
5955 &-.1970E+01,-.4839E+00,-.4603E+02,-.4594E+02,-.2228E+02,-.1438E+02, &
5956 &-.1022E+02,-.8088E+01,-.7258E+01,-.7212E+01,-.7130E+01,-.6990E+01, &
5957 &-.6798E+01,-.6544E+01,-.6229E+01,-.5865E+01,-.5438E+01,-.4882E+01, &
5958 &-.4236E+01,-.3257E+01,-.1876E+01,-.4746E+00,-.4603E+02,-.4594E+02, &
5959 &-.2182E+02,-.1396E+02,-.9852E+01,-.7715E+01,-.6899E+01,-.6850E+01, &
5960 &-.6763E+01,-.6634E+01,-.6450E+01,-.6213E+01,-.5906E+01,-.5557E+01, &
5961 &-.5172E+01,-.4648E+01,-.3944E+01,-.2971E+01,-.1842E+01,-.5561E+00, &
5962 &-.4603E+02,-.4594E+02,-.2136E+02,-.1357E+02,-.9510E+01,-.7355E+01, &
5963 &-.6550E+01,-.6505E+01,-.6422E+01,-.6301E+01,-.6129E+01,-.5896E+01, &
5964 &-.5626E+01,-.5297E+01,-.4907E+01,-.4358E+01,-.3663E+01,-.2761E+01, &
5965 &-.1908E+01,-.7289E+00,-.4603E+02,-.4594E+02,-.2090E+02,-.1323E+02, &
5966 &-.9201E+01,-.6995E+01,-.6227E+01,-.6182E+01,-.6099E+01,-.5985E+01, &
5967 &-.5826E+01,-.5616E+01,-.5355E+01,-.5017E+01,-.4620E+01,-.4072E+01, &
5968 &-.3446E+01,-.2716E+01,-.2018E+01,-.9620E+00,-.4603E+02,-.4594E+02, &
5969 &-.2044E+02,-.1297E+02,-.8905E+01,-.6661E+01,-.5914E+01,-.5872E+01, &
5970 &-.5798E+01,-.5682E+01,-.5530E+01,-.5318E+01,-.5071E+01,-.4743E+01, &
5971 &-.4329E+01,-.3853E+01,-.3294E+01,-.2761E+01,-.2106E+01,-.1277E+01, &
5972 &-.4603E+02,-.4594E+02,-.1964E+02,-.1276E+02,-.8637E+01,-.6354E+01, &
5973 &-.5583E+01,-.5545E+01,-.5474E+01,-.5373E+01,-.5234E+01,-.5044E+01, &
5974 &-.4793E+01,-.4491E+01,-.4132E+01,-.3730E+01,-.3306E+01,-.2872E+01, &
5975 &-.2235E+01,-.1592E+01,-.4603E+02,-.4593E+02,-.1896E+02,-.1262E+02, &
5976 &-.8408E+01,-.6026E+01,-.5278E+01,-.5241E+01,-.5175E+01,-.5085E+01, &
5977 &-.4950E+01,-.4782E+01,-.4573E+01,-.4327E+01,-.4035E+01,-.3728E+01, &
5978 &-.3405E+01,-.3006E+01,-.2431E+01,-.2000E+01/
5979 data ( ( coeco2_4_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
5980 &-.4786E-05,-.2403E-04,0.2072E-01,0.9662E-02,0.8712E-02,0.5356E-02, &
5981 &0.5389E-02,0.5435E-02,0.5612E-02,0.5805E-02,0.6110E-02,0.6088E-02, &
5982 &0.5988E-02,0.5956E-02,0.5210E-02,0.5759E-02,0.6807E-02,0.6879E-02, &
5983 &0.4498E-02,0.8106E-03,-.4786E-05,-.2403E-04,0.2075E-01,0.9764E-02, &
5984 &0.8516E-02,0.4715E-02,0.4838E-02,0.4893E-02,0.4981E-02,0.5072E-02, &
5985 &0.5072E-02,0.5026E-02,0.5005E-02,0.4854E-02,0.4801E-02,0.4993E-02, &
5986 &0.5714E-02,0.5394E-02,0.2506E-02,0.5935E-03,-.4786E-05,-.2403E-04, &
5987 &0.2072E-01,0.9849E-02,0.8397E-02,0.4084E-02,0.4279E-02,0.4267E-02, &
5988 &0.4226E-02,0.4131E-02,0.4163E-02,0.4449E-02,0.3956E-02,0.4184E-02, &
5989 &0.4426E-02,0.4227E-02,0.4501E-02,0.3655E-02,0.6654E-03,0.2776E-03, &
5990 &-.4786E-05,-.2403E-04,0.2072E-01,0.9987E-02,0.8372E-02,0.3617E-02, &
5991 &0.3670E-02,0.3694E-02,0.3735E-02,0.3613E-02,0.3498E-02,0.3302E-02, &
5992 &0.3386E-02,0.3718E-02,0.3896E-02,0.3861E-02,0.3237E-02,0.1668E-02, &
5993 &0.2576E-03,0.3221E-03,-.4786E-05,-.2403E-04,0.2072E-01,0.1016E-01, &
5994 &0.8369E-02,0.3237E-02,0.3168E-02,0.3134E-02,0.3018E-02,0.2996E-02, &
5995 &0.2910E-02,0.3054E-02,0.3244E-02,0.3424E-02,0.3511E-02,0.3221E-02, &
5996 &0.2240E-02,0.9645E-03,-.3647E-03,-.1492E-04,-.4786E-05,-.2403E-04, &
5997 &0.2072E-01,0.1054E-01,0.8352E-02,0.2944E-02,0.2692E-02,0.2719E-02, &
5998 &0.2786E-02,0.2721E-02,0.2762E-02,0.2862E-02,0.3180E-02,0.2981E-02, &
5999 &0.2720E-02,0.1900E-02,0.8285E-03,-.1636E-03,-.4815E-03,0.2303E-03, &
6000 &-.4786E-05,-.2403E-04,0.2075E-01,0.1081E-01,0.8350E-02,0.2716E-02, &
6001 &0.2437E-02,0.2431E-02,0.2421E-02,0.2520E-02,0.2662E-02,0.2547E-02, &
6002 &0.2587E-02,0.2341E-02,0.1632E-02,0.8147E-03,0.3410E-03,-.1676E-03, &
6003 &-.1672E-03,0.9590E-03,-.4786E-05,-.2403E-04,0.2072E-01,0.1079E-01, &
6004 &0.8543E-02,0.2851E-02,0.1950E-02,0.1962E-02,0.1952E-02,0.1953E-02, &
6005 &0.1993E-02,0.2013E-02,0.1666E-02,0.1273E-02,0.7388E-03,-.1403E-03, &
6006 &-.2617E-03,0.2904E-03,-.7046E-04,0.8429E-03,-.4786E-05,-.2403E-04, &
6007 &0.2075E-01,0.1103E-01,0.8771E-02,0.2490E-02,0.1106E-02,0.1033E-02, &
6008 &0.1039E-02,0.1066E-02,0.1137E-02,0.9681E-03,0.7354E-03,0.3735E-03, &
6009 &-.1874E-03,-.3749E-03,-.3094E-04,0.4770E-03,0.2057E-03,0.6687E-03, &
6010 &-.8358E-05,-.4182E-04,0.2145E-01,0.1057E-01,0.9132E-02,0.1834E-02, &
6011 &0.3321E-03,0.3135E-03,0.2645E-03,0.1934E-03,0.2430E-03,0.2651E-03, &
6012 &0.5755E-04,-.2891E-03,-.2060E-03,0.1168E-04,0.1601E-03,0.4466E-03, &
6013 &0.4693E-03,0.1182E-02,-.5583E-05,-.2819E-04,0.2180E-01,0.1038E-01, &
6014 &0.9786E-02,0.1269E-02,-.5402E-04,-.1102E-03,-.2084E-03,-.3490E-03, &
6015 &-.3241E-03,-.3170E-03,-.2767E-03,-.1929E-03,0.8256E-04,0.2632E-03, &
6016 &0.3831E-03,0.7473E-04,0.8686E-03,0.1146E-02/
6017 data ( ( coeco2_4_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
6018 &0.1765E-07,0.9143E-07,-.1846E-03,0.8856E-05,-.3172E-04,0.1577E-04, &
6019 &0.5529E-05,0.4630E-05,0.4415E-05,0.1105E-04,0.1481E-04,0.1697E-04, &
6020 &0.2186E-04,0.2224E-04,0.1929E-04,0.1939E-04,0.8547E-05,-.3805E-05, &
6021 &-.2759E-04,0.4665E-05,0.1765E-07,0.9143E-07,-.1851E-03,0.7178E-05, &
6022 &-.2857E-04,0.1569E-04,0.1230E-04,0.1373E-04,0.1592E-04,0.2054E-04, &
6023 &0.2810E-04,0.1609E-04,0.1396E-04,0.1831E-04,0.1049E-04,0.8116E-05, &
6024 &-.8963E-05,0.2490E-04,0.1198E-04,-.1697E-05,0.1765E-07,0.9143E-07, &
6025 &-.1846E-03,0.6871E-05,-.2871E-04,0.8531E-05,0.2124E-04,0.2059E-04, &
6026 &0.2299E-04,0.2221E-04,0.2082E-04,0.1278E-04,0.6971E-05,0.1295E-04, &
6027 &0.6508E-05,0.4034E-05,0.2943E-05,0.2663E-04,0.4140E-05,0.9827E-05, &
6028 &0.1765E-07,0.9143E-07,-.1846E-03,0.5894E-05,-.2687E-04,0.8905E-05, &
6029 &0.2267E-04,0.2275E-04,0.1966E-04,0.2027E-04,0.2032E-04,0.9168E-05, &
6030 &0.2746E-05,0.6496E-05,0.6572E-05,0.2861E-05,0.1795E-04,0.2862E-04, &
6031 &-.1103E-04,0.9369E-05,0.1765E-07,0.9143E-07,-.1846E-03,0.4515E-05, &
6032 &-.2626E-04,0.1275E-04,0.1577E-04,0.1667E-04,0.1871E-04,0.1644E-04, &
6033 &0.1360E-04,0.6632E-05,0.4221E-06,-.2254E-05,0.7433E-05,0.1725E-04, &
6034 &0.1834E-04,0.2148E-04,-.2537E-05,0.9251E-05,0.1765E-07,0.9143E-07, &
6035 &-.1846E-03,0.3060E-05,-.2709E-04,0.1159E-04,0.1195E-04,0.1081E-04, &
6036 &0.1058E-04,0.1026E-04,0.8609E-05,0.4794E-05,-.9331E-06,0.3166E-05, &
6037 &0.1340E-04,0.2067E-04,0.1223E-04,0.1459E-05,0.4914E-05,-.2115E-05, &
6038 &0.1765E-07,0.9143E-07,-.1851E-03,0.5947E-05,-.2452E-04,0.7255E-05, &
6039 &0.7111E-05,0.7851E-05,0.8384E-05,0.9930E-05,0.9285E-05,0.5097E-05, &
6040 &0.6752E-05,0.1298E-04,0.1399E-04,0.1913E-04,0.5781E-05,-.1565E-05, &
6041 &-.2180E-05,0.5621E-05,0.1765E-07,0.9143E-07,-.1846E-03,-.6184E-06, &
6042 &-.1702E-04,0.1730E-05,0.1379E-04,0.1288E-04,0.1210E-04,0.1426E-04, &
6043 &0.1402E-04,0.1163E-04,0.1156E-04,0.1250E-04,0.1988E-04,0.5954E-05, &
6044 &0.7024E-05,0.3524E-05,0.6520E-05,0.9981E-06,0.1765E-07,0.9143E-07, &
6045 &-.1851E-03,-.3396E-05,-.1723E-04,0.6361E-05,0.1388E-04,0.1304E-04, &
6046 &0.1399E-04,0.1344E-04,0.1278E-04,0.1051E-04,0.1462E-04,0.1480E-04, &
6047 &0.3949E-05,0.8595E-06,-.6487E-05,0.2725E-05,-.9187E-05,0.9898E-06, &
6048 &0.3216E-07,0.1677E-06,-.1570E-03,-.4189E-05,-.2111E-04,0.1012E-04, &
6049 &0.9510E-05,0.1072E-04,0.1242E-04,0.1382E-04,0.1744E-04,0.1622E-04, &
6050 &0.9391E-05,0.5166E-05,0.1522E-05,0.3378E-06,-.1901E-06,-.7943E-06, &
6051 &-.1324E-05,-.8822E-05,-.6747E-07,-.3373E-06,-.1785E-03,-.7169E-05, &
6052 &-.2373E-04,0.5172E-05,0.5896E-05,0.6778E-05,0.8321E-05,0.1054E-04, &
6053 &0.9381E-05,0.7614E-05,0.5371E-05,0.5089E-05,0.2464E-05,0.1010E-05, &
6054 &0.9660E-06,0.1519E-05,0.3679E-05,-.7842E-05/
6055 data ( ( coeco_4_new(k,j), j = 1, 11 ), k=1, 3) / &
6056 &-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02, &
6057 &-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.5549E-06, &
6058 &-.1040E-05,-.1040E-05,-.1283E-05,-.1491E-05,-.1491E-05,-.1769E-05, &
6059 &-.1838E-05,-.1838E-05,-.3190E-05,0.4161E-06,-.2396E-07,-.1513E-07, &
6060 &-.1513E-07,-.1072E-07,-.6936E-08,-.6936E-08,-.1892E-08,-.6305E-09, &
6061 &-.6305E-09,0.6305E-08,-.7566E-08/
6062 data ( ( coeh2o_4_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
6063 &-.2300E+02,-.1911E+02,-.1696E+02,-.1450E+02,-.1169E+02,-.9251E+01, &
6064 &-.8138E+01,-.8075E+01,-.7958E+01,-.7791E+01,-.7572E+01,-.7300E+01, &
6065 &-.6947E+01,-.6497E+01,-.6001E+01,-.5246E+01,-.4412E+01,-.3153E+01, &
6066 &-.1527E+01,0.9630E+00,-.2254E+02,-.1865E+02,-.1651E+02,-.1406E+02, &
6067 &-.1130E+02,-.8910E+01,-.7842E+01,-.7776E+01,-.7658E+01,-.7494E+01, &
6068 &-.7276E+01,-.6996E+01,-.6636E+01,-.6224E+01,-.5726E+01,-.4992E+01, &
6069 &-.4137E+01,-.2962E+01,-.1452E+01,0.9661E+00,-.2208E+02,-.1819E+02, &
6070 &-.1604E+02,-.1362E+02,-.1091E+02,-.8556E+01,-.7509E+01,-.7448E+01, &
6071 &-.7339E+01,-.7178E+01,-.6957E+01,-.6653E+01,-.6324E+01,-.5907E+01, &
6072 &-.5410E+01,-.4741E+01,-.3912E+01,-.2840E+01,-.1379E+01,0.1020E+01, &
6073 &-.2162E+02,-.1773E+02,-.1559E+02,-.1318E+02,-.1052E+02,-.8197E+01, &
6074 &-.7172E+01,-.7118E+01,-.7004E+01,-.6836E+01,-.6610E+01,-.6327E+01, &
6075 &-.5991E+01,-.5585E+01,-.5072E+01,-.4460E+01,-.3690E+01,-.2684E+01, &
6076 &-.1315E+01,0.9195E+00,-.2115E+02,-.1727E+02,-.1513E+02,-.1276E+02, &
6077 &-.1013E+02,-.7855E+01,-.6806E+01,-.6753E+01,-.6653E+01,-.6479E+01, &
6078 &-.6268E+01,-.5993E+01,-.5651E+01,-.5234E+01,-.4751E+01,-.4200E+01, &
6079 &-.3413E+01,-.2512E+01,-.1197E+01,0.9174E+00,-.2069E+02,-.1681E+02, &
6080 &-.1468E+02,-.1234E+02,-.9755E+01,-.7502E+01,-.6437E+01,-.6384E+01, &
6081 &-.6291E+01,-.6147E+01,-.5935E+01,-.5654E+01,-.5301E+01,-.4909E+01, &
6082 &-.4434E+01,-.3939E+01,-.3183E+01,-.2278E+01,-.1012E+01,0.8419E+00, &
6083 &-.2024E+02,-.1635E+02,-.1423E+02,-.1194E+02,-.9396E+01,-.7147E+01, &
6084 &-.6092E+01,-.6039E+01,-.5942E+01,-.5795E+01,-.5585E+01,-.5315E+01, &
6085 &-.4972E+01,-.4600E+01,-.4160E+01,-.3663E+01,-.2965E+01,-.2087E+01, &
6086 &-.8820E+00,0.7279E+00,-.1977E+02,-.1589E+02,-.1381E+02,-.1155E+02, &
6087 &-.9056E+01,-.6792E+01,-.5738E+01,-.5685E+01,-.5591E+01,-.5453E+01, &
6088 &-.5267E+01,-.5001E+01,-.4691E+01,-.4326E+01,-.3921E+01,-.3404E+01, &
6089 &-.2762E+01,-.1963E+01,-.8706E+00,0.5360E+00,-.1931E+02,-.1544E+02, &
6090 &-.1341E+02,-.1118E+02,-.8753E+01,-.6453E+01,-.5432E+01,-.5371E+01, &
6091 &-.5269E+01,-.5139E+01,-.4968E+01,-.4738E+01,-.4444E+01,-.4084E+01, &
6092 &-.3677E+01,-.3155E+01,-.2593E+01,-.1848E+01,-.8530E+00,0.3441E+00, &
6093 &-.1882E+02,-.1501E+02,-.1302E+02,-.1084E+02,-.8449E+01,-.6144E+01, &
6094 &-.5173E+01,-.5114E+01,-.5012E+01,-.4870E+01,-.4708E+01,-.4498E+01, &
6095 &-.4214E+01,-.3866E+01,-.3415E+01,-.2952E+01,-.2423E+01,-.1771E+01, &
6096 &-.9135E+00,0.1144E+00,-.1832E+02,-.1460E+02,-.1267E+02,-.1053E+02, &
6097 &-.8169E+01,-.5877E+01,-.4949E+01,-.4899E+01,-.4806E+01,-.4656E+01, &
6098 &-.4471E+01,-.4258E+01,-.3995E+01,-.3665E+01,-.3251E+01,-.2786E+01, &
6099 &-.2295E+01,-.1770E+01,-.1006E+01,-.1656E+00/
6100 data ( ( coeh2o_4_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
6101 &0.9281E-02,0.7063E-02,0.6968E-02,0.8328E-02,0.9339E-02,0.7776E-02, &
6102 &0.7936E-02,0.7936E-02,0.7875E-02,0.7744E-02,0.7441E-02,0.7480E-02, &
6103 &0.7449E-02,0.8004E-02,0.8682E-02,0.8472E-02,0.9103E-02,0.8632E-02, &
6104 &0.9273E-02,0.7225E-02,0.9289E-02,0.7079E-02,0.6967E-02,0.8315E-02, &
6105 &0.9148E-02,0.7388E-02,0.7432E-02,0.7410E-02,0.7403E-02,0.7244E-02, &
6106 &0.6958E-02,0.6883E-02,0.7329E-02,0.7612E-02,0.7700E-02,0.7688E-02, &
6107 &0.7969E-02,0.6924E-02,0.9211E-02,0.6126E-02,0.9289E-02,0.7071E-02, &
6108 &0.7001E-02,0.8291E-02,0.8952E-02,0.7112E-02,0.6841E-02,0.6893E-02, &
6109 &0.6894E-02,0.6947E-02,0.6865E-02,0.6753E-02,0.6912E-02,0.6820E-02, &
6110 &0.6682E-02,0.7168E-02,0.7151E-02,0.6037E-02,0.7499E-02,0.4312E-02, &
6111 &0.9283E-02,0.7071E-02,0.7040E-02,0.8229E-02,0.8783E-02,0.6729E-02, &
6112 &0.6602E-02,0.6697E-02,0.6842E-02,0.6773E-02,0.6847E-02,0.6511E-02, &
6113 &0.6583E-02,0.6321E-02,0.5896E-02,0.6472E-02,0.6582E-02,0.5389E-02, &
6114 &0.6017E-02,0.5314E-02,0.9277E-02,0.7075E-02,0.7085E-02,0.8209E-02, &
6115 &0.8633E-02,0.6474E-02,0.6425E-02,0.6452E-02,0.6521E-02,0.6613E-02, &
6116 &0.6682E-02,0.6400E-02,0.6030E-02,0.5932E-02,0.5521E-02,0.6027E-02, &
6117 &0.5448E-02,0.4493E-02,0.4742E-02,0.4193E-02,0.9280E-02,0.7083E-02, &
6118 &0.7145E-02,0.8235E-02,0.8507E-02,0.6615E-02,0.6202E-02,0.6202E-02, &
6119 &0.6215E-02,0.6321E-02,0.6409E-02,0.6188E-02,0.5670E-02,0.5742E-02, &
6120 &0.5332E-02,0.5431E-02,0.4760E-02,0.4682E-02,0.5189E-02,0.3815E-02, &
6121 &0.9289E-02,0.7120E-02,0.7240E-02,0.8241E-02,0.8473E-02,0.7078E-02, &
6122 &0.6049E-02,0.5961E-02,0.5985E-02,0.6066E-02,0.6185E-02,0.5823E-02, &
6123 &0.5609E-02,0.5362E-02,0.4848E-02,0.4827E-02,0.4381E-02,0.4667E-02, &
6124 &0.5201E-02,0.3296E-02,0.9283E-02,0.7181E-02,0.7373E-02,0.8216E-02, &
6125 &0.8499E-02,0.7122E-02,0.6128E-02,0.6053E-02,0.5910E-02,0.5690E-02, &
6126 &0.5731E-02,0.5727E-02,0.5558E-02,0.4958E-02,0.4759E-02,0.4226E-02, &
6127 &0.3988E-02,0.5002E-02,0.4975E-02,0.3933E-02,0.9286E-02,0.7343E-02, &
6128 &0.7485E-02,0.8212E-02,0.8729E-02,0.7269E-02,0.6253E-02,0.6173E-02, &
6129 &0.5940E-02,0.5573E-02,0.5120E-02,0.5207E-02,0.5069E-02,0.4704E-02, &
6130 &0.4552E-02,0.3975E-02,0.4286E-02,0.4832E-02,0.4471E-02,0.3344E-02, &
6131 &0.9085E-02,0.7800E-02,0.7732E-02,0.8265E-02,0.9332E-02,0.7232E-02, &
6132 &0.5979E-02,0.5903E-02,0.5651E-02,0.5311E-02,0.4955E-02,0.4721E-02, &
6133 &0.4874E-02,0.4779E-02,0.4284E-02,0.4249E-02,0.4157E-02,0.4764E-02, &
6134 &0.3974E-02,0.4288E-02,0.9157E-02,0.8265E-02,0.7739E-02,0.8207E-02, &
6135 &0.9788E-02,0.6982E-02,0.5511E-02,0.5498E-02,0.5459E-02,0.5323E-02, &
6136 &0.5261E-02,0.4914E-02,0.4383E-02,0.4399E-02,0.4525E-02,0.4712E-02, &
6137 &0.4326E-02,0.4187E-02,0.3584E-02,0.4187E-02/
6138 data ( ( coeh2o_4_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
6139 &-.3594E-04,-.2935E-04,-.1372E-04,-.1635E-04,-.2586E-04,-.2005E-04, &
6140 &-.1430E-04,-.1428E-04,-.1519E-04,-.1535E-04,-.7834E-05,-.2346E-05, &
6141 &-.6894E-05,-.1020E-04,0.8785E-05,-.1988E-04,0.8652E-05,-.2389E-04, &
6142 &-.2397E-04,-.4342E-04,-.3474E-04,-.2966E-04,-.1397E-04,-.1630E-04, &
6143 &-.2485E-04,-.1818E-04,-.3649E-05,-.4586E-05,-.6734E-05,-.6747E-05, &
6144 &-.6591E-05,-.4976E-05,-.1452E-04,-.1011E-04,0.3594E-05,-.2053E-04, &
6145 &-.1216E-04,-.3090E-04,-.3758E-04,-.3498E-04,-.3586E-04,-.2950E-04, &
6146 &-.1402E-04,-.1533E-04,-.2308E-04,-.1634E-04,-.1098E-05,-.1829E-05, &
6147 &-.2310E-05,-.3867E-05,-.6139E-05,-.1438E-04,-.1295E-04,-.1172E-04, &
6148 &0.3873E-06,-.2013E-04,-.7255E-05,-.2163E-04,-.2465E-04,-.2314E-04, &
6149 &-.3575E-04,-.2956E-04,-.1460E-04,-.1462E-04,-.2128E-04,-.1600E-04, &
6150 &-.1606E-05,0.7761E-06,-.2217E-05,-.6117E-05,-.1079E-04,-.1517E-04, &
6151 &-.9977E-05,-.1104E-04,-.1556E-04,-.1699E-04,-.2087E-05,-.1440E-04, &
6152 &-.1211E-04,-.9464E-05,-.3587E-04,-.2960E-04,-.1525E-04,-.1364E-04, &
6153 &-.1990E-04,-.1077E-04,-.8291E-05,-.5765E-05,-.2400E-05,-.8273E-05, &
6154 &-.1099E-04,-.1108E-04,-.7577E-05,-.1875E-04,-.2055E-04,-.4535E-05, &
6155 &-.1209E-04,-.2342E-05,-.4700E-06,-.3739E-04,-.3597E-04,-.2968E-04, &
6156 &-.1525E-04,-.1480E-04,-.2008E-04,-.1345E-04,-.1418E-04,-.1143E-04, &
6157 &-.6487E-05,-.3917E-05,-.6416E-05,-.1083E-04,-.1397E-04,-.2202E-04, &
6158 &-.2461E-04,0.5422E-05,-.2146E-04,-.3011E-04,-.2330E-04,-.2846E-04, &
6159 &-.3468E-04,-.3062E-04,-.1609E-04,-.1326E-04,-.1826E-04,-.1963E-04, &
6160 &-.1664E-04,-.1385E-04,-.8541E-05,-.5488E-05,-.1020E-04,-.1546E-04, &
6161 &-.2315E-04,-.2030E-04,-.1748E-04,-.3597E-05,-.2125E-04,-.2707E-04, &
6162 &-.4030E-04,-.2906E-04,-.3574E-04,-.3152E-04,-.1497E-04,-.1229E-04, &
6163 &-.1659E-04,-.2335E-04,-.2297E-04,-.2063E-04,-.1634E-04,-.1101E-04, &
6164 &-.1141E-04,-.1646E-04,-.1662E-04,-.1417E-04,-.4462E-05,-.1003E-04, &
6165 &-.2179E-04,-.1428E-04,-.3478E-04,-.3015E-04,-.3576E-04,-.3331E-04, &
6166 &-.1147E-04,-.1347E-04,-.1500E-04,-.2464E-04,-.2425E-04,-.2656E-04, &
6167 &-.2615E-04,-.1825E-04,-.8554E-05,-.1118E-04,-.1189E-04,-.1032E-04, &
6168 &-.8288E-05,-.2485E-04,-.1816E-04,-.9669E-05,-.3007E-04,-.2275E-04, &
6169 &-.3183E-04,-.3689E-04,-.8395E-05,-.1344E-04,-.1930E-04,-.2277E-04, &
6170 &-.1976E-04,-.2256E-04,-.2241E-04,-.2075E-04,-.1129E-04,-.6102E-05, &
6171 &-.1229E-04,-.1382E-04,-.2815E-04,-.2577E-04,-.1758E-04,-.1649E-04, &
6172 &-.1184E-04,-.1458E-04,-.3974E-04,-.4074E-04,-.5256E-05,-.1088E-04, &
6173 &-.2123E-04,-.1784E-04,-.1047E-04,-.1041E-04,-.1252E-04,-.2148E-04, &
6174 &-.2472E-04,-.1897E-04,-.1358E-04,-.1416E-04,-.1574E-04,-.2061E-04, &
6175 &-.2316E-04,-.1710E-04,-.1221E-04,-.2155E-04/
6178 ! block data ckd5_new
6179 !c *********************************************************************
6180 !c hk is the interval in the g (cumulative probability) space from 0
6181 !c to one. coeh2o is the coefficient to calculate the H2O absorption
6182 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
6183 !c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
6184 !c spectral region is from 4000 to 2850 cm**-1.
6185 !c in this block data, Z.F. has added the coefficients for CO2, CH4, &
6186 !c N2O and water vapor continuum absorption in Jun,2003.
6187 !c *********************************************************************
6188 ! common /band5_new/ hk(20), coehh52(3,11,20),coeco2(3,11,20), &
6189 ! coen2o(3,11),coech4(3,11),coeh2o(3,11,20)
6190 real hk_5_new(20), coehh52_5_new(3,11,20),coeco2_5_new(3,11,20), &
6191 & coen2o_5_new(3,11),coech4_5_new(3,11),coeh2o_5_new(3,11,20)
6192 data hk_5_new /3.16689E-02,7.09894E-02,1.04066E-01,0.127902, &
6193 & 0.140374,0.140374,0.127902,1.04066E-01,7.09894E-02,3.16689E-02 &
6194 & ,1.66678E-03 &
6195 & ,3.73628E-03,5.47716E-03,6.73167E-03,7.38811E-03,7.38811E-03, &
6196 & 6.73167E-03,5.47716E-03,3.73628E-03,1.66678E-03/
6197 data ( ( coehh52_5_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
6198 &-.8666E+01,-.6282E+01,-.5178E+01,-.4084E+01,-.2810E+01,-.1264E+01, &
6199 &-.1987E+00,0.8437E+00,0.2082E+01,0.3324E+01,0.3804E+01,0.3917E+01, &
6200 &0.4149E+01,0.4438E+01,0.4921E+01,0.5511E+01,0.6395E+01,0.7441E+01, &
6201 &0.9063E+01,0.1126E+02,-.8209E+01,-.5829E+01,-.4729E+01,-.3644E+01, &
6202 &-.2386E+01,-.8421E+00,0.2255E+00,0.1262E+01,0.2468E+01,0.3682E+01, &
6203 &0.4154E+01,0.4264E+01,0.4467E+01,0.4766E+01,0.5233E+01,0.5806E+01, &
6204 &0.6616E+01,0.7632E+01,0.9166E+01,0.1124E+02,-.7746E+01,-.5373E+01, &
6205 &-.4276E+01,-.3198E+01,-.1956E+01,-.4081E+00,0.6594E+00,0.1689E+01, &
6206 &0.2861E+01,0.4049E+01,0.4511E+01,0.4619E+01,0.4817E+01,0.5118E+01, &
6207 &0.5534E+01,0.6112E+01,0.6849E+01,0.7847E+01,0.9268E+01,0.1129E+02, &
6208 &-.7286E+01,-.4922E+01,-.3829E+01,-.2755E+01,-.1524E+01,0.2336E-01, &
6209 &0.1095E+01,0.2107E+01,0.3259E+01,0.4414E+01,0.4865E+01,0.4977E+01, &
6210 &0.5174E+01,0.5476E+01,0.5865E+01,0.6413E+01,0.7117E+01,0.8055E+01, &
6211 &0.9446E+01,0.1133E+02,-.6826E+01,-.4478E+01,-.3383E+01,-.2321E+01, &
6212 &-.1094E+01,0.4524E+00,0.1530E+01,0.2525E+01,0.3658E+01,0.4782E+01, &
6213 &0.5225E+01,0.5326E+01,0.5512E+01,0.5800E+01,0.6184E+01,0.6696E+01, &
6214 &0.7377E+01,0.8267E+01,0.9530E+01,0.1129E+02,-.6368E+01,-.4036E+01, &
6215 &-.2942E+01,-.1892E+01,-.6687E+00,0.8758E+00,0.1958E+01,0.2938E+01, &
6216 &0.4045E+01,0.5149E+01,0.5560E+01,0.5661E+01,0.5848E+01,0.6119E+01, &
6217 &0.6458E+01,0.6961E+01,0.7638E+01,0.8463E+01,0.9684E+01,0.1119E+02, &
6218 &-.5920E+01,-.3599E+01,-.2513E+01,-.1469E+01,-.2504E+00,0.1294E+01, &
6219 &0.2377E+01,0.3339E+01,0.4416E+01,0.5481E+01,0.5868E+01,0.5960E+01, &
6220 &0.6145E+01,0.6412E+01,0.6738E+01,0.7221E+01,0.7854E+01,0.8652E+01, &
6221 &0.9763E+01,0.1102E+02,-.5471E+01,-.3175E+01,-.2080E+01,-.1046E+01, &
6222 &0.1674E+00,0.1705E+01,0.2789E+01,0.3732E+01,0.4779E+01,0.5785E+01, &
6223 &0.6155E+01,0.6239E+01,0.6407E+01,0.6664E+01,0.7010E+01,0.7456E+01, &
6224 &0.8033E+01,0.8804E+01,0.9750E+01,0.1086E+02,-.5041E+01,-.2765E+01, &
6225 &-.1655E+01,-.6275E+00,0.5725E+00,0.2093E+01,0.3186E+01,0.4105E+01, &
6226 &0.5115E+01,0.6067E+01,0.6425E+01,0.6511E+01,0.6660E+01,0.6893E+01, &
6227 &0.7240E+01,0.7641E+01,0.8204E+01,0.8886E+01,0.9714E+01,0.1061E+02, &
6228 &-.4616E+01,-.2373E+01,-.1234E+01,-.2160E+00,0.9628E+00,0.2446E+01, &
6229 &0.3569E+01,0.4462E+01,0.5415E+01,0.6340E+01,0.6668E+01,0.6750E+01, &
6230 &0.6892E+01,0.7106E+01,0.7414E+01,0.7806E+01,0.8336E+01,0.8913E+01, &
6231 &0.9567E+01,0.1035E+02,-.4207E+01,-.1980E+01,-.8165E+00,0.1865E+00, &
6232 &0.1326E+01,0.2750E+01,0.3932E+01,0.4794E+01,0.5700E+01,0.6590E+01, &
6233 &0.6882E+01,0.6954E+01,0.7084E+01,0.7279E+01,0.7567E+01,0.7953E+01, &
6234 &0.8376E+01,0.8840E+01,0.9428E+01,0.1002E+02/
6235 data ( ( coehh52_5_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
6236 &-.4007E-02,0.1426E-03,0.1446E-02,0.3557E-02,0.5610E-02,0.4265E-02, &
6237 &0.1692E-02,0.1490E-02,0.2099E-02,0.3019E-02,0.2999E-02,0.3000E-02, &
6238 &0.3171E-02,0.3501E-02,0.3801E-02,0.3549E-02,0.4267E-02,0.3041E-02, &
6239 &0.2516E-02,0.1526E-02,-.4024E-02,0.1852E-03,0.1458E-02,0.3519E-02, &
6240 &0.5393E-02,0.4196E-02,0.1492E-02,0.1262E-02,0.1774E-02,0.2484E-02, &
6241 &0.2514E-02,0.2591E-02,0.2498E-02,0.2861E-02,0.2748E-02,0.2866E-02, &
6242 &0.3072E-02,0.2328E-02,0.2928E-02,0.9786E-03,-.3997E-02,0.2973E-03, &
6243 &0.1427E-02,0.3424E-02,0.5224E-02,0.4131E-02,0.1273E-02,0.1049E-02, &
6244 &0.1466E-02,0.2090E-02,0.2115E-02,0.2151E-02,0.2149E-02,0.2113E-02, &
6245 &0.2099E-02,0.2487E-02,0.2459E-02,0.1791E-02,0.2853E-02,0.5138E-03, &
6246 &-.3990E-02,0.4035E-03,0.1355E-02,0.3351E-02,0.5057E-02,0.4015E-02, &
6247 &0.1135E-02,0.9161E-03,0.1180E-02,0.1731E-02,0.1781E-02,0.1764E-02, &
6248 &0.1684E-02,0.1413E-02,0.1821E-02,0.1858E-02,0.1430E-02,0.1006E-02, &
6249 &0.2163E-02,0.2395E-03,-.3989E-02,0.5809E-03,0.1288E-02,0.3223E-02, &
6250 &0.4918E-02,0.3901E-02,0.9747E-03,0.7342E-03,0.1006E-02,0.1242E-02, &
6251 &0.1328E-02,0.1368E-02,0.1372E-02,0.1279E-02,0.1295E-02,0.1282E-02, &
6252 &0.1032E-02,0.6375E-03,0.1563E-02,-.2982E-04,-.4014E-02,0.7514E-03, &
6253 &0.1202E-02,0.3091E-02,0.4798E-02,0.3841E-02,0.8673E-03,0.5651E-03, &
6254 &0.9085E-03,0.1049E-02,0.1294E-02,0.1288E-02,0.1183E-02,0.1140E-02, &
6255 &0.9012E-03,0.9593E-03,0.1014E-02,0.1117E-02,0.1066E-02,-.1099E-02, &
6256 &-.4075E-02,0.8802E-03,0.1042E-02,0.2937E-02,0.4657E-02,0.3814E-02, &
6257 &0.6835E-03,0.4783E-03,0.8688E-03,0.8872E-03,0.1221E-02,0.1184E-02, &
6258 &0.1061E-02,0.7615E-03,0.6239E-03,0.8406E-03,0.7873E-03,0.9015E-03, &
6259 &0.1466E-03,-.5840E-03,-.4182E-02,0.1165E-02,0.8200E-03,0.2741E-02, &
6260 &0.4498E-02,0.3771E-02,0.4988E-03,0.3560E-03,0.6538E-03,0.6745E-03, &
6261 &0.8484E-03,0.8844E-03,0.7564E-03,0.7354E-03,0.4966E-03,0.6557E-03, &
6262 &0.5528E-03,0.3779E-03,0.2114E-04,-.1370E-02,-.4411E-02,0.1337E-02, &
6263 &0.5687E-03,0.2592E-02,0.4434E-02,0.3792E-02,0.2925E-03,0.2261E-03, &
6264 &0.5712E-03,0.5103E-03,0.3708E-03,0.4357E-03,0.5158E-03,0.5609E-03, &
6265 &0.4781E-03,0.4167E-03,0.4737E-03,0.1337E-03,-.4880E-03,-.1383E-02, &
6266 &-.4715E-02,0.1462E-02,0.3031E-03,0.2423E-02,0.4282E-02,0.3804E-02, &
6267 &0.1177E-03,0.2911E-03,0.3478E-03,0.2609E-03,0.9838E-04,0.2236E-03, &
6268 &0.4689E-03,0.4508E-03,0.4734E-03,0.3268E-03,0.3338E-03,-.1376E-04, &
6269 &-.4611E-03,-.6319E-03,-.5313E-02,0.1413E-02,0.1130E-03,0.2251E-02, &
6270 &0.4041E-02,0.3676E-02,-.8065E-04,0.2368E-03,0.5349E-05,0.1502E-03, &
6271 &0.1613E-03,0.2078E-03,0.2388E-03,0.2124E-03,0.2042E-03,0.8376E-04, &
6272 &0.3356E-03,-.2620E-03,-.9731E-03,-.1027E-02/
6273 data ( ( coehh52_5_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
6274 &0.1007E-03,0.2111E-04,0.1520E-04,0.7675E-05,0.4202E-05,-.1897E-04, &
6275 &0.6318E-05,0.4970E-05,-.3149E-05,-.3635E-05,-.3746E-05,-.3696E-05, &
6276 &-.5442E-05,0.9822E-05,0.4071E-05,0.3916E-05,-.2316E-04,0.5506E-05, &
6277 &-.1083E-04,0.1991E-04,0.1008E-03,0.2003E-04,0.1652E-04,0.8137E-05, &
6278 &0.4385E-05,-.1826E-04,0.6703E-05,0.4379E-05,-.1838E-05,-.4339E-05, &
6279 &-.6329E-07,0.1229E-05,0.2146E-05,0.1085E-04,0.3753E-06,-.4002E-05, &
6280 &-.4361E-05,0.5894E-05,-.5931E-05,0.1907E-04,0.1005E-03,0.1905E-04, &
6281 &0.1699E-04,0.8546E-05,0.4699E-05,-.1959E-04,0.7236E-05,0.2594E-05, &
6282 &-.5232E-06,-.5786E-05,0.2779E-05,0.4142E-05,0.3868E-05,0.5357E-05, &
6283 &0.1154E-05,-.6563E-05,0.4403E-05,0.4716E-05,-.3646E-05,0.1643E-05, &
6284 &0.1005E-03,0.1811E-04,0.1756E-04,0.8874E-05,0.3784E-05,-.2077E-04, &
6285 &0.6903E-05,0.2352E-05,-.2308E-05,0.1285E-06,0.3476E-05,0.2272E-05, &
6286 &0.1289E-05,-.9765E-05,-.3869E-05,-.5959E-05,0.4652E-05,0.2487E-05, &
6287 &-.1458E-04,-.1865E-04,0.1003E-03,0.1777E-04,0.1840E-04,0.9793E-05, &
6288 &0.3308E-05,-.2114E-04,0.5553E-05,0.2666E-05,-.4281E-05,-.1293E-05, &
6289 &-.2118E-05,-.1122E-05,-.8954E-06,-.4337E-05,-.4615E-05,-.1896E-05, &
6290 &0.4289E-05,-.5416E-06,0.1302E-04,0.6468E-06,0.1000E-03,0.1448E-04, &
6291 &0.1911E-04,0.1125E-04,0.1673E-05,-.2045E-04,0.5796E-05,0.8374E-06, &
6292 &-.2206E-05,-.3980E-05,-.2208E-05,-.2803E-05,-.3762E-05,-.4563E-05, &
6293 &0.2444E-05,0.1631E-05,-.1026E-05,-.7909E-05,-.8622E-05,-.1181E-04, &
6294 &0.1016E-03,0.9190E-05,0.2101E-04,0.1178E-04,0.3234E-05,-.2053E-04, &
6295 &0.5534E-05,0.9896E-06,-.1037E-05,-.1935E-05,-.3589E-05,-.1289E-05, &
6296 &-.3458E-05,-.6364E-05,0.1473E-05,0.4079E-05,-.6143E-05,-.1128E-04, &
6297 &-.1329E-04,0.3675E-05,0.1016E-03,0.3449E-05,0.2094E-04,0.1269E-04, &
6298 &0.3572E-05,-.1985E-04,0.4922E-05,0.1352E-05,-.9556E-06,-.1714E-05, &
6299 &-.8815E-06,0.8366E-06,0.4805E-06,-.1632E-05,-.2761E-05,-.4128E-05, &
6300 &-.3822E-05,-.6255E-05,0.1630E-06,0.9692E-05,0.1051E-03,-.3064E-05, &
6301 &0.2106E-04,0.1404E-04,0.4135E-05,-.1707E-04,0.4493E-05,0.1264E-05, &
6302 &-.2982E-05,-.4161E-06,-.2585E-05,-.1920E-05,0.1199E-05,-.2294E-05, &
6303 &-.2828E-05,-.2647E-05,-.5113E-05,0.5922E-05,-.7602E-05,0.2036E-05, &
6304 &0.1074E-03,-.2572E-05,0.2093E-04,0.1440E-04,0.5478E-05,-.1040E-04, &
6305 &0.4462E-05,-.6851E-06,-.2301E-06,-.1729E-05,-.3216E-06,0.2235E-06, &
6306 &0.7215E-06,-.2233E-05,-.3133E-05,0.3816E-05,-.3828E-05,-.2315E-05, &
6307 &0.6354E-05,-.8020E-05,0.1078E-03,-.9762E-05,0.2073E-04,0.1379E-04, &
6308 &0.7391E-05,0.2956E-05,0.1963E-05,-.3750E-05,0.2484E-05,-.2601E-05, &
6309 &-.1286E-05,-.1258E-06,0.3129E-05,0.4531E-05,0.8059E-06,-.3833E-05, &
6310 &-.6074E-05,0.1838E-05,0.2217E-05,-.2464E-05/
6311 data ( ( coeco2_5_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
6312 &-.4604E+02,-.4597E+02,-.4585E+02,-.2145E+02,-.1886E+02,-.1697E+02, &
6313 &-.1355E+02,-.8736E+01,-.6451E+01,-.5327E+01,-.4880E+01,-.4766E+01, &
6314 &-.4553E+01,-.4233E+01,-.3790E+01,-.3222E+01,-.2504E+01,-.1414E+01, &
6315 &0.1152E+00,0.3516E+01,-.4604E+02,-.4597E+02,-.4585E+02,-.2100E+02, &
6316 &-.1840E+02,-.1651E+02,-.1315E+02,-.8370E+01,-.6038E+01,-.4934E+01, &
6317 &-.4488E+01,-.4383E+01,-.4169E+01,-.3872E+01,-.3458E+01,-.2907E+01, &
6318 &-.2169E+01,-.1160E+01,0.3362E+00,0.3496E+01,-.4604E+02,-.4597E+02, &
6319 &-.4585E+02,-.2053E+02,-.1794E+02,-.1605E+02,-.1277E+02,-.7997E+01, &
6320 &-.5617E+01,-.4523E+01,-.4097E+01,-.3991E+01,-.3790E+01,-.3501E+01, &
6321 &-.3114E+01,-.2577E+01,-.1847E+01,-.8386E+00,0.5202E+00,0.3508E+01, &
6322 &-.4604E+02,-.4597E+02,-.4585E+02,-.2007E+02,-.1748E+02,-.1559E+02, &
6323 &-.1241E+02,-.7629E+01,-.5195E+01,-.4126E+01,-.3715E+01,-.3615E+01, &
6324 &-.3440E+01,-.3146E+01,-.2763E+01,-.2235E+01,-.1564E+01,-.5597E+00, &
6325 &0.7944E+00,0.3469E+01,-.4604E+02,-.4597E+02,-.4585E+02,-.1961E+02, &
6326 &-.1702E+02,-.1514E+02,-.1209E+02,-.7259E+01,-.4779E+01,-.3739E+01, &
6327 &-.3348E+01,-.3249E+01,-.3070E+01,-.2786E+01,-.2410E+01,-.1902E+01, &
6328 &-.1214E+01,-.3116E+00,0.1099E+01,0.3322E+01,-.4604E+02,-.4597E+02, &
6329 &-.4585E+02,-.1915E+02,-.1656E+02,-.1471E+02,-.1179E+02,-.6895E+01, &
6330 &-.4369E+01,-.3368E+01,-.2981E+01,-.2886E+01,-.2717E+01,-.2442E+01, &
6331 &-.2073E+01,-.1576E+01,-.8880E+00,-.9229E-01,0.1376E+01,0.3154E+01, &
6332 &-.4604E+02,-.4597E+02,-.4585E+02,-.1869E+02,-.1611E+02,-.1430E+02, &
6333 &-.1151E+02,-.6549E+01,-.3980E+01,-.3010E+01,-.2626E+01,-.2540E+01, &
6334 &-.2365E+01,-.2107E+01,-.1741E+01,-.1267E+01,-.6970E+00,0.2205E+00, &
6335 &0.1582E+01,0.2963E+01,-.4604E+02,-.4597E+02,-.4585E+02,-.1823E+02, &
6336 &-.1566E+02,-.1394E+02,-.1126E+02,-.6234E+01,-.3614E+01,-.2632E+01, &
6337 &-.2275E+01,-.2184E+01,-.2023E+01,-.1785E+01,-.1449E+01,-.1014E+01, &
6338 &-.3839E+00,0.5345E+00,0.1650E+01,0.2685E+01,-.4604E+02,-.4597E+02, &
6339 &-.4585E+02,-.1777E+02,-.1525E+02,-.1363E+02,-.1103E+02,-.5918E+01, &
6340 &-.3280E+01,-.2270E+01,-.1945E+01,-.1870E+01,-.1722E+01,-.1499E+01, &
6341 &-.1173E+01,-.7176E+00,-.7814E-01,0.7223E+00,0.1629E+01,0.2373E+01, &
6342 &-.4603E+02,-.4596E+02,-.4584E+02,-.1726E+02,-.1488E+02,-.1336E+02, &
6343 &-.1080E+02,-.5589E+01,-.2960E+01,-.1947E+01,-.1636E+01,-.1559E+01, &
6344 &-.1420E+01,-.1204E+01,-.8742E+00,-.4450E+00,0.1392E+00,0.8142E+00, &
6345 &0.1491E+01,0.2044E+01,-.4603E+02,-.4595E+02,-.2628E+02,-.1681E+02, &
6346 &-.1452E+02,-.1308E+02,-.1059E+02,-.5284E+01,-.2681E+01,-.1610E+01, &
6347 &-.1304E+01,-.1235E+01,-.1107E+01,-.9014E+00,-.5972E+00,-.2077E+00, &
6348 &0.2692E+00,0.7754E+00,0.1252E+01,0.1693E+01/
6349 data ( ( coeco2_5_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
6350 &-.6312E-05,-.3267E-04,-.7758E-04,0.2214E-01,0.1591E-01,0.1721E-01, &
6351 &0.1878E-01,0.1462E-01,0.4258E-02,0.4565E-02,0.5099E-02,0.5116E-02, &
6352 &0.5155E-02,0.5255E-02,0.5432E-02,0.5536E-02,0.5327E-02,0.4227E-02, &
6353 &0.4953E-02,0.2251E-02,-.6312E-05,-.3267E-04,-.7758E-04,0.2212E-01, &
6354 &0.1592E-01,0.1726E-01,0.1877E-01,0.1422E-01,0.3987E-02,0.4005E-02, &
6355 &0.4434E-02,0.4494E-02,0.4307E-02,0.4702E-02,0.4999E-02,0.4552E-02, &
6356 &0.4265E-02,0.3668E-02,0.3548E-02,0.1663E-02,-.6312E-05,-.3267E-04, &
6357 &-.7758E-04,0.2215E-01,0.1594E-01,0.1730E-01,0.1863E-01,0.1362E-01, &
6358 &0.3873E-02,0.3564E-02,0.3758E-02,0.3855E-02,0.3904E-02,0.4138E-02, &
6359 &0.4326E-02,0.3744E-02,0.3562E-02,0.3639E-02,0.2931E-02,0.1193E-02, &
6360 &-.6312E-05,-.3267E-04,-.7758E-04,0.2214E-01,0.1597E-01,0.1742E-01, &
6361 &0.1801E-01,0.1297E-01,0.3689E-02,0.3099E-02,0.3337E-02,0.3439E-02, &
6362 &0.3505E-02,0.3644E-02,0.3532E-02,0.3165E-02,0.3317E-02,0.3432E-02, &
6363 &0.1006E-02,0.1082E-02,-.6312E-05,-.3267E-04,-.7758E-04,0.2214E-01, &
6364 &0.1603E-01,0.1758E-01,0.1726E-01,0.1272E-01,0.3510E-02,0.2756E-02, &
6365 &0.2947E-02,0.2952E-02,0.3065E-02,0.2918E-02,0.3096E-02,0.2699E-02, &
6366 &0.3102E-02,0.2814E-02,-.2179E-03,0.6990E-03,-.6312E-05,-.3267E-04, &
6367 &-.7758E-04,0.2216E-01,0.1612E-01,0.1777E-01,0.1654E-01,0.1256E-01, &
6368 &0.3449E-02,0.2312E-02,0.2549E-02,0.2608E-02,0.2546E-02,0.2708E-02, &
6369 &0.2767E-02,0.2637E-02,0.3097E-02,0.1237E-02,-.4737E-04,0.5654E-03, &
6370 &-.6312E-05,-.3267E-04,-.7758E-04,0.2221E-01,0.1632E-01,0.1798E-01, &
6371 &0.1640E-01,0.1251E-01,0.3583E-02,0.2044E-02,0.2266E-02,0.2295E-02, &
6372 &0.2371E-02,0.2428E-02,0.2645E-02,0.2775E-02,0.2033E-02,-.4414E-03, &
6373 &0.7038E-04,0.6883E-03,-.6312E-05,-.3267E-04,-.7758E-04,0.2228E-01, &
6374 &0.1660E-01,0.1798E-01,0.1661E-01,0.1237E-01,0.3817E-02,0.1813E-02, &
6375 &0.1990E-02,0.2030E-02,0.2120E-02,0.2236E-02,0.2441E-02,0.1824E-02, &
6376 &0.6145E-03,-.6285E-03,-.5780E-03,0.1162E-02,-.6312E-05,-.3267E-04, &
6377 &-.7758E-04,0.2238E-01,0.1689E-01,0.1747E-01,0.1641E-01,0.1189E-01, &
6378 &0.4503E-02,0.1467E-02,0.1468E-02,0.1569E-02,0.1629E-02,0.1512E-02, &
6379 &0.1310E-02,0.5937E-03,-.4280E-03,-.4761E-03,0.3077E-03,0.9290E-03, &
6380 &-.1165E-04,-.6027E-04,-.1432E-03,0.2138E-01,0.1677E-01,0.1674E-01, &
6381 &0.1554E-01,0.1120E-01,0.5419E-02,0.8517E-03,0.6131E-03,0.5899E-03, &
6382 &0.6051E-03,0.3657E-03,0.1230E-03,-.2749E-03,-.2687E-03,-.3468E-04, &
6383 &0.7365E-03,0.7334E-03,-.1127E-04,-.5826E-04,-.1552E+00,0.2054E-01, &
6384 &0.1656E-01,0.1668E-01,0.1399E-01,0.1044E-01,0.5792E-02,-.4239E-04, &
6385 &-.2550E-03,-.2478E-03,-.2417E-03,-.2311E-03,-.2848E-03,-.1873E-03, &
6386 &-.1577E-03,0.3878E-03,0.7217E-03,0.9697E-03/
6387 data ( ( coeco2_5_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
6388 &0.2396E-07,0.1261E-06,0.3020E-06,-.1186E-03,-.5048E-04,-.3367E-04, &
6389 &-.2102E-04,-.1554E-04,0.4159E-05,0.1761E-04,0.1882E-04,0.1667E-04, &
6390 &0.1088E-04,0.1876E-05,0.1609E-05,0.5874E-05,0.1421E-04,0.7607E-05, &
6391 &0.6216E-05,-.1562E-04,0.2396E-07,0.1261E-06,0.3020E-06,-.1187E-03, &
6392 &-.5049E-04,-.3458E-04,-.1636E-04,-.1029E-04,0.1143E-05,0.1624E-04, &
6393 &0.1369E-04,0.1259E-04,0.4036E-05,0.4883E-05,0.8159E-05,0.1210E-04, &
6394 &0.9429E-05,0.8813E-05,0.2454E-05,-.9511E-05,0.2396E-07,0.1261E-06, &
6395 &0.3020E-06,-.1185E-03,-.5087E-04,-.3540E-04,-.6400E-05,-.6171E-05, &
6396 &-.2561E-05,0.1174E-04,0.1127E-04,0.1079E-04,0.7710E-05,0.6127E-05, &
6397 &0.1612E-04,0.1123E-04,0.8563E-05,-.2938E-05,0.2052E-04,-.2194E-04, &
6398 &0.2396E-07,0.1261E-06,0.3020E-06,-.1186E-03,-.5148E-04,-.3651E-04, &
6399 &-.4118E-05,-.1724E-05,-.6074E-05,0.1213E-04,0.1464E-04,0.1540E-04, &
6400 &0.1913E-04,0.1291E-04,0.1741E-04,0.1012E-04,0.1822E-04,0.3557E-05, &
6401 &0.1762E-04,-.2772E-04,0.2396E-07,0.1261E-06,0.3020E-06,-.1185E-03, &
6402 &-.5213E-04,-.3815E-04,-.1397E-06,-.1479E-05,-.7361E-05,0.1723E-04, &
6403 &0.1850E-04,0.1782E-04,0.1750E-04,0.1027E-04,0.7671E-05,0.7701E-05, &
6404 &0.3498E-05,0.1747E-04,0.1203E-04,-.2956E-05,0.2396E-07,0.1261E-06, &
6405 &0.3020E-06,-.1189E-03,-.5317E-04,-.3661E-04,0.3007E-05,-.2793E-05, &
6406 &-.8225E-05,0.2099E-04,0.1500E-04,0.1313E-04,0.1216E-04,0.5368E-05, &
6407 &0.3641E-05,0.2938E-05,-.7264E-05,0.3374E-04,0.7883E-05,0.5436E-05, &
6408 &0.2396E-07,0.1261E-06,0.3020E-06,-.1203E-03,-.5628E-04,-.3268E-04, &
6409 &0.3766E-05,-.5755E-05,-.1114E-04,0.2079E-04,0.4371E-05,0.6102E-05, &
6410 &0.3752E-05,0.5406E-05,-.2422E-05,0.6568E-05,0.2813E-04,0.1828E-04, &
6411 &-.6223E-05,-.3613E-05,0.2396E-07,0.1261E-06,0.3020E-06,-.1213E-03, &
6412 &-.5831E-04,-.2293E-04,-.3905E-05,0.5474E-06,-.1410E-04,0.1069E-04, &
6413 &0.6712E-05,0.3470E-05,0.4569E-05,0.9994E-05,0.9921E-05,0.2125E-04, &
6414 &0.1623E-04,-.3732E-05,-.1921E-06,0.8500E-05,0.2396E-07,0.1261E-06, &
6415 &0.3020E-06,-.1234E-03,-.5635E-04,-.1761E-04,-.6118E-05,0.2346E-05, &
6416 &-.2320E-04,0.9271E-05,0.1258E-04,0.1470E-04,0.1474E-04,0.1461E-04, &
6417 &0.1581E-04,0.1519E-04,0.2818E-05,-.2626E-06,0.3643E-05,0.5762E-05, &
6418 &0.4918E-07,0.2573E-06,0.6085E-06,-.1192E-03,-.4535E-04,-.7103E-05, &
6419 &-.2094E-06,0.4099E-05,-.2757E-04,0.1735E-04,0.1911E-04,0.1873E-04, &
6420 &0.1672E-04,0.1528E-04,0.1183E-04,0.9506E-05,0.5285E-06,-.4482E-07, &
6421 &-.4531E-05,0.5150E-05,-.1204E-06,-.6255E-06,-.3640E-02,-.1024E-03, &
6422 &-.4800E-04,-.8273E-05,0.1008E-04,-.3693E-05,-.2388E-04,0.1612E-04, &
6423 &0.1321E-04,0.1305E-04,0.1367E-04,0.9785E-05,0.3604E-05,0.1761E-05, &
6424 &-.4489E-05,-.2160E-05,-.8970E-06,0.1082E-05/
6425 data ( ( coen2o_5_new(k,i), i = 1, 11 ) , k= 1, 3 )/ &
6426 &-.1547E+02,-.1501E+02,-.1455E+02,-.1409E+02,-.1363E+02,-.1317E+02, &
6427 &-.1271E+02,-.1226E+02,-.1181E+02,-.1132E+02,-.1094E+02,0.1180E-01, &
6428 &0.1179E-01,0.1180E-01,0.1180E-01,0.1181E-01,0.1182E-01,0.1187E-01, &
6429 &0.1195E-01,0.1223E-01,0.1359E-01,0.1500E-01,-.6451E-04,-.6470E-04, &
6430 &-.6455E-04,-.6446E-04,-.6448E-04,-.6467E-04,-.6578E-04,-.6657E-04, &
6431 &-.7072E-04,-.8392E-04,-.1009E-03/
6432 data ( ( coech4_5_new(k,i), i = 1, 11 ) , k= 1, 3 )/ &
6433 &-.1469E+02,-.1423E+02,-.1377E+02,-.1331E+02,-.1285E+02,-.1239E+02, &
6434 &-.1193E+02,-.1147E+02,-.1101E+02,-.1054E+02,-.1010E+02,0.2568E-02, &
6435 &0.2559E-02,0.2564E-02,0.2575E-02,0.2568E-02,0.2575E-02,0.2566E-02, &
6436 &0.2572E-02,0.2589E-02,0.2741E-02,0.2859E-02,-.2855E-04,-.2877E-04, &
6437 &-.2893E-04,-.2867E-04,-.2855E-04,-.2867E-04,-.2857E-04,-.2876E-04, &
6438 &-.2814E-04,-.2486E-04,-.2352E-04/
6439 data ( ( coeh2o_5_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
6440 &-.1679E+02,-.1421E+02,-.1278E+02,-.1151E+02,-.1018E+02,-.8724E+01, &
6441 &-.7519E+01,-.6371E+01,-.5087E+01,-.3831E+01,-.3343E+01,-.3229E+01, &
6442 &-.3004E+01,-.2710E+01,-.2230E+01,-.1632E+01,-.7493E+00,0.2900E+00, &
6443 &0.1916E+01,0.4118E+01,-.1633E+02,-.1375E+02,-.1233E+02,-.1108E+02, &
6444 &-.9762E+01,-.8303E+01,-.7095E+01,-.5958E+01,-.4705E+01,-.3474E+01, &
6445 &-.2994E+01,-.2883E+01,-.2680E+01,-.2381E+01,-.1923E+01,-.1338E+01, &
6446 &-.5348E+00,0.4885E+00,0.2022E+01,0.4101E+01,-.1587E+02,-.1330E+02, &
6447 &-.1188E+02,-.1063E+02,-.9334E+01,-.7878E+01,-.6672E+01,-.5539E+01, &
6448 &-.4312E+01,-.3110E+01,-.2642E+01,-.2530E+01,-.2329E+01,-.2033E+01, &
6449 &-.1611E+01,-.1034E+01,-.2899E+00,0.6953E+00,0.2117E+01,0.4148E+01, &
6450 &-.1541E+02,-.1284E+02,-.1144E+02,-.1020E+02,-.8905E+01,-.7450E+01, &
6451 &-.6247E+01,-.5120E+01,-.3917E+01,-.2751E+01,-.2289E+01,-.2173E+01, &
6452 &-.1974E+01,-.1680E+01,-.1283E+01,-.7392E+00,-.2864E-01,0.9075E+00, &
6453 &0.2298E+01,0.4193E+01,-.1495E+02,-.1240E+02,-.1100E+02,-.9766E+01, &
6454 &-.8478E+01,-.7025E+01,-.5821E+01,-.4704E+01,-.3515E+01,-.2380E+01, &
6455 &-.1926E+01,-.1825E+01,-.1634E+01,-.1347E+01,-.9673E+00,-.4638E+00, &
6456 &0.2266E+00,0.1119E+01,0.2388E+01,0.4148E+01,-.1449E+02,-.1196E+02, &
6457 &-.1056E+02,-.9341E+01,-.8058E+01,-.6604E+01,-.5401E+01,-.4297E+01, &
6458 &-.3127E+01,-.2009E+01,-.1595E+01,-.1494E+01,-.1306E+01,-.1029E+01, &
6459 &-.6861E+00,-.1851E+00,0.4845E+00,0.1324E+01,0.2538E+01,0.4048E+01, &
6460 &-.1404E+02,-.1156E+02,-.1014E+02,-.8922E+01,-.7639E+01,-.6194E+01, &
6461 &-.4995E+01,-.3903E+01,-.2766E+01,-.1675E+01,-.1293E+01,-.1197E+01, &
6462 &-.1008E+01,-.7351E+00,-.4168E+00,0.7103E-01,0.7057E+00,0.1497E+01, &
6463 &0.2607E+01,0.3866E+01,-.1359E+02,-.1117E+02,-.9728E+01,-.8507E+01, &
6464 &-.7225E+01,-.5789E+01,-.4599E+01,-.3515E+01,-.2393E+01,-.1374E+01, &
6465 &-.1003E+01,-.9204E+00,-.7472E+00,-.4912E+00,-.1385E+00,0.3020E+00, &
6466 &0.8781E+00,0.1662E+01,0.2602E+01,0.3692E+01,-.1318E+02,-.1082E+02, &
6467 &-.9323E+01,-.8101E+01,-.6826E+01,-.5402E+01,-.4214E+01,-.3147E+01, &
6468 &-.2073E+01,-.1091E+01,-.7342E+00,-.6486E+00,-.4955E+00,-.2623E+00, &
6469 &0.8325E-01,0.4929E+00,0.1056E+01,0.1739E+01,0.2560E+01,0.3475E+01, &
6470 &-.1277E+02,-.1053E+02,-.8920E+01,-.7692E+01,-.6438E+01,-.5050E+01, &
6471 &-.3854E+01,-.2803E+01,-.1782E+01,-.8295E+00,-.4914E+00,-.4098E+00, &
6472 &-.2626E+00,-.4623E-01,0.2617E+00,0.6526E+00,0.1189E+01,0.1758E+01, &
6473 &0.2414E+01,0.3215E+01,-.1240E+02,-.1026E+02,-.8528E+01,-.7299E+01, &
6474 &-.6073E+01,-.4726E+01,-.3528E+01,-.2495E+01,-.1512E+01,-.5843E+00, &
6475 &-.2852E+00,-.2171E+00,-.7673E-01,0.1243E+00,0.4100E+00,0.8000E+00, &
6476 &0.1228E+01,0.1695E+01,0.2278E+01,0.2868E+01/
6477 data ( ( coeh2o_5_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
6478 &0.1204E-01,0.7706E-02,0.6638E-02,0.7243E-02,0.7680E-02,0.5452E-02, &
6479 &0.3557E-02,0.2130E-02,0.2271E-02,0.3087E-02,0.3014E-02,0.3048E-02, &
6480 &0.3219E-02,0.3560E-02,0.3806E-02,0.3584E-02,0.4275E-02,0.2983E-02, &
6481 &0.2555E-02,0.1260E-02,0.1205E-01,0.7751E-02,0.6707E-02,0.7213E-02, &
6482 &0.7529E-02,0.5346E-02,0.3357E-02,0.1917E-02,0.2007E-02,0.2577E-02, &
6483 &0.2549E-02,0.2596E-02,0.2542E-02,0.2886E-02,0.2759E-02,0.2819E-02, &
6484 &0.3234E-02,0.2266E-02,0.2982E-02,0.9786E-03,0.1207E-01,0.7798E-02, &
6485 &0.6725E-02,0.7193E-02,0.7357E-02,0.5232E-02,0.3185E-02,0.1721E-02, &
6486 &0.1677E-02,0.2172E-02,0.2133E-02,0.2169E-02,0.2169E-02,0.2152E-02, &
6487 &0.2124E-02,0.2462E-02,0.2520E-02,0.1767E-02,0.2956E-02,0.2229E-03, &
6488 &0.1209E-01,0.7870E-02,0.6740E-02,0.7117E-02,0.7196E-02,0.5153E-02, &
6489 &0.3017E-02,0.1577E-02,0.1401E-02,0.1784E-02,0.1860E-02,0.1845E-02, &
6490 &0.1683E-02,0.1516E-02,0.1836E-02,0.1864E-02,0.1418E-02,0.8931E-03, &
6491 &0.2304E-02,0.2570E-03,0.1215E-01,0.7968E-02,0.6728E-02,0.6976E-02, &
6492 &0.7038E-02,0.5049E-02,0.2906E-02,0.1479E-02,0.1208E-02,0.1313E-02, &
6493 &0.1452E-02,0.1438E-02,0.1389E-02,0.1262E-02,0.1286E-02,0.1193E-02, &
6494 &0.1107E-02,0.6817E-03,0.1556E-02,-.1493E-03,0.1223E-01,0.8121E-02, &
6495 &0.6734E-02,0.6903E-02,0.6912E-02,0.5013E-02,0.2808E-02,0.1337E-02, &
6496 &0.1165E-02,0.1084E-02,0.1340E-02,0.1399E-02,0.1313E-02,0.1174E-02, &
6497 &0.8843E-03,0.9987E-03,0.9803E-03,0.1086E-02,0.9965E-03,-.9692E-03, &
6498 &0.1229E-01,0.8279E-02,0.6713E-02,0.6800E-02,0.6847E-02,0.5006E-02, &
6499 &0.2661E-02,0.1253E-02,0.1035E-02,0.9595E-03,0.1264E-02,0.1258E-02, &
6500 &0.1156E-02,0.8092E-03,0.7080E-03,0.8455E-03,0.8113E-03,0.8759E-03, &
6501 &0.2292E-03,-.5840E-03,0.1244E-01,0.8559E-02,0.6642E-02,0.6655E-02, &
6502 &0.6701E-02,0.5003E-02,0.2486E-02,0.1133E-02,0.9329E-03,0.7777E-03, &
6503 &0.9160E-03,0.9158E-03,0.7865E-03,0.7290E-03,0.5881E-03,0.6781E-03, &
6504 &0.5059E-03,0.3786E-03,-.2816E-04,-.1370E-02,0.1252E-01,0.8676E-02, &
6505 &0.6502E-02,0.6573E-02,0.6754E-02,0.5131E-02,0.2346E-02,0.1110E-02, &
6506 &0.8200E-03,0.6781E-03,0.5184E-03,0.5828E-03,0.6087E-03,0.6010E-03, &
6507 &0.5973E-03,0.5822E-03,0.5167E-03,0.2478E-03,-.5116E-03,-.1448E-02, &
6508 &0.1275E-01,0.9012E-02,0.6375E-02,0.6409E-02,0.6763E-02,0.5223E-02, &
6509 &0.2154E-02,0.1186E-02,0.7161E-03,0.3788E-03,0.2895E-03,0.3548E-03, &
6510 &0.5469E-03,0.5274E-03,0.5283E-03,0.3407E-03,0.3951E-03,-.5743E-04, &
6511 &-.4179E-03,-.6078E-03,0.1267E-01,0.9445E-02,0.6244E-02,0.6370E-02, &
6512 &0.6707E-02,0.5162E-02,0.2073E-02,0.1367E-02,0.5272E-03,0.3591E-03, &
6513 &0.2973E-03,0.3340E-03,0.3241E-03,0.3011E-03,0.2689E-03,0.1879E-03, &
6514 &0.3560E-03,-.2123E-03,-.9343E-03,-.9746E-03/
6515 data ( ( coeh2o_5_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
6516 &-.1488E-04,-.4992E-04,-.1896E-04,-.1536E-04,-.1366E-04,-.1704E-04, &
6517 &-.9149E-05,0.1797E-06,-.3830E-05,-.3421E-05,-.4354E-05,-.3941E-05, &
6518 &-.5329E-05,0.9114E-05,0.6472E-05,0.2136E-05,-.2470E-04,0.6310E-05, &
6519 &-.8523E-05,0.1507E-04,-.1526E-04,-.4992E-04,-.1852E-04,-.1385E-04, &
6520 &-.1243E-04,-.1611E-04,-.1028E-04,0.1072E-05,-.7730E-06,-.3514E-05, &
6521 &-.1722E-05,-.4966E-06,0.9349E-06,0.8705E-05,0.2239E-05,-.5156E-05, &
6522 &-.3809E-05,0.5633E-05,-.6523E-05,0.1907E-04,-.1531E-04,-.5094E-04, &
6523 &-.1711E-04,-.1402E-04,-.1158E-04,-.1541E-04,-.8994E-05,0.5836E-06, &
6524 &-.7061E-06,-.2982E-05,0.2277E-05,0.3383E-05,0.3076E-05,0.4003E-05, &
6525 &0.1708E-06,-.6581E-05,0.2710E-05,0.7203E-05,-.1286E-05,-.3646E-05, &
6526 &-.1521E-04,-.5155E-04,-.1586E-04,-.1291E-04,-.1205E-04,-.1693E-04, &
6527 &-.7853E-05,-.1132E-05,-.2090E-05,0.4380E-05,0.3341E-05,0.2540E-06, &
6528 &0.4008E-07,-.7470E-05,-.3862E-05,-.4504E-05,0.5059E-05,0.1909E-05, &
6529 &-.1382E-04,-.1918E-04,-.1593E-04,-.5295E-04,-.1580E-04,-.1262E-04, &
6530 &-.1294E-04,-.1677E-04,-.7874E-05,-.1899E-05,-.5272E-05,-.1308E-06, &
6531 &-.2730E-05,-.1780E-05,-.3794E-05,-.5488E-05,-.5482E-05,0.1685E-05, &
6532 &0.5738E-05,0.8429E-07,0.1426E-04,-.8812E-05,-.1695E-04,-.5113E-04, &
6533 &-.1454E-04,-.1172E-04,-.1348E-04,-.1736E-04,-.6866E-05,-.2326E-05, &
6534 &-.4519E-05,-.3909E-05,-.2330E-05,-.2746E-05,-.4705E-05,-.7223E-05, &
6535 &0.6654E-06,-.2541E-06,0.2110E-05,-.9119E-05,-.1092E-04,-.1416E-04, &
6536 &-.1853E-04,-.4810E-04,-.1398E-04,-.1208E-04,-.1648E-04,-.1727E-04, &
6537 &-.5378E-05,-.3338E-05,-.3626E-07,-.3219E-05,-.3313E-06,0.1342E-05, &
6538 &-.2380E-05,-.7542E-05,0.2723E-05,0.3471E-05,-.5414E-05,-.8535E-05, &
6539 &-.8649E-05,0.9000E-05,-.1941E-04,-.4399E-04,-.1103E-04,-.1223E-04, &
6540 &-.1715E-04,-.1735E-04,-.3181E-05,-.4420E-05,-.4976E-05,-.2576E-05, &
6541 &0.4882E-07,0.2550E-05,0.8227E-06,-.1540E-05,-.4379E-05,-.3666E-05, &
6542 &-.1228E-05,-.6451E-05,0.3135E-06,0.1819E-04,-.1588E-04,-.3742E-04, &
6543 &-.1046E-04,-.1117E-04,-.1555E-04,-.1810E-04,-.3538E-05,-.5237E-05, &
6544 &-.4512E-05,-.4260E-05,-.1338E-05,-.1553E-05,-.2364E-06,-.2937E-05, &
6545 &-.3000E-05,-.4404E-05,-.4429E-05,0.5089E-05,-.3497E-05,0.1401E-05, &
6546 &-.1088E-04,-.1897E-04,-.1016E-04,-.1119E-04,-.1582E-04,-.1467E-04, &
6547 &-.4144E-05,-.7074E-05,-.2523E-05,-.1621E-06,-.2316E-05,-.1536E-05, &
6548 &-.1114E-05,-.3704E-05,-.4162E-05,0.5414E-05,-.6634E-05,0.7455E-06, &
6549 &0.7533E-05,-.1057E-04,-.6807E-05,-.1136E-04,-.9631E-05,-.1372E-04, &
6550 &-.1708E-04,-.1658E-04,-.4971E-05,-.8482E-05,0.4900E-06,-.2855E-05, &
6551 &-.8621E-06,0.6185E-06,0.2429E-05,0.2445E-05,-.4034E-06,-.4563E-05, &
6552 &-.8940E-05,0.1794E-05,0.2715E-05,-.5026E-06/
6554 ! block data ckd6_new
6555 !c *********************************************************************
6556 !c hk is the interval in the g (cumulative probability) space from 0
6557 !c to one. coeh2o is the coefficient to calculate the H2O absorption
6558 !c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
6559 !c pressures, and five cumulative probabilities ( Fu, 1991 ). The
6560 !c spectral region is from 2850 to 2500 cm**-1.
6561 !c in this block data, Z.F. has added the coefficients for SO2 and water
6562 !c vapor continuum absorption in Jun,2003.
6563 !c *********************************************************************
6564 ! common /band6_new/ hk(20), coehh62(3,11,20),coeso2(3,11) &
6565 ! ,coeh2o(3,11,20)
6566 real hk_6_new(20), coehh62_6_new(3,11,20),coeso2_6_new(3,11) &
6567 & ,coeh2o_6_new(3,11,20)
6568 data hk_6_new /3.16689E-02,7.09894E-02,1.04066E-01,0.127902, &
6569 & 0.140374,0.140374,0.127902,1.04066E-01,7.09894E-02,3.16689E-02 &
6570 & ,1.66678E-03 &
6571 & ,3.73628E-03,5.47716E-03,6.73167E-03,7.38811E-03,7.38811E-03, &
6572 & 6.73167E-03,5.47716E-03,3.73628E-03,1.66678E-03/
6573 data ( ( coehh62_6_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
6574 &-.9667E+01,-.9653E+01,-.9628E+01,-.9595E+01,-.9557E+01,-.9517E+01, &
6575 &-.9479E+01,-.9446E+01,-.9230E+01,-.7739E+01,-.7157E+01,-.7028E+01, &
6576 &-.6791E+01,-.6457E+01,-.5962E+01,-.5352E+01,-.4491E+01,-.3367E+01, &
6577 &-.1470E+01,0.8809E+00,-.9207E+01,-.9192E+01,-.9168E+01,-.9135E+01, &
6578 &-.9097E+01,-.9057E+01,-.9019E+01,-.8986E+01,-.8770E+01,-.7306E+01, &
6579 &-.6729E+01,-.6600E+01,-.6371E+01,-.6060E+01,-.5555E+01,-.5004E+01, &
6580 &-.4163E+01,-.3114E+01,-.1384E+01,0.8334E+00,-.8746E+01,-.8732E+01, &
6581 &-.8707E+01,-.8674E+01,-.8636E+01,-.8596E+01,-.8558E+01,-.8525E+01, &
6582 &-.8309E+01,-.6877E+01,-.6302E+01,-.6185E+01,-.5968E+01,-.5633E+01, &
6583 &-.5160E+01,-.4635E+01,-.3842E+01,-.2820E+01,-.1245E+01,0.6736E+00, &
6584 &-.8286E+01,-.8271E+01,-.8246E+01,-.8214E+01,-.8176E+01,-.8136E+01, &
6585 &-.8098E+01,-.8065E+01,-.7849E+01,-.6445E+01,-.5890E+01,-.5769E+01, &
6586 &-.5537E+01,-.5220E+01,-.4772E+01,-.4247E+01,-.3541E+01,-.2475E+01, &
6587 &-.1109E+01,0.6606E+00,-.7825E+01,-.7811E+01,-.7786E+01,-.7753E+01, &
6588 &-.7715E+01,-.7675E+01,-.7637E+01,-.7604E+01,-.7390E+01,-.6040E+01, &
6589 &-.5476E+01,-.5348E+01,-.5133E+01,-.4827E+01,-.4384E+01,-.3904E+01, &
6590 &-.3194E+01,-.2185E+01,-.9919E+00,0.4216E+00,-.7365E+01,-.7350E+01, &
6591 &-.7325E+01,-.7293E+01,-.7254E+01,-.7215E+01,-.7177E+01,-.7144E+01, &
6592 &-.6931E+01,-.5630E+01,-.5073E+01,-.4948E+01,-.4733E+01,-.4423E+01, &
6593 &-.4029E+01,-.3538E+01,-.2879E+01,-.1939E+01,-.9645E+00,0.3446E+00, &
6594 &-.6904E+01,-.6890E+01,-.6865E+01,-.6832E+01,-.6794E+01,-.6755E+01, &
6595 &-.6717E+01,-.6684E+01,-.6477E+01,-.5223E+01,-.4684E+01,-.4561E+01, &
6596 &-.4344E+01,-.4044E+01,-.3664E+01,-.3218E+01,-.2624E+01,-.1798E+01, &
6597 &-.8307E+00,0.2102E+00,-.6444E+01,-.6429E+01,-.6405E+01,-.6372E+01, &
6598 &-.6334E+01,-.6294E+01,-.6256E+01,-.6224E+01,-.6024E+01,-.4837E+01, &
6599 &-.4301E+01,-.4177E+01,-.3957E+01,-.3694E+01,-.3340E+01,-.2917E+01, &
6600 &-.2407E+01,-.1680E+01,-.8730E+00,-.1722E-01,-.5983E+01,-.5969E+01, &
6601 &-.5944E+01,-.5912E+01,-.5874E+01,-.5834E+01,-.5797E+01,-.5764E+01, &
6602 &-.5575E+01,-.4419E+01,-.3920E+01,-.3816E+01,-.3632E+01,-.3375E+01, &
6603 &-.3093E+01,-.2728E+01,-.2243E+01,-.1594E+01,-.9797E+00,-.2503E+00, &
6604 &-.5523E+01,-.5508E+01,-.5484E+01,-.5451E+01,-.5414E+01,-.5375E+01, &
6605 &-.5337E+01,-.5305E+01,-.5124E+01,-.4022E+01,-.3593E+01,-.3506E+01, &
6606 &-.3345E+01,-.3134E+01,-.2898E+01,-.2566E+01,-.2089E+01,-.1622E+01, &
6607 &-.1140E+01,-.5877E+00,-.5062E+01,-.5048E+01,-.5024E+01,-.4992E+01, &
6608 &-.4954E+01,-.4915E+01,-.4878E+01,-.4846E+01,-.4675E+01,-.3658E+01, &
6609 &-.3312E+01,-.3239E+01,-.3113E+01,-.2949E+01,-.2766E+01,-.2396E+01, &
6610 &-.2049E+01,-.1638E+01,-.1305E+01,-.9088E+00/
6611 data ( ( coehh62_6_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
6612 &-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01,-.2324E-01,-.2349E-01, &
6613 &-.2374E-01,-.2421E-01,-.1680E-01,-.2856E-03,0.1422E-02,0.1756E-02, &
6614 &0.2525E-02,0.3960E-02,0.5646E-02,0.7334E-02,0.7621E-02,0.7548E-02, &
6615 &0.5082E-02,0.5324E-02,-.2708E-01,-.2652E-01,-.2546E-01,-.2384E-01, &
6616 &-.2322E-01,-.2347E-01,-.2371E-01,-.2419E-01,-.1683E-01,-.3282E-03, &
6617 &0.1485E-02,0.1731E-02,0.2295E-02,0.3569E-02,0.5337E-02,0.5533E-02, &
6618 &0.5841E-02,0.5607E-02,0.4539E-02,0.5602E-02,-.2708E-01,-.2651E-01, &
6619 &-.2545E-01,-.2385E-01,-.2324E-01,-.2348E-01,-.2373E-01,-.2420E-01, &
6620 &-.1682E-01,-.2929E-03,0.1377E-02,0.1590E-02,0.2159E-02,0.3440E-02, &
6621 &0.4662E-02,0.5012E-02,0.4695E-02,0.3924E-02,0.3741E-02,0.4969E-02, &
6622 &-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01,-.2324E-01,-.2348E-01, &
6623 &-.2373E-01,-.2420E-01,-.1682E-01,-.3198E-03,0.1224E-02,0.1557E-02, &
6624 &0.2048E-02,0.2705E-02,0.3888E-02,0.4160E-02,0.3778E-02,0.2669E-02, &
6625 &0.2845E-02,0.5310E-02,-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01, &
6626 &-.2324E-01,-.2348E-01,-.2373E-01,-.2420E-01,-.1697E-01,-.5133E-03, &
6627 &0.9245E-03,0.1115E-02,0.1453E-02,0.1932E-02,0.3127E-02,0.2995E-02, &
6628 &0.2403E-02,0.3104E-02,0.1342E-02,0.5079E-02,-.2708E-01,-.2651E-01, &
6629 &-.2545E-01,-.2385E-01,-.2324E-01,-.2348E-01,-.2373E-01,-.2419E-01, &
6630 &-.1707E-01,-.1177E-02,0.1868E-03,0.4750E-03,0.9348E-03,0.1296E-02, &
6631 &0.2276E-02,0.2125E-02,0.2156E-02,0.3366E-02,0.2008E-02,0.4248E-02, &
6632 &-.2708E-01,-.2652E-01,-.2546E-01,-.2384E-01,-.2321E-01,-.2346E-01, &
6633 &-.2369E-01,-.2417E-01,-.1729E-01,-.2249E-02,-.4710E-03,-.4539E-03, &
6634 &0.6080E-04,0.7048E-03,0.1538E-02,0.2074E-02,0.2281E-02,0.3636E-02, &
6635 &0.3781E-02,0.5755E-02,-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01, &
6636 &-.2323E-01,-.2347E-01,-.2371E-01,-.2418E-01,-.1797E-01,-.3309E-02, &
6637 &-.1281E-02,-.1097E-02,-.5322E-03,0.2134E-04,0.7265E-03,0.1910E-02, &
6638 &0.1981E-02,0.3826E-02,0.4608E-02,0.5151E-02,-.2708E-01,-.2651E-01, &
6639 &-.2545E-01,-.2386E-01,-.2324E-01,-.2348E-01,-.2371E-01,-.2418E-01, &
6640 &-.1947E-01,-.4529E-02,-.2135E-02,-.1786E-02,-.1108E-02,-.1966E-03, &
6641 &0.8462E-03,0.1820E-02,0.2539E-02,0.4328E-02,0.3932E-02,0.5756E-02, &
6642 &-.2708E-01,-.2651E-01,-.2546E-01,-.2390E-01,-.2324E-01,-.2349E-01, &
6643 &-.2372E-01,-.2418E-01,-.2123E-01,-.5410E-02,-.2339E-02,-.2035E-02, &
6644 &-.1348E-02,-.6070E-03,-.4833E-05,0.1460E-02,0.3117E-02,0.3868E-02, &
6645 &0.4459E-02,0.5434E-02,-.2708E-01,-.2652E-01,-.2549E-01,-.2400E-01, &
6646 &-.2327E-01,-.2351E-01,-.2374E-01,-.2418E-01,-.2291E-01,-.6281E-02, &
6647 &-.2938E-02,-.2467E-02,-.2122E-02,-.1570E-02,-.3528E-03,0.1469E-02, &
6648 &0.2665E-02,0.3666E-02,0.3621E-02,0.5081E-02/
6649 data ( ( coehh62_6_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
6650 &-.3371E-04,-.1558E-04,0.1711E-04,0.6392E-04,0.9219E-04,0.1041E-03, &
6651 &0.1157E-03,0.1304E-03,0.2195E-03,0.6023E-04,0.3354E-04,0.3098E-04, &
6652 &0.2733E-04,0.3203E-04,0.1841E-04,0.3694E-04,0.2320E-04,0.2027E-04, &
6653 &-.1302E-04,-.5543E-04,-.3379E-04,-.1599E-04,0.1634E-04,0.6315E-04, &
6654 &0.9168E-04,0.1037E-03,0.1152E-03,0.1302E-03,0.2188E-03,0.6325E-04, &
6655 &0.3944E-04,0.3620E-04,0.3270E-04,0.4286E-04,0.2168E-04,0.2955E-04, &
6656 &0.1721E-04,0.8918E-05,-.6523E-05,-.5039E-04,-.3373E-04,-.1567E-04, &
6657 &0.1694E-04,0.6372E-04,0.9205E-04,0.1040E-03,0.1155E-03,0.1303E-03, &
6658 &0.2189E-03,0.7100E-04,0.4707E-04,0.4619E-04,0.4492E-04,0.4602E-04, &
6659 &0.2443E-04,0.3433E-04,0.1585E-04,0.5867E-05,0.3420E-06,-.1850E-04, &
6660 &-.3372E-04,-.1563E-04,0.1703E-04,0.6384E-04,0.9213E-04,0.1040E-03, &
6661 &0.1155E-03,0.1302E-03,0.2189E-03,0.7705E-04,0.5640E-04,0.5543E-04, &
6662 &0.4413E-04,0.4087E-04,0.2313E-04,0.2460E-04,0.2125E-04,-.4771E-05, &
6663 &-.1355E-05,-.3365E-04,-.3372E-04,-.1559E-04,0.1709E-04,0.6387E-04, &
6664 &0.9213E-04,0.1040E-03,0.1156E-03,0.1302E-03,0.2164E-03,0.8442E-04, &
6665 &0.5958E-04,0.5325E-04,0.4425E-04,0.3852E-04,0.2133E-04,0.2273E-04, &
6666 &0.1111E-05,-.6955E-05,-.1659E-04,0.1914E-04,-.3372E-04,-.1560E-04, &
6667 &0.1708E-04,0.6385E-04,0.9210E-04,0.1040E-03,0.1155E-03,0.1301E-03, &
6668 &0.2150E-03,0.8868E-04,0.5468E-04,0.5100E-04,0.4405E-04,0.3155E-04, &
6669 &0.1870E-04,0.7819E-05,0.1052E-05,-.1769E-04,0.2584E-05,0.7410E-05, &
6670 &-.3379E-04,-.1600E-04,0.1629E-04,0.6301E-04,0.9158E-04,0.1035E-03, &
6671 &0.1149E-03,0.1298E-03,0.2127E-03,0.8664E-04,0.5114E-04,0.4597E-04, &
6672 &0.3562E-04,0.2479E-04,0.1163E-04,0.9757E-05,0.3488E-05,-.1156E-04, &
6673 &-.2332E-04,-.3154E-05,-.3374E-04,-.1571E-04,0.1685E-04,0.6352E-04, &
6674 &0.9197E-04,0.1039E-03,0.1153E-03,0.1300E-03,0.2025E-03,0.9169E-04, &
6675 &0.4326E-04,0.3635E-04,0.2582E-04,0.2002E-04,0.9380E-05,0.1084E-04, &
6676 &-.1823E-05,-.1982E-04,-.1654E-04,-.1981E-04,-.3372E-04,-.1564E-04, &
6677 &0.1696E-04,0.6357E-04,0.9211E-04,0.1040E-03,0.1154E-03,0.1300E-03, &
6678 &0.1785E-03,0.8311E-04,0.3462E-04,0.3216E-04,0.2805E-04,0.1893E-04, &
6679 &0.2209E-04,0.1619E-04,0.2757E-05,-.2293E-04,0.1417E-06,-.2688E-04, &
6680 &-.3372E-04,-.1560E-04,0.1687E-04,0.6296E-04,0.9204E-04,0.1039E-03, &
6681 &0.1152E-03,0.1297E-03,0.1489E-03,0.8721E-04,0.4197E-04,0.4071E-04, &
6682 &0.3529E-04,0.2399E-04,0.2257E-04,0.1966E-04,-.4268E-05,-.7444E-05, &
6683 &0.4240E-05,-.2269E-04,-.3374E-04,-.1570E-04,0.1632E-04,0.6129E-04, &
6684 &0.9169E-04,0.1035E-03,0.1148E-03,0.1290E-03,0.1207E-03,0.1016E-03, &
6685 &0.5146E-04,0.4638E-04,0.4090E-04,0.3605E-04,0.4308E-04,0.1763E-04, &
6686 &0.1664E-04,-.4294E-05,0.1195E-04,-.6244E-05/
6687 data ( ( coeso2_6_new(k,j), j = 1, 11 ), k=1, 3 ) / &
6688 &-.1280E+02,-.1234E+02,-.1189E+02,-.1145E+02,-.1103E+02,-.1072E+02, &
6689 &-.1049E+02,-.1032E+02,-.1020E+02,-.9898E+01,-.9803E+01,0.1000E-01, &
6690 &0.1011E-01,0.1017E-01,0.1055E-01,0.1117E-01,0.1183E-01,0.1209E-01, &
6691 &0.1229E-01,0.1207E-01,0.1084E-01,0.1142E-01,-.4992E-04,-.5246E-04, &
6692 &-.5238E-04,-.5332E-04,-.6118E-04,-.5978E-04,-.5063E-04,-.4731E-04, &
6693 &-.4110E-04,-.6332E-04,-.4993E-04/
6694 data ( ( coeh2o_6_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
6695 &-.4600E+02,-.3047E+02,-.2846E+02,-.2708E+02,-.2564E+02,-.2430E+02, &
6696 &-.2317E+02,-.2161E+02,-.1833E+02,-.1505E+02,-.1438E+02,-.1424E+02, &
6697 &-.1400E+02,-.1363E+02,-.1317E+02,-.1251E+02,-.1163E+02,-.1052E+02, &
6698 &-.8621E+01,-.6305E+01,-.4600E+02,-.3001E+02,-.2800E+02,-.2662E+02, &
6699 &-.2518E+02,-.2384E+02,-.2271E+02,-.2115E+02,-.1787E+02,-.1462E+02, &
6700 &-.1397E+02,-.1383E+02,-.1358E+02,-.1322E+02,-.1275E+02,-.1216E+02, &
6701 &-.1132E+02,-.1025E+02,-.8523E+01,-.6305E+01,-.4600E+02,-.2955E+02, &
6702 &-.2754E+02,-.2616E+02,-.2472E+02,-.2338E+02,-.2225E+02,-.2069E+02, &
6703 &-.1741E+02,-.1419E+02,-.1354E+02,-.1340E+02,-.1317E+02,-.1280E+02, &
6704 &-.1234E+02,-.1179E+02,-.1101E+02,-.9958E+01,-.8383E+01,-.6464E+01, &
6705 &-.4600E+02,-.2909E+02,-.2708E+02,-.2570E+02,-.2425E+02,-.2292E+02, &
6706 &-.2179E+02,-.2023E+02,-.1695E+02,-.1377E+02,-.1314E+02,-.1299E+02, &
6707 &-.1275E+02,-.1239E+02,-.1195E+02,-.1141E+02,-.1070E+02,-.9646E+01, &
6708 &-.8247E+01,-.6477E+01,-.4600E+02,-.2862E+02,-.2661E+02,-.2524E+02, &
6709 &-.2379E+02,-.2246E+02,-.2133E+02,-.1977E+02,-.1651E+02,-.1338E+02, &
6710 &-.1273E+02,-.1258E+02,-.1234E+02,-.1201E+02,-.1157E+02,-.1108E+02, &
6711 &-.1038E+02,-.9328E+01,-.8163E+01,-.6721E+01,-.4600E+02,-.2816E+02, &
6712 &-.2615E+02,-.2478E+02,-.2333E+02,-.2200E+02,-.2087E+02,-.1931E+02, &
6713 &-.1608E+02,-.1297E+02,-.1233E+02,-.1219E+02,-.1196E+02,-.1163E+02, &
6714 &-.1121E+02,-.1071E+02,-.1004E+02,-.9092E+01,-.8137E+01,-.6840E+01, &
6715 &-.4600E+02,-.2771E+02,-.2570E+02,-.2432E+02,-.2288E+02,-.2154E+02, &
6716 &-.2041E+02,-.1885E+02,-.1572E+02,-.1258E+02,-.1196E+02,-.1182E+02, &
6717 &-.1158E+02,-.1125E+02,-.1085E+02,-.1037E+02,-.9773E+01,-.8976E+01, &
6718 &-.7992E+01,-.6928E+01,-.4600E+02,-.2724E+02,-.2523E+02,-.2386E+02, &
6719 &-.2241E+02,-.2108E+02,-.1995E+02,-.1840E+02,-.1542E+02,-.1221E+02, &
6720 &-.1157E+02,-.1143E+02,-.1120E+02,-.1089E+02,-.1053E+02,-.1010E+02, &
6721 &-.9581E+01,-.8824E+01,-.8043E+01,-.7155E+01,-.4600E+02,-.2678E+02, &
6722 &-.2477E+02,-.2340E+02,-.2195E+02,-.2062E+02,-.1949E+02,-.1797E+02, &
6723 &-.1517E+02,-.1180E+02,-.1121E+02,-.1108E+02,-.1086E+02,-.1062E+02, &
6724 &-.1030E+02,-.9901E+01,-.9409E+01,-.8739E+01,-.8128E+01,-.7388E+01, &
6725 &-.4595E+02,-.2593E+02,-.2418E+02,-.2290E+02,-.2147E+02,-.2015E+02, &
6726 &-.1904E+02,-.1756E+02,-.1505E+02,-.1143E+02,-.1090E+02,-.1079E+02, &
6727 &-.1061E+02,-.1038E+02,-.1012E+02,-.9753E+01,-.9284E+01,-.8780E+01, &
6728 &-.8300E+01,-.7749E+01,-.4594E+02,-.2538E+02,-.2372E+02,-.2244E+02, &
6729 &-.2101E+02,-.1970E+02,-.1860E+02,-.1723E+02,-.1497E+02,-.1109E+02, &
6730 &-.1064E+02,-.1056E+02,-.1041E+02,-.1023E+02,-.9992E+01,-.9603E+01, &
6731 &-.9239E+01,-.8818E+01,-.8469E+01,-.8081E+01/
6732 data ( ( coeh2o_6_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
6733 &-.1732E-03,-.1040E+00,0.4355E-01,0.3802E-01,0.3763E-01,0.3498E-01, &
6734 &0.3418E-01,0.3305E-01,0.2441E-01,0.5405E-02,0.4747E-02,0.4815E-02, &
6735 &0.4948E-02,0.5712E-02,0.6499E-02,0.8091E-02,0.7739E-02,0.7929E-02, &
6736 &0.5507E-02,0.5324E-02,-.1732E-03,-.1082E+00,0.4355E-01,0.3802E-01, &
6737 &0.3761E-01,0.3500E-01,0.3418E-01,0.3308E-01,0.2480E-01,0.5392E-02, &
6738 &0.4896E-02,0.4827E-02,0.4807E-02,0.5315E-02,0.6330E-02,0.6395E-02, &
6739 &0.6155E-02,0.5730E-02,0.4539E-02,0.5602E-02,-.1732E-03,-.1124E+00, &
6740 &0.4356E-01,0.3801E-01,0.3763E-01,0.3499E-01,0.3418E-01,0.3306E-01, &
6741 &0.2507E-01,0.5563E-02,0.4808E-02,0.4727E-02,0.4704E-02,0.5231E-02, &
6742 &0.5865E-02,0.5900E-02,0.4793E-02,0.3895E-02,0.3741E-02,0.4969E-02, &
6743 &-.1732E-03,-.1165E+00,0.4356E-01,0.3802E-01,0.3763E-01,0.3498E-01, &
6744 &0.3419E-01,0.3307E-01,0.2544E-01,0.5598E-02,0.4705E-02,0.4709E-02, &
6745 &0.4613E-02,0.4609E-02,0.5258E-02,0.4956E-02,0.4074E-02,0.2861E-02, &
6746 &0.2990E-02,0.5310E-02,-.1732E-03,-.1207E+00,0.4355E-01,0.3801E-01, &
6747 &0.3763E-01,0.3498E-01,0.3420E-01,0.3307E-01,0.2585E-01,0.5504E-02, &
6748 &0.4420E-02,0.4295E-02,0.4078E-02,0.3915E-02,0.4571E-02,0.3703E-02, &
6749 &0.3252E-02,0.3150E-02,0.1358E-02,0.4710E-02,-.1732E-03,-.1249E+00, &
6750 &0.4356E-01,0.3803E-01,0.3764E-01,0.3498E-01,0.3421E-01,0.3311E-01, &
6751 &0.2631E-01,0.5258E-02,0.3788E-02,0.3741E-02,0.3749E-02,0.3160E-02, &
6752 &0.3813E-02,0.2749E-02,0.2548E-02,0.3451E-02,0.2008E-02,0.4013E-02, &
6753 &-.1732E-03,-.1291E+00,0.4355E-01,0.3803E-01,0.3762E-01,0.3501E-01, &
6754 &0.3421E-01,0.3317E-01,0.2691E-01,0.4396E-02,0.3183E-02,0.2727E-02, &
6755 &0.2707E-02,0.2743E-02,0.3062E-02,0.2843E-02,0.2648E-02,0.3747E-02, &
6756 &0.3891E-02,0.5570E-02,-.1732E-03,-.1333E+00,0.4356E-01,0.3803E-01, &
6757 &0.3764E-01,0.3502E-01,0.3422E-01,0.3333E-01,0.2696E-01,0.3569E-02, &
6758 &0.2360E-02,0.2106E-02,0.2282E-02,0.2378E-02,0.2520E-02,0.3106E-02, &
6759 &0.2731E-02,0.3933E-02,0.4528E-02,0.5413E-02,-.1732E-03,-.1375E+00, &
6760 &0.4356E-01,0.3806E-01,0.3766E-01,0.3502E-01,0.3427E-01,0.3365E-01, &
6761 &0.2573E-01,0.2764E-02,0.1964E-02,0.1815E-02,0.2121E-02,0.2308E-02, &
6762 &0.2642E-02,0.2912E-02,0.3808E-02,0.4920E-02,0.4192E-02,0.5815E-02, &
6763 &-.2013E-03,0.6002E-01,0.4420E-01,0.3855E-01,0.3797E-01,0.3514E-01, &
6764 &0.3447E-01,0.3441E-01,0.2400E-01,0.2426E-02,0.2285E-02,0.2307E-02, &
6765 &0.2456E-02,0.2597E-02,0.2516E-02,0.3262E-02,0.4367E-02,0.4726E-02, &
6766 &0.4604E-02,0.5849E-02,0.0000E+00,0.6025E-01,0.4432E-01,0.3864E-01, &
6767 &0.3801E-01,0.3526E-01,0.3472E-01,0.3484E-01,0.2350E-01,0.2538E-02, &
6768 &0.2770E-02,0.2631E-02,0.2378E-02,0.2408E-02,0.2965E-02,0.4432E-02, &
6769 &0.4542E-02,0.5035E-02,0.4633E-02,0.5444E-02/
6770 data ( ( coeh2o_6_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
6771 &0.6305E-09,-.3186E-02,-.1769E-03,-.8462E-04,-.9882E-04,-.9498E-04, &
6772 &-.9584E-04,-.9217E-04,-.4288E-07,-.1434E-04,-.9830E-05,-.9121E-05, &
6773 &-.1076E-05,0.3692E-05,0.2042E-04,0.2711E-04,0.1446E-04,0.1809E-04, &
6774 &-.1982E-04,-.3973E-04,0.6305E-09,-.3261E-02,-.1763E-03,-.8508E-04, &
6775 &-.9858E-04,-.9520E-04,-.9582E-04,-.9287E-04,-.7187E-05,-.9534E-05, &
6776 &-.2394E-05,-.9578E-06,0.4418E-05,0.9583E-05,0.1496E-04,0.2117E-04, &
6777 &0.1408E-04,0.6408E-05,-.6277E-05,-.5039E-04,0.6305E-09,-.3338E-02, &
6778 &-.1765E-03,-.8448E-04,-.9877E-04,-.9522E-04,-.9598E-04,-.9268E-04, &
6779 &-.1109E-04,-.3322E-05,0.5691E-05,0.4565E-05,0.1416E-04,0.1524E-04, &
6780 &0.1264E-04,0.2417E-04,0.1825E-04,0.4172E-05,0.3421E-06,-.1850E-04, &
6781 &0.6305E-09,-.3414E-02,-.1767E-03,-.8451E-04,-.9882E-04,-.9486E-04, &
6782 &-.9598E-04,-.9240E-04,-.1727E-04,0.4190E-05,0.1412E-04,0.1219E-04, &
6783 &0.1657E-04,0.1401E-04,0.3647E-05,0.1615E-04,0.2174E-04,0.1934E-05, &
6784 &-.4005E-05,-.3364E-04,0.6305E-09,-.3491E-02,-.1769E-03,-.8450E-04, &
6785 &-.9913E-04,-.9498E-04,-.9614E-04,-.9239E-04,-.1977E-04,0.1724E-04, &
6786 &0.1983E-04,0.1352E-04,0.9765E-05,0.1277E-04,0.5305E-05,0.1480E-04, &
6787 &0.1430E-05,-.1099E-04,-.6924E-05,0.1404E-04,0.6305E-09,-.3567E-02, &
6788 &-.1770E-03,-.8474E-04,-.9894E-04,-.9473E-04,-.9617E-04,-.9291E-04, &
6789 &-.2151E-04,0.2346E-04,0.1371E-04,0.1147E-04,0.1094E-04,0.1407E-04, &
6790 &0.2222E-05,-.1062E-05,0.1531E-05,-.1748E-04,0.1407E-04,0.1847E-04, &
6791 &0.6305E-09,-.3642E-02,-.1764E-03,-.8523E-04,-.9892E-04,-.9513E-04, &
6792 &-.9623E-04,-.9317E-04,-.7163E-05,0.1964E-04,0.1505E-04,0.1327E-04, &
6793 &0.4409E-05,0.1338E-06,-.8370E-05,-.5770E-05,-.4403E-05,-.1135E-05, &
6794 &-.1786E-04,-.1126E-04,0.6305E-09,-.3719E-02,-.1765E-03,-.8487E-04, &
6795 &-.9882E-04,-.9518E-04,-.9627E-04,-.9435E-04,0.4101E-05,0.2025E-04, &
6796 &0.1494E-05,0.2371E-05,-.4260E-05,-.1145E-04,-.1501E-04,-.5205E-05, &
6797 &-.7078E-05,-.2613E-04,-.1220E-04,-.2457E-04,0.6305E-09,-.3795E-02, &
6798 &-.1768E-03,-.8520E-04,-.9896E-04,-.9557E-04,-.9678E-04,-.9741E-04, &
6799 &0.7907E-05,0.2320E-05,-.1138E-04,-.1181E-04,-.1171E-04,-.4526E-05, &
6800 &-.9526E-06,-.1426E-05,-.1523E-04,-.3728E-04,-.7095E-05,-.3584E-04, &
6801 &0.6154E-06,-.2967E-03,-.1664E-03,-.8674E-04,-.1013E-03,-.9641E-04, &
6802 &-.9766E-04,-.1016E-03,0.3196E-04,-.2726E-05,-.9340E-05,-.8610E-05, &
6803 &-.6137E-05,-.1048E-04,-.3945E-05,-.9921E-05,-.1724E-04,-.2295E-04, &
6804 &0.4577E-05,-.2728E-04,0.0000E+00,-.3212E-03,-.1657E-03,-.8656E-04, &
6805 &-.1007E-03,-.9824E-04,-.9977E-04,-.8734E-04,0.3091E-04,0.8470E-06, &
6806 &-.1287E-04,-.1108E-04,-.8110E-05,-.7669E-05,-.7991E-05,-.1662E-04, &
6807 &-.1272E-04,-.2306E-04,-.1398E-05,-.1044E-04/
6809 ! block data ckd7_new
6810 !c *********************************************************************
6811 !c hk is the interval in the g (cumulative probability) space from 0
6812 !c to one. coeh2o is the coefficient to calculate the H2O absorption
6813 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
6814 !c teen pressures, and two cumulative probabilities ( Fu, 1991 ).
6815 !c The spectral region is from 2200 to 1900 cm**-1.
6816 !c *********************************************************************
6817 ! common /band7_new/ hk(2), coeh2o(3,19,2)
6818 real hk_7_new(2), coeh2o_7_new(3,19,2)
6819 data hk_7_new / 0.7, 0.3 /
6820 data ( ( ( coeh2o_7_new(k,j,i), i = 1, 2 ), j = 1, 19 ), k = 1, 3) / &
6821 &-.2008E+02,-.1467E+02,-.2004E+02,-.1426E+02,-.2001E+02,-.1386E+02, &
6822 &-.1998E+02,-.1345E+02,-.1995E+02,-.1304E+02,-.1992E+02,-.1263E+02, &
6823 &-.1989E+02,-.1223E+02,-.1986E+02,-.1183E+02,-.1984E+02,-.1143E+02, &
6824 &-.1758E+02,-.1038E+02,-.1602E+02,-.9480E+01,-.1469E+02,-.8752E+01, &
6825 &-.1349E+02,-.8218E+01,-.1255E+02,-.7677E+01,-.1174E+02,-.7184E+01, &
6826 &-.1110E+02,-.6735E+01,-.1056E+02,-.6332E+01,-.1019E+02,-.5975E+01, &
6827 &-.9874E+01,-.5644E+01, .2533E-02, .2269E-01, .2575E-02, .2263E-01, &
6828 & .2554E-02, .2267E-01, .2491E-02, .2250E-01, .2449E-02, .2244E-01, &
6829 & .2344E-02, .2234E-01, .2219E-02, .2208E-01, .5694E-02, .2190E-01, &
6830 & .9650E-02, .2162E-01, .3286E-01, .1848E-01, .2987E-01, .1578E-01, &
6831 & .2527E-01, .1465E-01, .2175E-01, .1386E-01, .2056E-01, .1235E-01, &
6832 & .1963E-01, .1116E-01, .1926E-01, .1040E-01, .2014E-01, .1040E-01, &
6833 & .2024E-01, .1042E-01, .1972E-01, .1080E-01,-.8754E-05,-.6698E-04, &
6834 &-.1104E-04,-.6432E-04,-.1142E-04,-.6051E-04,-.1180E-04,-.6128E-04, &
6835 &-.1180E-04,-.6242E-04,-.1218E-04,-.6280E-04,-.1218E-04,-.6204E-04, &
6836 & .5328E-04,-.5709E-04, .1275E-03,-.5214E-04,-.1370E-03,-.4148E-04, &
6837 &-.1100E-03,-.3045E-04,-.9248E-04,-.3197E-04,-.7346E-04,-.2436E-04, &
6838 &-.5100E-04,-.2131E-04,-.5861E-04,-.2550E-04,-.5328E-04,-.3311E-04, &
6839 &-.6090E-04,-.4225E-04,-.5443E-04,-.4415E-04,-.4034E-04,-.4339E-04/
6841 ! block data ckd8_new
6842 !c *********************************************************************
6843 !c hk is the interval in the g (cumulative probability) space from 0
6844 !c to one. coeh2o is the coefficient to calculate the H2O absorption
6845 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
6846 !c teen pressures, and three cumulative probabilities ( Fu, 1991 ).
6847 !c The spectral region is from 1900 to 1700 cm**-1.
6848 !c *********************************************************************
6849 ! common /band8_new/ hk(3), coeh2o(3,19,3),coeno(3,19)
6850 real hk_8_new(3), coeh2o_8_new(3,19,3),coeno_8_new(3,19)
6851 data hk_8_new / 0.2, 0.7, 0.1 /
6852 data ((( coeh2o_8_new(k,j,i), i = 1, 3), j = 1, 19), k = 1, 3)/ &
6853 &-.2283E+02,-.1639E+02,-.6155E+01,-.2237E+02,-.1595E+02,-.5775E+01, &
6854 &-.2191E+02,-.1551E+02,-.5381E+01,-.2145E+02,-.1507E+02,-.5004E+01, &
6855 &-.2099E+02,-.1463E+02,-.4617E+01,-.2053E+02,-.1419E+02,-.4218E+01, &
6856 &-.2025E+02,-.1375E+02,-.3806E+01,-.2021E+02,-.1330E+02,-.3403E+01, &
6857 &-.2018E+02,-.1287E+02,-.2993E+01,-.1998E+02,-.1091E+02,-.2586E+01, &
6858 &-.1744E+02,-.9171E+01,-.2162E+01,-.1490E+02,-.7642E+01,-.1763E+01, &
6859 &-.1303E+02,-.6526E+01,-.1373E+01,-.1113E+02,-.5846E+01,-.9699E+00, &
6860 &-.9814E+01,-.5280E+01,-.5955E+00,-.8582E+01,-.4787E+01,-.2510E+00, &
6861 &-.8020E+01,-.4350E+01, .2770E-01,-.7571E+01,-.3942E+01, .2406E+00, &
6862 &-.7140E+01,-.3537E+01, .3567E+00, .3722E-01, .1505E-01, .6615E-02, &
6863 & .3722E-01, .1518E-01, .5840E-02, .3720E-01, .1526E-01, .5170E-02, &
6864 & .3399E-01, .1530E-01, .4773E-02, .3012E-01, .1551E-01, .4333E-02, &
6865 & .2625E-01, .1553E-01, .3956E-02, .2240E-01, .1562E-01, .3454E-02, &
6866 & .1846E-01, .1574E-01, .3161E-02, .1446E-01, .1572E-01, .3098E-02, &
6867 & .5924E-02, .8875E-02, .2658E-02, .2204E-01, .7096E-02, .2504E-02, &
6868 & .1591E-01, .5233E-02, .2292E-02, .8855E-02, .4249E-02, .2190E-02, &
6869 & .5422E-02, .3496E-02, .2041E-02, .4919E-02, .3621E-02, .2200E-02, &
6870 & .6657E-02, .3663E-02, .2248E-02, .8645E-02, .3852E-02, .2118E-02, &
6871 & .8771E-02, .3873E-02, .2176E-02, .9043E-02, .3747E-02, .2079E-02, &
6872 &-.1568E-03,-.4681E-04, .4567E-05,-.1568E-03,-.4605E-04,-.3425E-05, &
6873 &-.1572E-03,-.4605E-04,-.1104E-04,-.2154E-03,-.4453E-04,-.6851E-05, &
6874 &-.2843E-03,-.4225E-04,-.7231E-05,-.3562E-03,-.4110E-04,-.7231E-05, &
6875 &-.3692E-03,-.4110E-04,-.1028E-04,-.3007E-03,-.4263E-04,-.6470E-05, &
6876 &-.2325E-03,-.3996E-04,-.8373E-05,-.5290E-04,-.7612E-05,-.4948E-05, &
6877 &-.7422E-04,-.1256E-04,-.8449E-05,-.3501E-04,-.1446E-04,-.4834E-05, &
6878 & .4529E-04,-.2246E-04,-.2893E-05, .6470E-05,-.1789E-04,-.7498E-05, &
6879 &-.4948E-05,-.1713E-04,-.8183E-05,-.5481E-04,-.1713E-04,-.1447E-04, &
6880 &-.4986E-04,-.1903E-04,-.1353E-04,-.5138E-04,-.1484E-04,-.1147E-04, &
6881 &-.5328E-04,-.1560E-04,-.6588E-05/
6882 data ( ( coeno_8_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
6883 &-.1164E+02,-.1119E+02,-.1074E+02,-.1030E+02,-.9853E+01,-.9400E+01, &
6884 &-.8947E+01,-.8497E+01,-.8044E+01,-.7594E+01,-.7142E+01,-.6689E+01, &
6885 &-.6245E+01,-.5808E+01,-.5399E+01,-.4998E+01,-.4544E+01,-.4134E+01, &
6886 &-.3773E+01,0.4822E-02,0.4864E-02,0.4915E-02,0.4985E-02,0.5089E-02, &
6887 &0.5150E-02,0.5189E-02,0.5210E-02,0.5268E-02,0.5291E-02,0.5348E-02, &
6888 &0.5368E-02,0.5450E-02,0.5606E-02,0.5740E-02,0.6009E-02,0.6353E-02, &
6889 &0.6841E-02,0.7601E-02,-.3353E-04,-.3355E-04,-.3262E-04,-.3182E-04, &
6890 &-.3045E-04,-.3080E-04,-.3168E-04,-.3100E-04,-.3167E-04,-.3193E-04, &
6891 &-.3146E-04,-.3226E-04,-.3289E-04,-.3499E-04,-.3260E-04,-.3156E-04, &
6892 &-.3860E-04,-.4087E-04,-.4527E-04/
6894 ! block data ckd9_new
6895 !c *********************************************************************
6896 !c hk is the interval in the g (cumulative probability) space from 0
6897 !c to one. coeh2o is the coefficient to calculate the H2O absorption
6898 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
6899 !c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
6900 !c The spectral region is from 1700 to 1400 cm**-1.
6901 !c *********************************************************************
6902 ! common /band9_new/ hk(4), coeh2o(3,19,4),coeno2(3,19)
6903 real hk_9_new(4), coeh2o_9_new(3,19,4),coeno2_9_new(3,19)
6904 data hk_9_new / 0.22, 0.51, 0.22, 0.05 /
6905 data ( ( ( coeh2o_9_new(k,j,i), i = 1, 4 ), j = 1, 19), k = 1, 3)/ &
6906 &-.2066E+02,-.1464E+02,-.8301E+01,-.3548E+01,-.2025E+02,-.1419E+02, &
6907 &-.7905E+01,-.3260E+01,-.2019E+02,-.1374E+02,-.7495E+01,-.2927E+01, &
6908 &-.2013E+02,-.1329E+02,-.7078E+01,-.2584E+01,-.2007E+02,-.1284E+02, &
6909 &-.6675E+01,-.2247E+01,-.2001E+02,-.1239E+02,-.6268E+01,-.1890E+01, &
6910 &-.1996E+02,-.1194E+02,-.5853E+01,-.1530E+01,-.1991E+02,-.1150E+02, &
6911 &-.5441E+01,-.1133E+01,-.1987E+02,-.1105E+02,-.5022E+01,-.7447E+00, &
6912 &-.1575E+02,-.9657E+01,-.4191E+01,-.3728E+00,-.1329E+02,-.8133E+01, &
6913 &-.3638E+01, .1616E-01,-.1181E+02,-.6675E+01,-.3178E+01, .4083E+00, &
6914 &-.1036E+02,-.5655E+01,-.2731E+01, .7953E+00,-.8628E+01,-.4990E+01, &
6915 &-.2303E+01, .1153E+01,-.7223E+01,-.4453E+01,-.1877E+01, .1454E+01, &
6916 &-.6567E+01,-.3974E+01,-.1461E+01, .1663E+01,-.6077E+01,-.3551E+01, &
6917 &-.1071E+01, .1800E+01,-.5651E+01,-.3136E+01,-.7005E+00, .1809E+01, &
6918 &-.5241E+01,-.2726E+01,-.3859E+00, .1781E+01, .1315E-01, .4542E-02, &
6919 & .3496E-02, .4877E-02, .9650E-02, .4542E-02, .3098E-02, .3956E-02, &
6920 & .6154E-02, .4626E-02, .2763E-02, .3077E-02, .2658E-02, .4626E-02, &
6921 & .2512E-02, .2261E-02, .2658E-02, .4689E-02, .2219E-02, .1405E-02, &
6922 & .2700E-02, .4752E-02, .1926E-02, .7473E-03, .2658E-02, .4773E-02, &
6923 & .1737E-02, .5066E-03, .4668E-02, .4815E-02, .1507E-02, .1842E-03, &
6924 & .8541E-02, .4794E-02, .1382E-02,-.2156E-03, .1022E-01, .2198E-02, &
6925 & .3977E-03,-.2910E-03, .5484E-02, .6698E-03, .0000E+00,-.2339E-03, &
6926 & .3349E-02, .1068E-02,-.2512E-03,-.4228E-03, .1884E-02, .2093E-03, &
6927 &-.3977E-03,-.6405E-03,-.8373E-04,-.5233E-03,-.4124E-03,-.5945E-03, &
6928 & .7536E-03,-.6698E-03,-.4919E-03,-.4794E-03, .3600E-02,-.4605E-03, &
6929 &-.4375E-03,-.3517E-03, .3873E-02,-.5861E-03,-.3203E-03,-.4689E-03, &
6930 & .3935E-02,-.7326E-03,-.2072E-03,-.4228E-03, .4124E-02,-.8582E-03, &
6931 &-.4187E-04,-.5945E-03,-.8525E-04, .1865E-04,-.1142E-05, .2664E-05, &
6932 &-.1313E-03, .1865E-04, .0000E+00, .1256E-04,-.6470E-04, .1865E-04, &
6933 &-.3045E-05, .8754E-05, .3805E-06, .1789E-04,-.6851E-05, .5328E-05, &
6934 & .1142E-05, .1827E-04,-.6090E-05, .4148E-05, .1142E-05, .1865E-04, &
6935 &-.3806E-05,-.3768E-05,-.1903E-05, .1751E-04,-.4948E-05, .3121E-05, &
6936 & .3159E-04, .1979E-04,-.3045E-05,-.9896E-06, .1005E-03, .1789E-04, &
6937 &-.6089E-05,-.1865E-05,-.2207E-04, .1941E-04, .1903E-05, .2322E-05, &
6938 &-.1675E-04, .6090E-05,-.7611E-06, .4397E-05, .3425E-04, .3806E-06, &
6939 & .1522E-05, .3806E-05, .4796E-04, .1522E-05,-.3806E-06, .3654E-05, &
6940 &-.6851E-05, .2664E-05,-.3920E-05,-.6850E-06,-.1370E-04, .5328E-05, &
6941 &-.6584E-05,-.8716E-05,-.8374E-10, .1522E-05,-.6356E-05, .1294E-05, &
6942 &-.9515E-05, .7612E-06,-.3235E-05,-.1066E-05,-.7612E-05, .1142E-05, &
6943 &-.4529E-05, .3730E-05,-.2664E-05,-.3806E-06,-.3501E-05,-.5328E-06/
6944 data ( ( coeno2_9_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
6945 &-.9663E+01,-.9349E+01,-.9029E+01,-.8713E+01,-.8379E+01,-.8038E+01, &
6946 &-.7698E+01,-.7371E+01,-.7058E+01,-.6777E+01,-.6518E+01,-.6299E+01, &
6947 &-.6124E+01,-.6005E+01,-.5938E+01,-.5904E+01,-.5890E+01,-.5868E+01, &
6948 &-.5853E+01,0.2549E-01,0.2453E-01,0.2346E-01,0.2252E-01,0.2161E-01, &
6949 &0.2069E-01,0.1963E-01,0.1875E-01,0.1790E-01,0.1709E-01,0.1646E-01, &
6950 &0.1587E-01,0.1542E-01,0.1501E-01,0.1484E-01,0.1461E-01,0.1466E-01, &
6951 &0.1455E-01,0.1414E-01,-.5673E-04,-.5248E-04,-.4935E-04,-.4199E-04, &
6952 &-.3850E-04,-.3829E-04,-.4200E-04,-.4360E-04,-.4090E-04,-.3483E-04, &
6953 &-.3077E-04,-.2846E-04,-.2721E-04,-.2576E-04,-.2186E-04,-.2060E-04, &
6954 &-.1960E-04,-.2490E-04,-.2946E-04/
6956 ! block data ckd10_new
6957 !c *********************************************************************
6958 !c hk is the interval in the g (cumulative probability) space from 0
6959 !c to one. coeh2o is the coefficient to calculate the H2O absorption
6960 !c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
6961 !c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
6962 !c The spectral region is from 1400 to 1250 cm**-1. coech4 and coen2o
6963 !c are the coefficients to calculate the CH4 and N2O absorption coe-
6964 !c fficients in units of (cm-atm)**-1 at three temperature, nineteen
6965 !c pressures, and one cumulative probability (Fu, 1991), respectively.
6966 !c *********************************************************************
6967 ! common /band10_new/hk(4), coeh2o(3,19,4), coech4(3,19) &
6968 ! ,coen2o(3,19) &
6969 ! ,coeso2(3,19)
6970 real hk_10_new(4), coeh2o_10_new(3,19,4), coech4_10_new(3,19) &
6971 & ,coen2o_10_new(3,19) &
6972 & ,coeso2_10_new(3,19)
6973 data hk_10_new / 0.28, 0.42, 0.25, 0.05 /
6974 data ( ( ( coeh2o_10_new(k,j,i), i = 1, 4), j = 1, 19), k = 1, 3)/ &
6975 &-.2023E+02,-.1641E+02,-.1171E+02,-.6090E+01,-.2016E+02,-.1595E+02, &
6976 &-.1133E+02,-.5867E+01,-.2011E+02,-.1550E+02,-.1095E+02,-.5660E+01, &
6977 &-.2005E+02,-.1504E+02,-.1055E+02,-.5407E+01,-.2001E+02,-.1459E+02, &
6978 &-.1015E+02,-.5137E+01,-.1997E+02,-.1413E+02,-.9749E+01,-.4852E+01, &
6979 &-.1993E+02,-.1367E+02,-.9337E+01,-.4534E+01,-.1990E+02,-.1321E+02, &
6980 &-.8920E+01,-.4211E+01,-.1987E+02,-.1276E+02,-.8506E+01,-.3889E+01, &
6981 &-.1645E+02,-.1179E+02,-.7711E+01,-.3613E+01,-.1442E+02,-.1081E+02, &
6982 &-.6942E+01,-.3316E+01,-.1308E+02,-.9950E+01,-.6344E+01,-.2950E+01, &
6983 &-.1212E+02,-.9217E+01,-.5904E+01,-.2577E+01,-.1131E+02,-.8559E+01, &
6984 &-.5519E+01,-.2256E+01,-.1064E+02,-.7962E+01,-.5183E+01,-.1929E+01, &
6985 &-.1013E+02,-.7447E+01,-.4833E+01,-.1643E+01,-.9712E+01,-.7071E+01, &
6986 &-.4485E+01,-.1410E+01,-.9305E+01,-.6760E+01,-.4145E+01,-.1249E+01, &
6987 &-.8966E+01,-.6477E+01,-.3820E+01,-.1114E+01, .7913E-02, .8206E-02, &
6988 & .1509E-01, .1869E-01, .4228E-02, .8247E-02, .1467E-01, .1783E-01, &
6989 & .2010E-02, .8227E-02, .1442E-01, .1687E-01, .1947E-02, .8289E-02, &
6990 & .1394E-01, .1568E-01, .1863E-02, .8289E-02, .1346E-01, .1484E-01, &
6991 & .1842E-02, .8415E-02, .1310E-01, .1400E-01, .1800E-02, .8457E-02, &
6992 & .1275E-01, .1377E-01, .1696E-02, .8478E-02, .1220E-01, .1321E-01, &
6993 & .1842E-02, .8478E-02, .1189E-01, .1250E-01, .1409E-01, .8624E-02, &
6994 & .1254E-01, .1214E-01, .9043E-02, .1045E-01, .1225E-01, .1260E-01, &
6995 & .8561E-02, .1202E-01, .1181E-01, .1296E-01, .1114E-01, .1235E-01, &
6996 & .1191E-01, .1330E-01, .1199E-01, .1271E-01, .1195E-01, .1371E-01, &
6997 & .1415E-01, .1315E-01, .1218E-01, .1361E-01, .1478E-01, .1338E-01, &
6998 & .1296E-01, .1306E-01, .1518E-01, .1375E-01, .1365E-01, .1334E-01, &
6999 & .1530E-01, .1411E-01, .1392E-01, .1327E-01, .1547E-01, .1507E-01, &
7000 & .1390E-01, .1264E-01,-.1089E-03,-.2740E-04,-.2017E-04,-.5519E-04, &
7001 &-.4491E-04,-.2740E-04,-.1408E-04,-.5937E-04,-.6090E-05,-.2702E-04, &
7002 &-.6470E-05,-.4719E-04,-.7232E-05,-.2740E-04,-.6089E-05,-.4910E-04, &
7003 &-.7231E-05,-.2969E-04,-.4186E-05,-.5366E-04,-.6090E-05,-.3045E-04, &
7004 &-.2284E-05,-.4986E-04,-.4568E-05,-.3121E-04,-.4948E-05,-.5100E-04, &
7005 &-.3426E-05,-.3007E-04,-.7993E-05,-.4910E-04, .1522E-05,-.2931E-04, &
7006 &-.9896E-05,-.5366E-04,-.5823E-04,-.1599E-04,-.1713E-04,-.4110E-04, &
7007 &-.3121E-04,-.1713E-04,-.3159E-04,-.3578E-04,-.3996E-04,-.1598E-04, &
7008 &-.3958E-04,-.4605E-04,-.3349E-04,-.1751E-04,-.3844E-04,-.5576E-04, &
7009 &-.2626E-04,-.2474E-04,-.3920E-04,-.4464E-04,-.1979E-04,-.3045E-04, &
7010 &-.3958E-04,-.5336E-04,-.2893E-04,-.3616E-04,-.3996E-04,-.4754E-04, &
7011 &-.2398E-04,-.3083E-04,-.4415E-04,-.5119E-04,-.2702E-04,-.2664E-04, &
7012 &-.4605E-04,-.4038E-04,-.2398E-04,-.2360E-04,-.4948E-04,-.5149E-04/
7013 data ( ( coech4_10_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
7014 &-.8909E+01,-.8464E+01,-.8018E+01,-.7573E+01,-.7133E+01,-.6687E+01, &
7015 &-.6240E+01,-.5803E+01,-.5377E+01,-.4534E+01,-.3983E+01,-.3502E+01, &
7016 &-.3062E+01,-.2648E+01,-.2265E+01,-.1896E+01,-.1568E+01,-.1234E+01, &
7017 &-.9298E+00, .9629E-03, .9838E-03, .1088E-02, .1172E-02, .1256E-02, &
7018 & .1402E-02, .1528E-02, .1633E-02, .1716E-02, .4815E-03,-.3977E-03, &
7019 &-.5652E-03,-.5024E-03,-.4605E-03,-.4563E-03,-.4438E-03,-.4521E-03, &
7020 &-.4312E-03,-.3789E-03,-.1294E-04,-.1408E-04,-.1522E-04,-.1675E-04, &
7021 &-.1751E-04,-.1941E-04,-.2246E-04,-.2207E-04,-.1827E-04,-.1256E-04, &
7022 &-.9515E-05,-.6470E-05,-.3045E-05,-.3806E-05,-.2055E-05,-.3730E-05, &
7023 &-.7612E-06,-.3806E-05, .1256E-05/
7024 data ( ( coen2o_10_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
7025 &-.7863E+01,-.7412E+01,-.6963E+01,-.6514E+01,-.6065E+01,-.5611E+01, &
7026 &-.5167E+01,-.4720E+01,-.4283E+01,-.3454E+01,-.2858E+01,-.2404E+01, &
7027 &-.1922E+01,-.1491E+01,-.1097E+01,-.7177E+00,-.3548E+00, .1218E-01, &
7028 & .3088E+00, .4459E-02, .4542E-02, .4668E-02, .4752E-02, .4815E-02, &
7029 & .4919E-02, .5087E-02, .5254E-02, .5296E-02, .2324E-02, .2093E-02, &
7030 & .2294E-02, .2125E-02, .2058E-02, .1920E-02, .1786E-02, .1689E-02, &
7031 & .1788E-02, .2144E-02,-.7231E-05,-.7231E-05,-.7231E-05,-.6470E-05, &
7032 &-.6851E-05,-.7231E-05,-.5709E-05,-.6470E-05,-.4186E-05, .8754E-05, &
7033 &-.7612E-05,-.9134E-06,-.8640E-05,-.8487E-05,-.8259E-05,-.9553E-05, &
7034 &-.8107E-05,-.1654E-04,-.1858E-04/
7035 data ( ( coeso2_10_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
7036 &-.7207E+01,-.6750E+01,-.6292E+01,-.5835E+01,-.5384E+01,-.4925E+01, &
7037 &-.4473E+01,-.4029E+01,-.3601E+01,-.3191E+01,-.2785E+01,-.2451E+01, &
7038 &-.2170E+01,-.1973E+01,-.1819E+01,-.1732E+01,-.1612E+01,-.1532E+01, &
7039 &-.1394E+01,0.1824E-01,0.1826E-01,0.1828E-01,0.1832E-01,0.1831E-01, &
7040 &0.1837E-01,0.1848E-01,0.1864E-01,0.1885E-01,0.1913E-01,0.1972E-01, &
7041 &0.2057E-01,0.2158E-01,0.2202E-01,0.2255E-01,0.2291E-01,0.2286E-01, &
7042 &0.2112E-01,0.1848E-01,-.1230E-03,-.1229E-03,-.1228E-03,-.1232E-03, &
7043 &-.1222E-03,-.1225E-03,-.1231E-03,-.1238E-03,-.1239E-03,-.1249E-03, &
7044 &-.1298E-03,-.1263E-03,-.1288E-03,-.1230E-03,-.1238E-03,-.1111E-03, &
7045 &-.1067E-03,-.7294E-04,-.4405E-04/
7047 ! block data ckd11_new
7048 ! *********************************************************************
7049 ! hk is the interval in the g (cumulative probability) space from 0
7050 ! to one. coeh2o is the coefficient to calculate the H2O absorption
7051 ! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
7052 ! teen pressures, and three cumulative probabilities ( Fu, 1991 ).
7053 ! The spectral region is from 1250 to 1100 cm**-1. coech4 and coen2o
7054 ! are the coefficients to calculate the CH4 and N2O absorption coe-
7055 ! fficients in units of (cm-atm)**-1 at three temperature, nineteen
7056 ! pressures, and one cumulative probability (Fu, 1991), respectively.
7057 ! *********************************************************************
7058 real hk_11_new(3), coeh2o_11_new(3,19,3), coech4_11_new(3,19) &
7059 & , coen2o_11_new(3,19) &
7060 & , c11CFC11_11_new, c11CFC12_11_new
7061 data hk_11_new / 0.80, 0.15, 0.05 /
7062 data c11CFC11_11_new / 0.13273E+02 /
7063 data c11CFC12_11_new / 0.19158E+02 /
7064 data ( ( ( coeh2o_11_new(k,j,i), i = 1, 3), j = 1, 19), k = 1, 3)/ &
7065 &-.2005E+02,-.1548E+02,-.1021E+02,-.2001E+02,-.1504E+02,-.1001E+02, &
7066 &-.1997E+02,-.1459E+02,-.9814E+01,-.1993E+02,-.1416E+02,-.9595E+01, &
7067 &-.1989E+02,-.1373E+02,-.9349E+01,-.1985E+02,-.1328E+02,-.9072E+01, &
7068 &-.1982E+02,-.1286E+02,-.8833E+01,-.1957E+02,-.1243E+02,-.8566E+01, &
7069 &-.1911E+02,-.1200E+02,-.8276E+01,-.1743E+02,-.1134E+02,-.7958E+01, &
7070 &-.1625E+02,-.1078E+02,-.7629E+01,-.1524E+02,-.1036E+02,-.7334E+01, &
7071 &-.1429E+02,-.9970E+01,-.7051E+01,-.1348E+02,-.9620E+01,-.6749E+01, &
7072 &-.1282E+02,-.9270E+01,-.6505E+01,-.1229E+02,-.8932E+01,-.6277E+01, &
7073 &-.1186E+02,-.8628E+01,-.6120E+01,-.1148E+02,-.8345E+01,-.6049E+01, &
7074 &-.1112E+02,-.8066E+01,-.5906E+01, .1842E-02, .2131E-01, .3033E-01, &
7075 & .1905E-02, .2137E-01, .2841E-01, .1926E-02, .2135E-01, .2696E-01, &
7076 & .1926E-02, .2133E-01, .2514E-01, .1884E-02, .2154E-01, .2401E-01, &
7077 & .5589E-02, .2156E-01, .2321E-01, .9483E-02, .2156E-01, .2210E-01, &
7078 & .1333E-01, .2150E-01, .2133E-01, .1725E-01, .2154E-01, .2074E-01, &
7079 & .2254E-01, .1999E-01, .2005E-01, .2118E-01, .1926E-01, .1978E-01, &
7080 & .1936E-01, .1920E-01, .1963E-01, .1905E-01, .1911E-01, .1934E-01, &
7081 & .1909E-01, .1903E-01, .1920E-01, .1922E-01, .1901E-01, .1899E-01, &
7082 & .1934E-01, .1930E-01, .1974E-01, .1966E-01, .1909E-01, .2014E-01, &
7083 & .1976E-01, .1905E-01, .1984E-01, .1963E-01, .1940E-01, .1897E-01, &
7084 &-.1522E-05,-.6013E-04,-.5062E-04,-.2665E-05,-.6204E-04,-.5519E-04, &
7085 &-.3806E-05,-.6394E-04,-.5633E-04,-.4567E-05,-.6280E-04,-.5214E-04, &
7086 &-.6090E-05,-.6128E-04,-.5290E-04, .6051E-04,-.6242E-04,-.5823E-04, &
7087 & .1313E-03,-.6013E-04,-.5176E-04, .1336E-03,-.5747E-04,-.4072E-04, &
7088 & .6318E-04,-.5671E-04,-.3996E-04,-.5595E-04,-.3996E-04,-.4263E-04, &
7089 &-.3958E-04,-.4719E-04,-.4453E-04,-.3387E-04,-.5138E-04,-.5100E-04, &
7090 &-.5252E-04,-.4986E-04,-.4491E-04,-.5100E-04,-.4453E-04,-.4529E-04, &
7091 &-.5176E-04,-.4795E-04,-.4453E-04,-.5557E-04,-.5176E-04,-.5062E-04, &
7092 &-.5747E-04,-.4795E-04,-.5633E-04,-.5709E-04,-.4643E-04,-.3806E-04, &
7093 &-.5481E-04,-.5671E-04,-.4948E-04/
7094 data ( ( coech4_11_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
7095 &-.1207E+02,-.1162E+02,-.1116E+02,-.1070E+02,-.1024E+02,-.9777E+01, &
7096 &-.9319E+01,-.8858E+01,-.8398E+01,-.7384E+01,-.6643E+01,-.6081E+01, &
7097 &-.5602E+01,-.5188E+01,-.4822E+01,-.4479E+01,-.4184E+01,-.3884E+01, &
7098 &-.3627E+01, .1036E-01, .1036E-01, .1040E-01, .1040E-01, .1045E-01, &
7099 & .1047E-01, .1049E-01, .1055E-01, .1059E-01, .1059E-01, .1026E-01, &
7100 & .1011E-01, .1024E-01, .1049E-01, .1072E-01, .1089E-01, .1109E-01, &
7101 & .1153E-01, .1191E-01,-.4910E-04,-.4834E-04,-.4910E-04,-.4910E-04, &
7102 &-.4910E-04,-.4872E-04,-.4834E-04,-.4948E-04,-.5100E-04,-.5633E-04, &
7103 &-.6166E-04,-.5595E-04,-.5366E-04,-.5366E-04,-.5328E-04,-.5328E-04, &
7104 &-.4948E-04,-.5519E-04,-.5595E-04/
7105 data ( ( coen2o_11_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
7106 &-.9461E+01,-.9003E+01,-.8543E+01,-.8084E+01,-.7629E+01,-.7166E+01, &
7107 &-.6707E+01,-.6249E+01,-.5793E+01,-.5312E+01,-.4847E+01,-.4393E+01, &
7108 &-.3974E+01,-.3587E+01,-.3231E+01,-.2885E+01,-.2602E+01,-.2358E+01, &
7109 &-.2108E+01, .4710E-02, .4752E-02, .4773E-02, .4773E-02, .4815E-02, &
7110 & .4877E-02, .4898E-02, .4982E-02, .5066E-02, .5296E-02, .5149E-02, &
7111 & .5129E-02, .5024E-02, .4752E-02, .4501E-02, .4270E-02, .4019E-02, &
7112 & .3646E-02, .2759E-02,-.1484E-04,-.1408E-04,-.1446E-04,-.1446E-04, &
7113 &-.1522E-04,-.1560E-04,-.1522E-04,-.1522E-04,-.1598E-04,-.1484E-04, &
7114 &-.9895E-05,-.1028E-04,-.7612E-05,-.1903E-05, .1903E-05, .0000E+00, &
7115 & .2283E-05, .6166E-05,-.2740E-05/
7117 ! block data ckd12_new
7118 ! *********************************************************************
7119 ! hk is the interval in the g (cumulative probability) space from 0
7120 ! to one. coeo3 is the coefficient to calculate the ozone absorption
7121 ! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
7122 ! teen pressures, and five cumulative probabilities ( Fu, 1991 ).
7123 ! The spectral region is from 1100 to 980 cm**-1. coeh2o is the
7124 ! coefficient to calculate the H2O absorption coefficient in units
7125 ! of (cm-atm)**-1 at three temperature, nineteen pressures, and one
7126 ! cumulative probability ( Fu, 1991 ).
7127 ! *********************************************************************
7128 real hk_12_new(5), coeo3_12_new(3,19,5), coeh2o_12_new(3,19) , &
7129 & c12CFC11_12_new, c12CFC12_12_new
7130 data hk_12_new / 0.45, 0.30, 0.2, 0.04, 0.01 /
7131 data c12CFC11_12_new / 0.13857E+02 /
7132 data c12CFC12_12_new / 0.96058E+01 /
7133 data ( ( ( coeo3_12_new(k,j,i), i = 1, 5 ), j = 1, 19), k = 1, 3)/ &
7134 &-.6590E+01,-.3912E+01,-.8513E+00, .2731E+01, .5515E+01,-.6157E+01, &
7135 &-.3583E+01,-.7292E+00, .2740E+01, .5508E+01,-.5731E+01,-.3242E+01, &
7136 &-.5800E+00, .2782E+01, .5485E+01,-.5301E+01,-.2901E+01,-.4131E+00, &
7137 & .2805E+01, .5455E+01,-.4879E+01,-.2551E+01,-.2288E+00, .2878E+01, &
7138 & .5416E+01,-.4449E+01,-.2201E+01,-.2228E-01, .3000E+01, .5374E+01, &
7139 &-.4018E+01,-.1843E+01, .2055E+00, .3143E+01, .5342E+01,-.3615E+01, &
7140 &-.1502E+01, .4561E+00, .3288E+01, .5204E+01,-.3228E+01,-.1172E+01, &
7141 & .7099E+00, .3396E+01, .5077E+01,-.2828E+01,-.8499E+00, .9664E+00, &
7142 & .3463E+01, .4893E+01,-.2480E+01,-.5393E+00, .1229E+01, .3493E+01, &
7143 & .4656E+01,-.2181E+01,-.2653E+00, .1504E+01, .3456E+01, .4398E+01, &
7144 &-.1950E+01,-.1469E-01, .1735E+01, .3387E+01, .4115E+01,-.1788E+01, &
7145 & .2517E+00, .1919E+01, .3251E+01, .3832E+01,-.1677E+01, .5027E+00, &
7146 & .2032E+01, .3088E+01, .3581E+01,-.1637E+01, .7373E+00, .2100E+01, &
7147 & .2910E+01, .3364E+01,-.1650E+01, .9383E+00, .2123E+01, .2793E+01, &
7148 & .3150E+01,-.1658E+01, .1091E+01, .2112E+01, .2683E+01, .3021E+01, &
7149 &-.1654E+01, .1163E+01, .2099E+01, .2602E+01, .2871E+01, .9498E-02, &
7150 & .8894E-02, .1161E-01, .8828E-02,-.1669E-02, .9613E-02, .8347E-02, &
7151 & .1053E-01, .8462E-02,-.1612E-02, .9700E-02, .7829E-02, .9101E-02, &
7152 & .7915E-02,-.1439E-02, .9815E-02, .7167E-02, .7981E-02, .7282E-02, &
7153 &-.1094E-02, .9671E-02, .6764E-02, .6930E-02, .5613E-02,-.8347E-03, &
7154 & .9613E-02, .6312E-02, .6225E-02, .4145E-02,-.1295E-02, .9728E-02, &
7155 & .6099E-02, .5293E-02, .2965E-02,-.1756E-02, .9844E-02, .5915E-02, &
7156 & .4496E-02, .1871E-02,-.2044E-02, .9930E-02, .5817E-02, .3509E-02, &
7157 & .1324E-02,-.2044E-02, .9988E-02, .5535E-02, .2711E-02, .6620E-03, &
7158 &-.1813E-02, .1034E-01, .5247E-02, .1926E-02,-.2303E-03,-.1842E-02, &
7159 & .1058E-01, .4795E-02, .1197E-02,-.9498E-03,-.2216E-02, .1084E-01, &
7160 & .4414E-02, .6188E-03,-.1123E-02,-.2303E-02, .1079E-01, .3926E-02, &
7161 & .1756E-03,-.1497E-02,-.2274E-02, .1039E-01, .3425E-02,-.1900E-03, &
7162 &-.1353E-02,-.2389E-02, .9815E-02, .2769E-02,-.6620E-03,-.1756E-02, &
7163 &-.1785E-02, .9818E-02, .2444E-02,-.1016E-02,-.1410E-02,-.1698E-02, &
7164 & .1074E-01, .3218E-02,-.1235E-02,-.1900E-02,-.2533E-02, .1145E-01, &
7165 & .3684E-02,-.1364E-02,-.1353E-02,-.1957E-02,-.4030E-04,-.2375E-04, &
7166 &-.3814E-05,-.4943E-04,-.3166E-04,-.3742E-04,-.1871E-04,-.1137E-04, &
7167 &-.4317E-04,-.2878E-04,-.3526E-04,-.2015E-04,-.1295E-04,-.4821E-04, &
7168 &-.2303E-04,-.3382E-04,-.2087E-04,-.1519E-04,-.2231E-04,-.1871E-04, &
7169 &-.3454E-04,-.2087E-04,-.8109E-05,-.6476E-05,-.1511E-04,-.3454E-04, &
7170 &-.1820E-04,-.1269E-05,-.1439E-04,-.5037E-05,-.4173E-04,-.2598E-04, &
7171 & .6645E-05,-.1943E-04,-.2087E-04,-.3454E-04,-.2267E-04, .2159E-05, &
7172 &-.2231E-04,-.2159E-05,-.2950E-04,-.2080E-04, .2159E-06,-.4317E-05, &
7173 & .1799E-04,-.3670E-04,-.1590E-04,-.4461E-05,-.9354E-05,-.3598E-05, &
7174 &-.3216E-04,-.1475E-04,-.2231E-05,-.1295E-04,-.2878E-05,-.3576E-04, &
7175 &-.7347E-05,-.1022E-04,-.2159E-05,-.7915E-05,-.3015E-04,-.5230E-05, &
7176 &-.5109E-05,-.6476E-05,-.7196E-05,-.2331E-04,-.1079E-04,-.4102E-05, &
7177 & .1439E-05,-.1223E-04,-.2216E-04,-.1094E-04,-.5325E-05,-.7196E-06, &
7178 &-.1655E-04,-.1036E-04,-.7627E-05,-.2878E-05, .5037E-05,-.1295E-04, &
7179 & .1029E-04,-.1346E-04,-.4821E-05,-.7915E-05, .7915E-05, .2835E-04, &
7180 &-.2893E-04,-.1367E-05,-.7196E-05,-.1871E-04, .3965E-04,-.3310E-04, &
7181 &-.3310E-05,-.7195E-06, .2303E-04/
7182 data ( ( coeh2o_12_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
7183 &-.1984E+02,-.1983E+02,-.1982E+02,-.1981E+02,-.1963E+02,-.1917E+02, &
7184 &-.1871E+02,-.1825E+02,-.1779E+02,-.1639E+02,-.1545E+02,-.1484E+02, &
7185 &-.1433E+02,-.1387E+02,-.1345E+02,-.1305E+02,-.1268E+02,-.1231E+02, &
7186 &-.1196E+02, .6071E-03, .2072E-02, .6196E-02, .1030E-01, .1436E-01, &
7187 & .1846E-01, .2259E-01, .2667E-01, .2993E-01, .2878E-01, .2803E-01, &
7188 & .2851E-01, .2864E-01, .2874E-01, .2862E-01, .2859E-01, .2853E-01, &
7189 & .2868E-01, .2887E-01,-.3808E-06, .2474E-04, .9895E-04, .1728E-03, &
7190 & .1911E-03, .1165E-03, .4225E-04,-.3121E-04,-.8982E-04,-.9553E-04, &
7191 &-.9705E-04,-.9591E-04,-.9287E-04,-.9172E-04,-.9096E-04,-.9134E-04, &
7192 &-.9248E-04,-.1050E-03,-.1031E-03/
7194 ! block data ckd13_new
7195 ! *********************************************************************
7196 ! hk is the interval in the g (cumulative probability) space from 0
7197 ! to one. coeh2o is the coefficient to calculate the H2O absorption
7198 ! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
7199 ! teen pressures, and two cumulative probabilities ( Fu, 1991 ).
7200 ! The spectral region is from 980 to 800 cm**-1.
7201 ! *********************************************************************
7202 real hk_13_new(2), coeh2o_13_new(3,19,2) &
7203 & , c13CFC11_13_new, c13CFC12_13_new
7204 data hk_13_new / 0.95, 0.05 /
7205 data c13CFC11_13_new / 0.38552E+01 /
7206 data c13CFC12_13_new / 0.84634E+01 /
7207 data ( ( ( coeh2o_13_new(k,j,i), i = 1, 2), j = 1, 19), k = 1, 3)/ &
7208 &-.1992E+02,-.1446E+02,-.1992E+02,-.1405E+02,-.1991E+02,-.1363E+02, &
7209 &-.1990E+02,-.1322E+02,-.1989E+02,-.1282E+02,-.1989E+02,-.1242E+02, &
7210 &-.1988E+02,-.1201E+02,-.1987E+02,-.1159E+02,-.1986E+02,-.1119E+02, &
7211 &-.1982E+02,-.1079E+02,-.1817E+02,-.1039E+02,-.1659E+02,-.1000E+02, &
7212 &-.1537E+02,-.9623E+01,-.1460E+02,-.9266E+01,-.1406E+02,-.8959E+01, &
7213 &-.1354E+02,-.8676E+01,-.1309E+02,-.8411E+01,-.1267E+02,-.8232E+01, &
7214 &-.1229E+02,-.8094E+01, .5024E-03, .3199E-01, .5652E-03, .3199E-01, &
7215 & .6071E-03, .3211E-01, .6489E-03, .3199E-01, .6699E-03, .3178E-01, &
7216 & .6908E-03, .3157E-01, .6908E-03, .3109E-01, .6698E-03, .3075E-01, &
7217 & .6698E-03, .3054E-01, .1474E-01, .3000E-01, .3085E-01, .2960E-01, &
7218 & .3659E-01, .2935E-01, .3016E-01, .2920E-01, .2834E-01, .2895E-01, &
7219 & .2780E-01, .2870E-01, .2753E-01, .2843E-01, .2755E-01, .2820E-01, &
7220 & .2765E-01, .2732E-01, .2769E-01, .2705E-01, .6299E-09,-.7993E-04, &
7221 &-.3802E-06,-.7992E-04,-.3802E-06,-.8525E-04,-.3808E-06,-.8449E-04, &
7222 &-.7610E-06,-.7764E-04,-.1142E-05,-.7231E-04,-.1142E-05,-.7345E-04, &
7223 &-.2284E-05,-.8259E-04,-.2284E-05,-.8031E-04, .2436E-03,-.7878E-04, &
7224 & .7612E-05,-.8525E-04,-.1248E-03,-.9439E-04,-.9477E-04,-.9172E-04, &
7225 &-.8982E-04,-.8640E-04,-.7916E-04,-.6813E-04,-.7574E-04,-.6090E-04, &
7226 &-.7612E-04,-.7117E-04,-.7498E-04,-.7041E-04,-.7269E-04,-.7992E-04/
7228 ! block data ckd14_new
7229 ! **********************************************************************
7230 ! hk is the interval in the g (cumulative probability) space from 0
7231 ! to one. coehca and coehcb are the coefficients to calculate the
7232 ! H2O and CO2 overlapping absorption coefficients in units of (cm-
7233 ! atm)**-1 at three temperature, nineteen pressures, and ten cumu-
7234 ! lative probabilities (Fu, 1991). The spectral region is from 800
7235 ! to 670 cm**-1.
7236 ! **********************************************************************
7237 real hk_14_new(10), coehca_14_new(3,19,10), coehcb_14_new(3,19,10) &
7238 & ,coech3cl_14_new(3,19)
7239 data hk_14_new / .3,.3,.2,.12,.06,.012,.004,.0025,.0011,.0004 /
7240 data ( ( (coehca_14_new(k,j,i), i = 1, 10), j = 1, 19), k = 1, 3)/ &
7241 &-.1847E+02,-.1399E+02,-.1106E+02,-.8539E+01,-.5852E+01,-.3295E+01, &
7242 &-.1208E+01,-.6272E-01, .2055E+01, .6071E+01,-.1801E+02,-.1357E+02, &
7243 &-.1067E+02,-.8171E+01,-.5562E+01,-.3071E+01,-.1073E+01, .1033E+00, &
7244 & .2055E+01, .6071E+01,-.1755E+02,-.1314E+02,-.1027E+02,-.7798E+01, &
7245 &-.5224E+01,-.2823E+01,-.9280E+00, .2723E+00, .2165E+01, .5969E+01, &
7246 &-.1709E+02,-.1272E+02,-.9868E+01,-.7404E+01,-.4880E+01,-.2569E+01, &
7247 &-.6908E+00, .4453E+00, .2241E+01, .5969E+01,-.1663E+02,-.1230E+02, &
7248 &-.9467E+01,-.7013E+01,-.4535E+01,-.2297E+01,-.4408E+00, .6353E+00, &
7249 & .2359E+01, .5969E+01,-.1617E+02,-.1188E+02,-.9050E+01,-.6619E+01, &
7250 &-.4160E+01,-.1967E+01,-.1687E+00, .8213E+00, .2421E+01, .5969E+01, &
7251 &-.1571E+02,-.1147E+02,-.8629E+01,-.6230E+01,-.3771E+01,-.1648E+01, &
7252 & .1573E+00, .1019E+01, .2511E+01, .5884E+01,-.1525E+02,-.1106E+02, &
7253 &-.8215E+01,-.5841E+01,-.3393E+01,-.1331E+01, .4013E+00, .1198E+01, &
7254 & .2654E+01, .5794E+01,-.1480E+02,-.1066E+02,-.7800E+01,-.5454E+01, &
7255 &-.3032E+01,-.9870E+00, .6323E+00, .1373E+01, .2905E+01, .5647E+01, &
7256 &-.1402E+02,-.9693E+01,-.7206E+01,-.4846E+01,-.2656E+01,-.6540E+00, &
7257 & .8323E+00, .1530E+01, .3211E+01, .5355E+01,-.1343E+02,-.9060E+01, &
7258 &-.6596E+01,-.4399E+01,-.2294E+01,-.3519E+00, .9823E+00, .1673E+01, &
7259 & .3420E+01, .5083E+01,-.1279E+02,-.8611E+01,-.5785E+01,-.4010E+01, &
7260 &-.1936E+01,-.1177E+00, .1134E+01, .1974E+01, .3591E+01, .4770E+01, &
7261 &-.1230E+02,-.8174E+01,-.5298E+01,-.3611E+01,-.1607E+01, .3636E-01, &
7262 & .1433E+01, .2260E+01, .3539E+01, .4439E+01,-.1192E+02,-.7763E+01, &
7263 &-.4946E+01,-.3228E+01,-.1321E+01, .1991E+00, .1720E+01, .2420E+01, &
7264 & .3383E+01, .4041E+01,-.1154E+02,-.7377E+01,-.4576E+01,-.2851E+01, &
7265 &-.1093E+01, .4430E+00, .1896E+01, .2462E+01, .3122E+01, .3620E+01, &
7266 &-.1118E+02,-.7003E+01,-.4210E+01,-.2524E+01,-.8973E+00, .7490E+00, &
7267 & .1966E+01, .2363E+01, .2818E+01, .3182E+01,-.1080E+02,-.6677E+01, &
7268 &-.3872E+01,-.2264E+01,-.6846E+00, .9392E+00, .1867E+01, .2138E+01, &
7269 & .2505E+01, .2738E+01,-.1031E+02,-.6353E+01,-.3596E+01,-.1938E+01, &
7270 &-.4537E+00, .1015E+01, .1659E+01, .1830E+01, .2142E+01, .2287E+01, &
7271 &-.9695E+01,-.5977E+01,-.3427E+01,-.1596E+01,-.1979E+00, .9458E+00, &
7272 & .1363E+01, .1545E+01, .1743E+01, .1832E+01, .3628E-01, .2728E-01, &
7273 & .2213E-01, .1656E-01, .1507E-01, .1564E-01, .1623E-01, .1419E-01, &
7274 & .1455E-01, .1089E-02, .3632E-01, .2740E-01, .2164E-01, .1606E-01, &
7275 & .1369E-01, .1418E-01, .1444E-01, .1275E-01, .1331E-01, .9210E-03, &
7276 & .3636E-01, .2746E-01, .2114E-01, .1557E-01, .1239E-01, .1285E-01, &
7277 & .1237E-01, .1141E-01, .1141E-01, .9210E-03, .3640E-01, .2748E-01, &
7278 & .2064E-01, .1516E-01, .1141E-01, .1125E-01, .1092E-01, .1026E-01, &
7279 & .1011E-01,-.5652E-03, .3646E-01, .2746E-01, .2024E-01, .1478E-01, &
7280 & .1036E-01, .9688E-02, .9610E-02, .9305E-02, .9399E-02,-.6489E-03, &
7281 & .3651E-01, .2734E-01, .1984E-01, .1438E-01, .9436E-02, .8486E-02, &
7282 & .8214E-02, .8995E-02, .7892E-02,-.8582E-03, .3655E-01, .2723E-01, &
7283 & .1951E-01, .1402E-01, .8716E-02, .7433E-02, .7169E-02, .8072E-02, &
7284 & .5443E-02,-.1172E-02, .3659E-01, .2709E-01, .1911E-01, .1379E-01, &
7285 & .8107E-02, .6818E-02, .6818E-02, .7033E-02, .3056E-02,-.1047E-02, &
7286 & .3670E-01, .2698E-01, .1890E-01, .1363E-01, .7502E-02, .6371E-02, &
7287 & .6558E-02, .6489E-02,-.5652E-03,-.1340E-02, .3592E-01, .2238E-01, &
7288 & .1804E-01, .1007E-01, .6730E-02, .5512E-02, .6194E-02, .4375E-02, &
7289 &-.1109E-02,-.3559E-03, .3609E-01, .2242E-01, .1526E-01, .8582E-02, &
7290 & .6284E-02, .5809E-02, .4501E-02, .9420E-03,-.9001E-03,-.1005E-02, &
7291 & .3703E-01, .2196E-01, .1281E-01, .7860E-02, .5861E-02, .5842E-02, &
7292 & .1800E-02,-.1591E-02,-.1235E-02,-.9420E-03, .3728E-01, .2114E-01, &
7293 & .1347E-01, .6678E-02, .5449E-02, .4837E-02,-.1084E-02,-.1361E-02, &
7294 &-.6699E-03,-.1256E-03, .3683E-01, .2061E-01, .1350E-01, .6133E-02, &
7295 & .5449E-02, .2111E-02,-.1386E-02,-.1235E-02,-.5652E-03,-.8373E-04, &
7296 & .3656E-01, .1988E-01, .1348E-01, .5441E-02, .5149E-02,-.8813E-03, &
7297 &-.1116E-02,-.8373E-03,-.3140E-03,-.6280E-04, .3669E-01, .1934E-01, &
7298 & .1363E-01, .5035E-02, .3585E-02,-.1250E-02,-.9357E-03,-.8227E-03, &
7299 &-.3140E-03,-.4187E-04, .3618E-01, .1856E-01, .1390E-01, .3836E-02, &
7300 & .1470E-02,-.1096E-02,-.8080E-03,-.4480E-03,-.2093E-03,-.2093E-04, &
7301 & .3416E-01, .1741E-01, .1431E-01, .1951E-02,-.2923E-04,-.9422E-03, &
7302 &-.4576E-03,-.2395E-03,-.1565E-03,-.2799E-04, .3219E-01, .1674E-01, &
7303 & .1516E-01, .6652E-03,-.5051E-03,-.7052E-03,-.2002E-03,-.2135E-03, &
7304 &-.7633E-04,-.7300E-04,-.1290E-03,-.9934E-04,-.5595E-04,-.3996E-04, &
7305 & .1294E-04,-.9134E-05, .1294E-05,-.3121E-05,-.4757E-04,-.1979E-04, &
7306 &-.1305E-03,-.9629E-04,-.5481E-04,-.4301E-04, .1827E-04,-.9363E-05, &
7307 & .1777E-04,-.2185E-04,-.1903E-04,-.1675E-04,-.1313E-03,-.9439E-04, &
7308 &-.5404E-04,-.4263E-04, .9134E-05,-.1020E-04, .3524E-04,-.2599E-04, &
7309 &-.2093E-04, .1675E-04,-.1313E-03,-.9172E-04,-.5252E-04,-.4567E-04, &
7310 & .4186E-05,-.3920E-05, .2552E-04,-.2059E-04,-.2246E-04,-.1028E-04, &
7311 &-.1324E-03,-.9210E-04,-.5138E-04,-.4491E-04, .6470E-05,-.2131E-05, &
7312 & .1496E-04,-.1572E-04,-.3311E-04,-.8754E-05,-.1324E-03,-.9058E-04, &
7313 &-.5328E-04,-.4225E-04, .1827E-05,-.8411E-06, .4719E-05,-.6813E-05, &
7314 &-.2474E-04,-.1256E-04,-.1340E-03,-.8868E-04,-.5633E-04,-.4187E-04, &
7315 &-.4415E-05, .6055E-05,-.1648E-04,-.1507E-04, .1979E-04,-.2131E-04, &
7316 &-.1340E-03,-.8373E-04,-.5899E-04,-.3920E-04,-.4072E-05, .1491E-04, &
7317 &-.9781E-05,-.5328E-05, .3578E-04,-.1979E-04,-.1321E-03,-.7954E-04, &
7318 &-.5899E-04,-.4072E-04, .1066E-05, .5728E-05,-.5138E-05,-.8373E-05, &
7319 & .2626E-04,-.2436E-04,-.1363E-03,-.6432E-04,-.5176E-04,-.3083E-04, &
7320 & .2169E-05,-.8944E-05, .3159E-05, .6470E-05,-.4187E-05, .4948E-05, &
7321 &-.1302E-03,-.7802E-04,-.3311E-04,-.1903E-04, .5328E-05,-.1884E-04, &
7322 & .1408E-04, .3311E-04, .1142E-05,-.7613E-06,-.1473E-03,-.6737E-04, &
7323 &-.7536E-04,-.1085E-04,-.1903E-05,-.1458E-04, .4034E-04,-.3941E-10, &
7324 &-.7992E-05, .2664E-05,-.1361E-03,-.5709E-04,-.8550E-04,-.5709E-05, &
7325 &-.8640E-05, .6523E-05, .1903E-05,-.8221E-05,-.3045E-05,-.9134E-05, &
7326 &-.1329E-03,-.5529E-04,-.7107E-04, .2664E-05,-.9020E-05, .3320E-04, &
7327 &-.2131E-05,-.4187E-05,-.7231E-05,-.3806E-05,-.1278E-03,-.5247E-04, &
7328 &-.6465E-04, .3806E-05,-.6091E-05, .1245E-04,-.3844E-05,-.6090E-05, &
7329 &-.8754E-05,-.2664E-05,-.1321E-03,-.5632E-04,-.5897E-04, .1012E-04, &
7330 & .1168E-04,-.4196E-06,-.8411E-05,-.8868E-05,-.1484E-04,-.1522E-05, &
7331 &-.1252E-03,-.4907E-04,-.5932E-04, .3245E-04, .1996E-04,-.3325E-05, &
7332 &-.5785E-05,-.6394E-05,-.6851E-05,-.1142E-05,-.1093E-03,-.4731E-04, &
7333 &-.6761E-04, .1808E-04, .1754E-04,-.5079E-05,-.5809E-05,-.5649E-05, &
7334 &-.3988E-05,-.5849E-06,-.1151E-03,-.4965E-04,-.7163E-04, .7839E-05, &
7335 & .5505E-05,-.6084E-05,-.3344E-05,-.3894E-05,-.1391E-05,-.1327E-05/
7336 data ( ( (coehcb_14_new(k,j,i), i = 1, 10), j = 1, 19), k = 1, 3)/ &
7337 &-.9398E+01,-.5678E+01,-.3606E+01,-.2192E+01, .2104E+01, .3044E+01, &
7338 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.9094E+01,-.5422E+01, &
7339 &-.3448E+01,-.1650E+01, .2046E+01, .2749E+01,-.4587E+02,-.4587E+02, &
7340 &-.4587E+02,-.4587E+02,-.8760E+01,-.5270E+01,-.3329E+01,-.1147E+01, &
7341 & .2112E+01, .2709E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7342 &-.8537E+01,-.5152E+01,-.3129E+01,-.9544E+00, .2254E+01, .2771E+01, &
7343 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.8176E+01,-.4936E+01, &
7344 &-.2680E+01,-.9259E+00, .2247E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7345 &-.4587E+02,-.4587E+02,-.7836E+01,-.4676E+01,-.2378E+01,-.3550E+00, &
7346 & .1396E+01, .1976E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7347 &-.7419E+01,-.4122E+01,-.2407E+01,-.1204E-01, .1744E+01,-.4587E+02, &
7348 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.7124E+01,-.3727E+01, &
7349 &-.2160E+01, .6158E+00, .1953E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7350 &-.4587E+02,-.4587E+02,-.6823E+01,-.3324E+01,-.1748E+01,-.9806E-01, &
7351 & .2319E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7352 &-.5957E+01,-.3017E+01,-.1647E+01, .1398E+01,-.4587E+02,-.4587E+02, &
7353 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.5115E+01,-.2290E+01, &
7354 &-.5273E+00, .5662E+00, .1459E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7355 &-.4587E+02,-.4587E+02,-.4162E+01,-.1453E+01, .1116E+00,-.4587E+02, &
7356 & .9569E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7357 &-.3611E+01,-.9744E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7358 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.3075E+01,-.4176E+00, &
7359 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7360 &-.4587E+02,-.4587E+02,-.3469E+01,-.9395E+00, .5092E+00, .6200E+00, &
7361 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7362 &-.3808E+01,-.1505E+01, .3901E+00, .6264E+00,-.1155E+01,-.4587E+02, &
7363 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4058E+01,-.1818E+01, &
7364 & .2693E+00, .7087E+00, .3820E+00,-.4587E+02,-.4587E+02,-.4587E+02, &
7365 &-.4587E+02,-.4587E+02,-.4262E+01,-.2097E+01,-.5711E-01, .5681E+00, &
7366 & .1310E+01, .7371E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7367 &-.3997E+01,-.1784E+01, .4388E-01, .5167E+00, .6930E+00,-.6906E+00, &
7368 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, .2944E-01, .2723E-01, &
7369 & .1854E-01, .2023E-01, .2254E-01, .3059E-02, .4788E+00, .3059E-02, &
7370 & .3059E-02, .3059E-02, .3080E-01, .2549E-01, .1547E-01, .2225E-01, &
7371 & .2107E-01, .3059E-02, .4737E+00, .3059E-02, .3059E-02, .3059E-02, &
7372 & .3269E-01, .2656E-01, .2125E-01, .2179E-01, .2162E-01, .4589E+00, &
7373 & .4643E+00, .3059E-02, .3059E-02, .3059E-02, .3322E-01, .2476E-01, &
7374 & .2075E-01, .2139E-01, .1907E-01, .4501E+00, .4441E+00, .3059E-02, &
7375 & .3059E-02, .3059E-02, .3387E-01, .2182E-01, .2665E-01, .1841E-01, &
7376 & .2506E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7377 & .3532E-01, .2091E-01, .1995E-01, .2067E-01, .1949E-01, .4491E+00, &
7378 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3468E-01, .2075E-01, &
7379 & .2587E-01, .1401E-01, .8646E-02, .3059E-02, .3059E-02, .3059E-02, &
7380 & .3059E-02, .3059E-02, .3666E-01, .2430E-01, .1919E-01, .2007E-01, &
7381 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7382 & .3613E-01, .2147E-01, .1892E-01, .1361E-01, .3059E-02, .4506E+00, &
7383 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3129E-01, .1954E-01, &
7384 & .2442E-01, .1011E-01, .4420E+00, .3059E-02, .3059E-02, .3059E-02, &
7385 & .3059E-02, .3059E-02, .3177E-01, .2101E-01, .1526E-01, .4376E+00, &
7386 & .4379E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7387 & .2887E-01, .2044E-01, .1285E-01, .3059E-02,-.4862E-03, .3059E-02, &
7388 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2759E-01, .2114E-01, &
7389 & .4303E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7390 & .3059E-02, .3059E-02, .2880E-01, .1690E-01,-.4187E+00, .3059E-02, &
7391 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7392 & .2852E-01, .2255E-01, .2184E-01, .4334E+00, .4217E+00, .3059E-02, &
7393 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2840E-01, .2136E-01, &
7394 & .1644E-01, .2812E-01, .4358E+00, .4288E+00, .3059E-02, .3059E-02, &
7395 & .3059E-02, .3059E-02, .2809E-01, .2173E-01, .1708E-01, .3346E-01, &
7396 & .4225E-01, .4419E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7397 & .2702E-01, .2260E-01, .1607E-01, .2720E-01, .3982E-01, .4452E+00, &
7398 & .4365E+00, .4345E+00, .4432E+00, .4623E+00, .2684E-01, .2328E-01, &
7399 & .2099E-01, .3040E-01, .3867E-01, .4389E+00, .3132E-01, .3158E-01, &
7400 & .4083E-01, .4580E+00,-.1581E-03,-.9707E-04,-.1250E-03, .2580E-03, &
7401 & .7378E-04,-.1617E-01, .8646E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7402 &-.1319E-03,-.9528E-04,-.1710E-03, .7118E-04, .2076E-04,-.1608E-01, &
7403 & .8552E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.1721E-03,-.4680E-04, &
7404 &-.5522E-04,-.6242E-04, .4517E-04,-.7777E-02, .8382E-02,-.4656E-05, &
7405 &-.4656E-05,-.4656E-05,-.1482E-03,-.4208E-04,-.5216E-04,-.6514E-04, &
7406 &-.8378E-04,-.7956E-02, .8013E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7407 &-.1501E-03,-.4002E-04,-.1664E-03, .2272E-04,-.1888E-03,-.4656E-05, &
7408 &-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1201E-03,-.4709E-04, &
7409 &-.5371E-04,-.1574E-03, .1854E-03,-.7712E-02,-.4656E-05,-.4656E-05, &
7410 &-.4656E-05,-.4656E-05,-.1333E-03,-.1062E-03, .5785E-04,-.4150E-04, &
7411 &-.5717E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7412 &-.1212E-03,-.8524E-04,-.5895E-04,-.2884E-03,-.1581E-01,-.4656E-05, &
7413 &-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.8148E-04,-.9361E-04, &
7414 &-.2873E-03, .1883E-03,-.1594E-01, .8133E-02,-.4656E-05,-.4656E-05, &
7415 &-.4656E-05,-.4656E-05,-.1221E-03,-.1430E-04, .6335E-04,-.2581E-03, &
7416 & .7977E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7417 &-.9257E-04,-.5008E-04, .6389E-04,-.7455E-02,-.7745E-02,-.4656E-05, &
7418 &-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1186E-03,-.9037E-04, &
7419 &-.7461E-04,-.4656E-05, .1168E-03,-.4656E-05,-.4656E-05,-.4656E-05, &
7420 &-.4656E-05,-.4656E-05,-.8513E-04,-.5708E-04, .7763E-02,-.4656E-05, &
7421 &-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7422 &-.1124E-03,-.1228E-03, .7663E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7423 &-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1015E-03,-.8369E-04, &
7424 &-.2167E-03,-.7548E-02, .7608E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7425 &-.4656E-05,-.4656E-05,-.1049E-03,-.6414E-04,-.1384E-03,-.1644E-03, &
7426 &-.6919E-02, .7736E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7427 &-.1008E-03,-.7047E-04,-.1276E-03,-.2445E-03,-.1860E-03, .7975E-02, &
7428 &-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.9629E-04,-.1007E-03, &
7429 &-.1127E-03,-.1527E-03,-.3238E-03,-.7373E-02, .7877E-02, .7840E-02, &
7430 & .7997E-02, .8345E-02,-.8800E-04,-.1072E-03,-.1046E-03,-.1777E-03, &
7431 &-.2146E-03,-.7016E-02, .1516E-01, .1532E-01, .1509E-01, .8268E-02/
7432 data ( ( coech3cl_14_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
7433 &-.8278E+01,-.7818E+01,-.7357E+01,-.6897E+01,-.6439E+01,-.5976E+01, &
7434 &-.5516E+01,-.5056E+01,-.4597E+01,-.4151E+01,-.3704E+01,-.3283E+01, &
7435 &-.2888E+01,-.2545E+01,-.2263E+01,-.2015E+01,-.1785E+01,-.1572E+01, &
7436 &-.1400E+01,0.4800E-02,0.4797E-02,0.4798E-02,0.4798E-02,0.4785E-02, &
7437 &0.4801E-02,0.4802E-02,0.4831E-02,0.4874E-02,0.4964E-02,0.5198E-02, &
7438 &0.5691E-02,0.6425E-02,0.7134E-02,0.7507E-02,0.7846E-02,0.7890E-02, &
7439 &0.7674E-02,0.7747E-02,-.3590E-04,-.3585E-04,-.3560E-04,-.3570E-04, &
7440 &-.3594E-04,-.3607E-04,-.3620E-04,-.3644E-04,-.3774E-04,-.3753E-04, &
7441 &-.4034E-04,-.4465E-04,-.5313E-04,-.5958E-04,-.6406E-04,-.6210E-04, &
7442 &-.5871E-04,-.6018E-04,-.5777E-04/
7444 ! block data ckd15_new
7445 ! **********************************************************************
7446 ! hk is the interval in the g (cumulative probability) space from 0
7447 ! to one. coehca and coehcb are the coefficients to calculate the
7448 ! H2O and CO2 overlapping absorption coefficients in units of (cm-
7449 ! atm)**-1 at three temperatures, nineteen pressures, and 12 cumu-
7450 ! lative probabilities (Fu, 1991). The spectral region is from 670
7451 ! to 540 cm**-1.
7452 ! **********************************************************************
7453 real hk_15_new(12), coehca_15_new(3,19,12), coehcb_15_new(3,19,12)
7454 data hk_15_new /.24,.36,.18,.1,.05,.02,.016,.012,.01 &
7455 & ,.006,.0039,.0021/
7456 data ( ( (coehca_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 1, 2)/ &
7457 &-.1921E+02,-.1363E+02,-.1080E+02,-.8392E+01,-.6776E+01,-.5696E+01, &
7458 &-.4572E+01,-.3752E+01,-.2382E+01,-.1110E+01, .6803E+00, .3259E+01, &
7459 &-.1875E+02,-.1321E+02,-.1040E+02,-.8026E+01,-.6449E+01,-.5401E+01, &
7460 &-.4316E+01,-.3498E+01,-.2141E+01,-.9439E+00, .8103E+00, .3314E+01, &
7461 &-.1829E+02,-.1278E+02,-.1000E+02,-.7646E+01,-.6089E+01,-.5085E+01, &
7462 &-.4047E+01,-.3217E+01,-.1872E+01,-.7106E+00, .9573E+00, .3390E+01, &
7463 &-.1783E+02,-.1236E+02,-.9596E+01,-.7264E+01,-.5735E+01,-.4740E+01, &
7464 &-.3743E+01,-.2882E+01,-.1587E+01,-.4714E+00, .1120E+01, .3425E+01, &
7465 &-.1737E+02,-.1195E+02,-.9193E+01,-.6877E+01,-.5371E+01,-.4404E+01, &
7466 &-.3405E+01,-.2574E+01,-.1298E+01,-.1747E+00, .1327E+01, .3547E+01, &
7467 &-.1691E+02,-.1153E+02,-.8776E+01,-.6490E+01,-.4993E+01,-.4049E+01, &
7468 &-.3039E+01,-.2256E+01,-.1012E+01, .1103E+00, .1530E+01, .3651E+01, &
7469 &-.1644E+02,-.1112E+02,-.8360E+01,-.6105E+01,-.4623E+01,-.3688E+01, &
7470 &-.2694E+01,-.1915E+01,-.6855E+00, .3993E+00, .1714E+01, .3950E+01, &
7471 &-.1598E+02,-.1073E+02,-.7943E+01,-.5723E+01,-.4236E+01,-.3314E+01, &
7472 &-.2338E+01,-.1596E+01,-.3583E+00, .6963E+00, .1868E+01, .4127E+01, &
7473 &-.1553E+02,-.1034E+02,-.7542E+01,-.5357E+01,-.3856E+01,-.2942E+01, &
7474 &-.1986E+01,-.1299E+01,-.5472E-01, .9443E+00, .2149E+01, .4261E+01, &
7475 &-.1485E+02,-.9661E+01,-.7008E+01,-.4830E+01,-.3458E+01,-.2566E+01, &
7476 &-.1658E+01,-.9639E+00, .2083E+00, .1182E+01, .2458E+01, .4452E+01, &
7477 &-.1427E+02,-.9166E+01,-.6373E+01,-.4404E+01,-.3073E+01,-.2209E+01, &
7478 &-.1349E+01,-.6648E+00, .4023E+00, .1452E+01, .2739E+01, .4466E+01, &
7479 &-.1380E+02,-.8726E+01,-.5772E+01,-.3982E+01,-.2732E+01,-.1874E+01, &
7480 &-.1052E+01,-.4403E+00, .5763E+00, .1792E+01, .2999E+01, .4335E+01, &
7481 &-.1305E+02,-.8270E+01,-.5304E+01,-.3586E+01,-.2392E+01,-.1568E+01, &
7482 &-.8299E+00,-.2650E+00, .8584E+00, .2062E+01, .3141E+01, .4168E+01, &
7483 &-.1269E+02,-.7900E+01,-.4956E+01,-.3205E+01,-.2065E+01,-.1332E+01, &
7484 &-.6415E+00,-.7921E-01, .1170E+01, .2269E+01, .3198E+01, .4066E+01, &
7485 &-.1227E+02,-.7536E+01,-.4576E+01,-.2859E+01,-.1815E+01,-.1139E+01, &
7486 &-.4520E+00, .2272E+00, .1371E+01, .2351E+01, .3150E+01, .3935E+01, &
7487 &-.1186E+02,-.7159E+01,-.4223E+01,-.2538E+01,-.1619E+01,-.9324E+00, &
7488 &-.1566E+00, .5151E+00, .1520E+01, .2339E+01, .3132E+01, .3880E+01, &
7489 &-.1120E+02,-.6777E+01,-.3919E+01,-.2330E+01,-.1387E+01,-.6737E+00, &
7490 & .1108E+00, .6991E+00, .1531E+01, .2163E+01, .3150E+01, .3767E+01, &
7491 &-.9973E+01,-.6279E+01,-.3638E+01,-.2048E+01,-.1098E+01,-.4407E+00, &
7492 & .3043E+00, .7797E+00, .1424E+01, .2002E+01, .3122E+01, .3611E+01, &
7493 &-.8483E+01,-.5607E+01,-.3357E+01,-.1744E+01,-.8884E+00,-.2264E+00, &
7494 & .3800E+00, .7504E+00, .1245E+01, .2032E+01, .3097E+01, .3546E+01, &
7495 & .3762E-01, .2372E-01, .1643E-01, .1208E-01, .1170E-01, .1164E-01, &
7496 & .1214E-01, .1161E-01, .1028E-01, .9185E-02, .7712E-02, .1001E-01, &
7497 & .3762E-01, .2382E-01, .1593E-01, .1145E-01, .1059E-01, .1049E-01, &
7498 & .1080E-01, .1057E-01, .8894E-02, .7807E-02, .7132E-02, .1032E-01, &
7499 & .3764E-01, .2386E-01, .1555E-01, .1080E-01, .9692E-02, .9231E-02, &
7500 & .9585E-02, .9644E-02, .7711E-02, .6443E-02, .6223E-02, .9922E-02, &
7501 & .3764E-01, .2395E-01, .1516E-01, .1028E-01, .8917E-02, .8415E-02, &
7502 & .8457E-02, .8777E-02, .6436E-02, .5428E-02, .5499E-02, .8017E-02, &
7503 & .3768E-01, .2399E-01, .1482E-01, .9692E-02, .8247E-02, .7640E-02, &
7504 & .7582E-02, .7783E-02, .5432E-02, .4482E-02, .4919E-02, .5903E-02, &
7505 & .3770E-01, .2401E-01, .1449E-01, .9252E-02, .7620E-02, .6678E-02, &
7506 & .6845E-02, .6925E-02, .4939E-02, .3471E-02, .4124E-02, .3873E-02, &
7507 & .3776E-01, .2395E-01, .1419E-01, .8959E-02, .7096E-02, .6184E-02, &
7508 & .6110E-02, .6075E-02, .4419E-02, .2891E-02, .3056E-02, .1214E-02, &
7509 & .3780E-01, .2391E-01, .1392E-01, .8687E-02, .6573E-02, .5733E-02, &
7510 & .5359E-02, .5009E-02, .4034E-02, .2755E-02, .1968E-02,-.4187E-04, &
7511 & .3791E-01, .2382E-01, .1373E-01, .8561E-02, .6060E-02, .5120E-02, &
7512 & .4618E-02, .4713E-02, .3965E-02, .2481E-02, .8164E-03,-.1088E-02, &
7513 & .3843E-01, .2148E-01, .1302E-01, .6384E-02, .5256E-02, .4260E-02, &
7514 & .4077E-02, .4181E-02, .4132E-02, .2135E-02,-.2931E-03,-.1151E-02, &
7515 & .3896E-01, .2081E-01, .1097E-01, .5568E-02, .4475E-02, .3795E-02, &
7516 & .3828E-02, .3996E-02, .3766E-02, .1193E-02,-.1089E-02,-.9420E-03, &
7517 & .3973E-01, .2024E-01, .9943E-02, .4815E-02, .3820E-02, .3663E-02, &
7518 & .3568E-02, .3881E-02, .2859E-02, .6698E-03,-.1549E-02,-.6280E-03, &
7519 & .3635E-01, .1963E-01, .1061E-01, .3812E-02, .3509E-02, .3429E-02, &
7520 & .3693E-02, .3316E-02, .1120E-02, .6552E-03,-.1193E-02,-.1109E-02, &
7521 & .3631E-01, .1893E-01, .1056E-01, .3172E-02, .3378E-02, .3164E-02, &
7522 & .2751E-02, .1722E-02, .1112E-02, .4354E-03,-.7327E-03,-.1319E-02, &
7523 & .3500E-01, .1828E-01, .1050E-01, .2831E-02, .2784E-02, .2564E-02, &
7524 & .1469E-02, .7739E-03, .1209E-02, .7913E-03,-.2512E-03,-.1758E-02, &
7525 & .3352E-01, .1763E-01, .1045E-01, .2401E-02, .1928E-02, .1340E-02, &
7526 & .3753E-03, .5794E-03, .9060E-03, .1042E-02, .1465E-03,-.2533E-02, &
7527 & .2880E-01, .1729E-01, .1077E-01, .1347E-02, .1194E-02,-.1191E-03, &
7528 & .2828E-03, .6606E-03, .9743E-03, .1002E-02, .0000E+00,-.3140E-02, &
7529 & .2040E-01, .1585E-01, .1165E-01, .3871E-05, .1509E-04,-.1046E-02, &
7530 & .2444E-03, .4359E-03, .1041E-02, .2429E-02,-.1721E-03,-.2786E-02, &
7531 & .1737E-01, .1560E-01, .1240E-01,-.2139E-03,-.1025E-02,-.1248E-02, &
7532 &-.6934E-04, .1649E-03, .4062E-03, .1554E-02,-.4179E-03,-.7795E-03/
7533 data ( ( (coehca_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 3, 3)/ &
7534 &-.1488E-03,-.9248E-04,-.2322E-04,-.4187E-05, .1104E-04, .9895E-05, &
7535 &-.2283E-05, .2512E-05,-.9058E-05, .8449E-05, .8297E-05,-.3882E-04, &
7536 &-.1488E-03,-.9058E-04,-.2398E-04,-.5709E-05, .1218E-04, .1180E-04, &
7537 & .1522E-05, .6927E-05,-.1161E-04, .1714E-04,-.4948E-06,-.3540E-04, &
7538 &-.1500E-03,-.8830E-04,-.2474E-04,-.8373E-05, .6470E-05, .7992E-05, &
7539 & .9096E-05, .6737E-05,-.1485E-04, .1873E-04,-.4948E-06,-.4491E-04, &
7540 &-.1500E-03,-.8601E-04,-.2664E-04,-.1028E-04, .6851E-05, .6851E-05, &
7541 & .1294E-04,-.2550E-05,-.1520E-04, .2310E-04, .4948E-06,-.2017E-04, &
7542 &-.1507E-03,-.8373E-04,-.2664E-04,-.1256E-04, .4567E-05, .1028E-04, &
7543 & .9210E-05,-.2131E-05,-.6995E-05, .7498E-05,-.1104E-04,-.2284E-05, &
7544 &-.1519E-03,-.8183E-04,-.2816E-04,-.1142E-04, .7611E-06, .7231E-05, &
7545 & .1751E-05,-.7612E-06, .8312E-05, .2436E-05,-.7231E-05, .2398E-04, &
7546 &-.1530E-03,-.7992E-04,-.2893E-04,-.9896E-05, .3806E-06, .8906E-05, &
7547 & .3159E-05,-.5328E-05, .3692E-05,-.2093E-05,-.6851E-05,-.3045E-05, &
7548 &-.1538E-03,-.7536E-04,-.3007E-04,-.8754E-05,-.3045E-05, .5138E-05, &
7549 & .9134E-06,-.1979E-06, .1560E-05,-.1507E-04, .2284E-04, .9895E-05, &
7550 &-.1541E-03,-.7688E-04,-.2969E-04,-.5709E-05,-.3996E-05, .1142E-05, &
7551 &-.8373E-06, .1235E-04,-.7079E-05,-.6737E-05, .1028E-04, .3578E-04, &
7552 &-.1560E-03,-.6851E-04,-.1903E-04,-.4187E-05,-.4605E-05,-.1142E-06, &
7553 & .3878E-05, .3597E-05,-.9591E-05, .5328E-05, .7612E-05,-.4948E-05, &
7554 &-.1587E-03,-.6546E-04,-.2740E-04,-.7612E-06,-.3578E-05, .1713E-05, &
7555 & .6064E-05,-.9781E-05, .1408E-05, .5709E-05, .8373E-05,-.1256E-04, &
7556 &-.1484E-03,-.5823E-04,-.4301E-04,-.1522E-05, .7498E-05,-.5328E-06, &
7557 &-.7855E-05,-.1599E-05, .1964E-04,-.2284E-05, .7882E-10, .5328E-05, &
7558 &-.1238E-03,-.5700E-04,-.5266E-04, .3286E-05, .4910E-05,-.8602E-05, &
7559 & .6090E-06, .8454E-05, .1256E-05,-.4072E-05,-.1903E-05, .6470E-05, &
7560 &-.1155E-03,-.5231E-04,-.4396E-04, .3626E-05,-.7051E-05,-.1743E-05, &
7561 & .9667E-05, .2064E-04,-.2778E-05,-.6546E-05,-.4948E-05, .1903E-05, &
7562 &-.1024E-03,-.5129E-04,-.4506E-04, .7943E-06, .3074E-06, .3243E-05, &
7563 & .2754E-04,-.1479E-05, .1661E-05,-.2969E-05,-.1066E-04, .7612E-06, &
7564 &-.8473E-04,-.5418E-04,-.4674E-04,-.3418E-05, .9460E-05, .1151E-04, &
7565 & .5714E-05,-.1069E-04,-.2022E-05,-.9061E-05,-.1104E-04,-.3083E-04, &
7566 &-.4283E-04,-.5037E-04,-.4476E-04, .1951E-04, .8922E-05, .1296E-04, &
7567 &-.4053E-05,-.4355E-05,-.2355E-05,-.5004E-05,-.1218E-04,-.1522E-04, &
7568 & .6411E-05,-.5937E-04,-.5331E-04, .1934E-04, .5284E-05, .1129E-04, &
7569 &-.2166E-05,-.1484E-06,-.5407E-05,-.1364E-04,-.3115E-05, .3004E-04, &
7570 &-.5074E-04,-.6256E-04,-.5097E-04, .2218E-04, .1228E-04,-.1160E-05, &
7571 &-.1105E-05, .1618E-06,-.6089E-05,-.4216E-06,-.5314E-05, .7903E-05/
7572 data ( ( (coehcb_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 1, 2)/ &
7573 &-.9593E+01,-.4078E+01,-.2812E+01,-.6506E+00,-.4123E+00, .2055E+01, &
7574 & .4097E+01, .4671E+01, .4639E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7575 &-.9276E+01,-.3757E+01,-.2467E+01,-.5784E+00, .8833E-01, .2232E+01, &
7576 & .3826E+01, .4723E+01, .4942E+01, .5135E+01,-.4587E+02,-.4587E+02, &
7577 &-.8968E+01,-.3508E+01,-.2116E+01,-.1363E+00, .1662E+00, .2424E+01, &
7578 & .4220E+01, .4513E+01, .1375E+01, .4601E+01,-.4587E+02,-.4587E+02, &
7579 &-.8662E+01,-.3164E+01,-.1722E+01, .5178E-01, .7288E+00, .2411E+01, &
7580 & .3805E+01, .4766E+01, .4342E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7581 &-.8292E+01,-.2799E+01,-.1359E+01, .3271E+00, .1650E+01, .2395E+01, &
7582 & .4192E+01, .4758E+01, .2470E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7583 &-.7812E+01,-.2404E+01,-.1085E+01, .7167E+00, .2202E+01, .2922E+01, &
7584 & .4322E+01, .4591E+01, .4186E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7585 &-.7441E+01,-.2066E+01,-.7142E+00, .1057E+01, .2524E+01, .2946E+01, &
7586 & .4220E+01, .3607E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7587 &-.7191E+01,-.1745E+01,-.3487E+00, .1453E+01, .2739E+01, .3660E+01, &
7588 & .4114E+01, .3245E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7589 &-.6895E+01,-.1326E+01,-.3500E+00, .1647E+01, .2899E+01, .4023E+01, &
7590 & .3361E+01, .3360E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7591 &-.5876E+01,-.9573E+00, .2014E+00, .2130E+01, .3493E+01, .4088E+01, &
7592 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7593 &-.4429E+01,-.3417E+00, .1204E+01, .2780E+01, .3843E+01, .3099E+01, &
7594 &-.4587E+02, .3605E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7595 &-.3122E+01, .2697E+00, .1866E+01, .3526E+01, .3569E+01, .1025E+01, &
7596 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7597 &-.2284E+01, .8186E+00, .2754E+01, .3206E+01, .3704E+01,-.4587E+02, &
7598 &-.4587E+02, .4625E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7599 &-.1711E+01, .1220E+01, .3248E+01,-.4587E+02, .2565E+01, .3297E+01, &
7600 &-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7601 &-.1758E+01, .7970E+00, .2758E+01, .2926E+01, .2613E+01, .1974E+01, &
7602 &-.4587E+02, .2310E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
7603 &-.1737E+01, .3499E+00, .2246E+01, .2673E+01, .3308E+01, .3463E+01, &
7604 & .3103E+01, .2611E+01, .2178E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7605 &-.1559E+01, .2215E+00, .1875E+01, .2500E+01, .3346E+01, .3585E+01, &
7606 & .3946E+01, .3533E+01, .3205E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
7607 &-.1601E+01, .5060E-01, .1275E+01, .2176E+01, .3081E+01, .3649E+01, &
7608 & .3940E+01, .4106E+01, .4112E+01, .4349E+01, .2292E+01,-.4587E+02, &
7609 &-.1222E+01, .3199E+00, .1642E+01, .2380E+01, .3254E+01, .3534E+01, &
7610 & .3687E+01, .3717E+01, .3402E+01, .3868E+01,-.4587E+02,-.4587E+02, &
7611 & .2967E-01, .1697E-01, .1795E-01, .1387E-01, .2032E-01, .1187E-01, &
7612 & .2560E-01, .1044E-01,-.4560E+00, .3059E-02, .3059E-02, .3059E-02, &
7613 & .2998E-01, .1586E-01, .1786E-01, .1521E-01, .1710E-01, .1061E-01, &
7614 & .2030E-01, .1158E-01, .4452E+00, .3059E-02, .3059E-02, .3059E-02, &
7615 & .2993E-01, .1551E-01, .1481E-01, .9846E-02, .2443E-01, .1150E-01, &
7616 & .1865E-01, .1376E-01, .4617E+00, .3059E-02, .3059E-02, .3059E-02, &
7617 & .3035E-01, .1417E-01, .1438E-01, .1511E-01, .1901E-01, .8582E-02, &
7618 & .1746E-01, .1450E-01, .4523E+00, .3059E-02, .3059E-02, .3059E-02, &
7619 & .2970E-01, .1347E-01, .1322E-01, .1252E-01, .1665E-01, .1037E-01, &
7620 & .1320E-01, .1199E-01, .4436E+00, .3059E-02, .3059E-02, .3059E-02, &
7621 & .2949E-01, .1291E-01, .1671E-01, .1111E-01, .1400E-01, .1318E-01, &
7622 & .1060E-01, .1046E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7623 & .3004E-01, .1300E-01, .1413E-01, .9085E-02, .9764E-02, .2260E-01, &
7624 & .9778E-02, .4671E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7625 & .3086E-01, .1436E-01, .1205E-01, .1081E-01, .4681E-02, .1479E-01, &
7626 & .1888E-01, .3494E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7627 & .3094E-01, .1500E-01, .1457E-01, .1060E-01, .8319E-02, .8983E-02, &
7628 & .3791E-01, .2232E-01, .4631E+00, .3059E-02, .3059E-02, .3059E-02, &
7629 & .3158E-01, .1585E-01, .1292E-01, .6531E-02, .1383E-01, .4605E+00, &
7630 & .4662E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7631 & .3182E-01, .1586E-01, .8724E-02, .5798E-02, .2454E-01, .4607E+00, &
7632 & .4560E+00, .4511E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7633 & .2369E-01, .1606E-01, .5477E-02, .1228E-01, .4579E+00, .4561E+00, &
7634 & .4497E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7635 & .2190E-01, .1779E-01, .6267E-02, .4535E+00, .4533E+00, .3059E-02, &
7636 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7637 & .2100E-01, .1653E-01, .7449E-02, .4543E+00, .4472E+00, .4439E+00, &
7638 & .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
7639 & .1864E-01, .1771E-01, .7040E-02, .2877E-01, .3381E-01, .2691E-01, &
7640 & .4466E+00, .3059E-02, .4613E+00, .3059E-02, .3059E-02, .3059E-02, &
7641 & .1637E-01, .1641E-01, .8424E-02, .1318E-01, .2060E-01, .3426E-01, &
7642 & .4122E-01, .4621E+00, .4555E+00, .4525E+00, .3059E-02, .3059E-02, &
7643 & .1607E-01, .1452E-01, .8013E-02, .1213E-01, .1482E-01, .2125E-01, &
7644 & .3379E-01, .3562E-01, .4619E+00, .4569E+00, .3059E-02, .3059E-02, &
7645 & .1698E-01, .1538E-01, .6616E-02, .1147E-01, .1217E-01, .1696E-01, &
7646 & .1871E-01, .2273E-01, .4513E-01, .4702E+00, .4617E+00, .4553E+00, &
7647 & .1700E-01, .1547E-01, .6456E-02, .1324E-01, .1502E-01, .2095E-01, &
7648 & .2547E-01, .2823E-01, .4107E-01, .4676E+00, .4583E+00, .4498E+00/
7649 data ( ( (coehcb_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 3, 3)/ &
7650 &-.6747E-05,-.2483E-04, .6575E-04, .1026E-03, .3888E-03,-.8519E-04, &
7651 &-.1629E-03,-.1808E-04,-.8355E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7652 &-.2270E-04,-.3427E-04, .5118E-04, .1218E-03, .1245E-03,-.1245E-03, &
7653 & .3841E-05,-.4151E-04,-.8763E-02,-.1687E-01,-.4656E-05,-.4656E-05, &
7654 &-.4557E-04,-.3023E-04, .2286E-04, .5656E-04, .4113E-04,-.1407E-03, &
7655 &-.1301E-03, .8503E-04,-.7284E-02,-.1669E-01,-.4656E-05,-.4656E-05, &
7656 &-.5325E-04,-.5309E-04,-.1246E-04, .2244E-04, .5136E-04,-.1272E-03, &
7657 & .4217E-04,-.1749E-04,-.8435E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7658 &-.6857E-04,-.7217E-04, .1740E-05, .3653E-04,-.1490E-03,-.4090E-04, &
7659 &-.2376E-04, .2047E-04,-.7974E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7660 &-.1232E-03,-.9826E-04,-.2849E-04, .1703E-04,-.1895E-03,-.3363E-03, &
7661 & .7102E-04,-.1838E-05,-.1655E-01,-.4656E-05,-.4656E-05,-.4656E-05, &
7662 &-.9896E-04,-.5127E-04,-.2704E-04,-.1218E-04,-.1207E-03,-.5883E-04, &
7663 & .6893E-04,-.7924E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7664 &-.7837E-04,-.4980E-04, .6902E-05,-.1072E-03,-.4051E-04,-.1991E-05, &
7665 &-.1173E-03,-.5195E-04,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7666 &-.8136E-04,-.8102E-04, .1254E-03,-.4658E-04, .3173E-04,-.4461E-05, &
7667 &-.1558E-03,-.2036E-03, .8360E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7668 &-.2232E-04,-.6411E-04, .9486E-04,-.2322E-03,-.8282E-04,-.8202E-02, &
7669 & .8416E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7670 &-.1398E-03,-.7165E-04,-.4258E-04,-.3970E-04,-.2839E-03,-.7873E-02, &
7671 & .8231E-02,-.8213E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7672 &-.6754E-04,-.7469E-04,-.6898E-04,-.1702E-03,-.8079E-02,-.7270E-02, &
7673 & .8116E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7674 &-.2396E-04,-.2361E-04,-.8664E-04,-.8038E-02,-.8207E-02,-.4656E-05, &
7675 &-.4656E-05,-.1670E-01,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7676 &-.5479E-04,-.7593E-04,-.1005E-03, .8199E-02,-.7942E-02,-.8244E-02, &
7677 &-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
7678 &-.3806E-04,-.5825E-04,-.1003E-03,-.2925E-03,-.1506E-03, .3148E-04, &
7679 & .8060E-02,-.1593E-01, .8327E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
7680 &-.4706E-04,-.3630E-04,-.7811E-04,-.6881E-04,-.1822E-03,-.3091E-03, &
7681 &-.3033E-03,-.7684E-02,-.7663E-02, .8167E-02,-.4656E-05,-.4656E-05, &
7682 &-.7669E-04,-.4610E-04,-.8063E-04,-.7250E-04,-.1094E-03,-.1241E-03, &
7683 &-.2944E-03,-.1736E-03,-.7886E-02, .8248E-02,-.4656E-05,-.4656E-05, &
7684 &-.7138E-04,-.4545E-04,-.3653E-04,-.6075E-04,-.4528E-04,-.1077E-03, &
7685 &-.1119E-03,-.1657E-03,-.4695E-03,-.8112E-02,-.7587E-02, .8217E-02, &
7686 &-.6812E-04,-.4558E-04,-.6739E-04,-.8861E-04,-.9386E-04,-.1334E-03, &
7687 &-.2007E-03,-.2179E-03,-.1650E-03,-.8001E-02, .8273E-02, .8118E-02/
7689 ! block data ckd16_new
7690 ! *********************************************************************
7691 ! hk is the interval in the g (cumulative probability) space from 0
7692 ! to one. coeh2o is the coefficient to calculate the H2O absorption
7693 ! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
7694 ! teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
7695 ! The spectral region is from 540 to 400 cm**-1.
7696 ! *********************************************************************
7697 real hk_16_new(7), coeh2o_16_new(3,19,7)
7698 data hk_16_new / .12, .24, .24, .20, .12, .06, .02 /
7699 data ( ( ( coeh2o_16_new(k,j,i), i = 1, 7), j = 1, 19), k = 1, 3)/ &
7700 &-.2344E+02,-.2016E+02,-.1986E+02,-.1655E+02,-.1243E+02,-.8437E+01, &
7701 &-.4858E+01,-.2298E+02,-.2014E+02,-.1984E+02,-.1609E+02,-.1198E+02, &
7702 &-.8020E+01,-.4548E+01,-.2252E+02,-.2012E+02,-.1981E+02,-.1564E+02, &
7703 &-.1153E+02,-.7596E+01,-.4239E+01,-.2206E+02,-.2009E+02,-.1957E+02, &
7704 &-.1517E+02,-.1111E+02,-.7161E+01,-.3871E+01,-.2160E+02,-.2007E+02, &
7705 &-.1911E+02,-.1472E+02,-.1065E+02,-.6721E+01,-.3479E+01,-.2113E+02, &
7706 &-.2005E+02,-.1865E+02,-.1426E+02,-.1021E+02,-.6302E+01,-.3081E+01, &
7707 &-.2067E+02,-.2003E+02,-.1819E+02,-.1379E+02,-.9765E+01,-.5883E+01, &
7708 &-.2678E+01,-.2026E+02,-.2001E+02,-.1773E+02,-.1333E+02,-.9332E+01, &
7709 &-.5443E+01,-.2253E+01,-.2024E+02,-.1999E+02,-.1727E+02,-.1288E+02, &
7710 &-.8897E+01,-.5029E+01,-.1858E+01,-.2026E+02,-.1959E+02,-.1481E+02, &
7711 &-.1147E+02,-.7477E+01,-.4555E+01,-.1464E+01,-.2022E+02,-.1632E+02, &
7712 &-.1305E+02,-.9885E+01,-.6689E+01,-.4108E+01,-.1068E+01,-.1936E+02, &
7713 &-.1438E+02,-.1163E+02,-.8499E+01,-.6146E+01,-.3673E+01,-.6816E+00, &
7714 &-.1675E+02,-.1281E+02,-.1020E+02,-.7716E+01,-.5678E+01,-.3256E+01, &
7715 &-.3125E+00,-.1510E+02,-.1124E+02,-.8821E+01,-.7140E+01,-.5243E+01, &
7716 &-.2851E+01,-.2560E-01,-.1334E+02,-.9708E+01,-.8061E+01,-.6611E+01, &
7717 &-.4842E+01,-.2459E+01, .1711E+00,-.1155E+02,-.8798E+01,-.7440E+01, &
7718 &-.6123E+01,-.4439E+01,-.2089E+01, .2480E+00,-.1020E+02,-.8154E+01, &
7719 &-.6945E+01,-.5681E+01,-.4055E+01,-.1737E+01, .2390E+00,-.9464E+01, &
7720 &-.7677E+01,-.6512E+01,-.5284E+01,-.3707E+01,-.1453E+01, .2015E+00, &
7721 &-.9033E+01,-.7246E+01,-.6093E+01,-.4882E+01,-.3346E+01,-.1264E+01, &
7722 & .1033E+00, .4658E-01, .5840E-02, .4626E-02, .2688E-01, .2395E-01, &
7723 & .1804E-01, .2074E-01, .4660E-01, .1884E-02, .8561E-02, .2690E-01, &
7724 & .2403E-01, .1788E-01, .1934E-01, .4660E-01, .1800E-02, .1252E-01, &
7725 & .2694E-01, .2393E-01, .1786E-01, .1825E-01, .4660E-01, .1779E-02, &
7726 & .1649E-01, .2696E-01, .2397E-01, .1779E-01, .1765E-01, .4348E-01, &
7727 & .1758E-02, .2043E-01, .2696E-01, .2393E-01, .1748E-01, .1675E-01, &
7728 & .3944E-01, .1737E-02, .2445E-01, .2698E-01, .2384E-01, .1752E-01, &
7729 & .1549E-01, .3538E-01, .1654E-02, .2847E-01, .2702E-01, .2384E-01, &
7730 & .1714E-01, .1565E-01, .3127E-01, .1570E-02, .3245E-01, .2705E-01, &
7731 & .2374E-01, .1712E-01, .1514E-01, .2715E-01, .1444E-02, .3540E-01, &
7732 & .2711E-01, .2363E-01, .1702E-01, .1446E-01, .2960E-01, .1760E-01, &
7733 & .2977E-01, .2397E-01, .2087E-01, .1618E-01, .1445E-01, .2466E-01, &
7734 & .3039E-01, .2428E-01, .2217E-01, .1821E-01, .1593E-01, .1463E-01, &
7735 & .2640E-01, .2545E-01, .2231E-01, .2060E-01, .1773E-01, .1555E-01, &
7736 & .1473E-01, .3456E-01, .2135E-01, .2030E-01, .1844E-01, .1740E-01, &
7737 & .1559E-01, .1428E-01, .3203E-01, .2047E-01, .1809E-01, .1760E-01, &
7738 & .1725E-01, .1545E-01, .1541E-01, .2137E-01, .1857E-01, .1616E-01, &
7739 & .1698E-01, .1700E-01, .1537E-01, .1636E-01, .1338E-01, .1518E-01, &
7740 & .1580E-01, .1658E-01, .1710E-01, .1518E-01, .1513E-01, .1570E-01, &
7741 & .1614E-01, .1603E-01, .1673E-01, .1706E-01, .1497E-01, .1439E-01, &
7742 & .1987E-01, .1731E-01, .1601E-01, .1675E-01, .1681E-01, .1535E-01, &
7743 & .1425E-01, .2018E-01, .1723E-01, .1597E-01, .1691E-01, .1666E-01, &
7744 & .1509E-01, .1446E-01,-.2873E-03,-.8031E-04, .4225E-04,-.9287E-04, &
7745 &-.6013E-04,-.4339E-04,-.2474E-04,-.2862E-03,-.8372E-05, .1146E-03, &
7746 &-.9248E-04,-.6166E-04,-.3882E-04,-.1827E-04,-.2870E-03,-.6851E-05, &
7747 & .1865E-03,-.9172E-04,-.6128E-04,-.3616E-04,-.7612E-05,-.2877E-03, &
7748 &-.7231E-05, .1880E-03,-.9287E-04,-.5671E-04,-.4110E-04,-.1104E-04, &
7749 &-.3429E-03,-.7612E-05, .1149E-03,-.9287E-04,-.6356E-04,-.4529E-04, &
7750 &-.2436E-04,-.4187E-03,-.7992E-05, .4339E-04,-.9325E-04,-.6280E-04, &
7751 &-.4225E-04,-.3197E-04,-.4925E-03,-.8754E-05,-.2740E-04,-.9477E-04, &
7752 &-.6432E-04,-.3768E-04,-.3361E-04,-.5511E-03,-.8753E-05,-.9972E-04, &
7753 &-.9515E-04,-.6394E-04,-.3806E-04,-.3787E-04,-.4792E-03,-.1028E-04, &
7754 &-.1534E-03,-.9477E-04,-.6356E-04,-.3616E-04,-.2923E-04,-.5070E-03, &
7755 & .1922E-03,-.1028E-03,-.5823E-04,-.7954E-04,-.2550E-04,-.3893E-04, &
7756 &-.3776E-03,-.1043E-03,-.7993E-04,-.7422E-04,-.4948E-04,-.3007E-04, &
7757 &-.3863E-04, .8335E-04,-.5709E-04,-.6090E-04,-.7840E-04,-.3692E-04, &
7758 &-.3007E-04,-.4251E-04,-.6204E-04,-.4872E-04,-.3806E-04,-.4681E-04, &
7759 &-.3463E-04,-.3007E-04,-.4312E-04,-.1142E-04,-.5176E-04,-.5024E-04, &
7760 &-.3007E-04,-.3730E-04,-.3037E-04,-.3888E-04, .2550E-04,-.6508E-04, &
7761 &-.2512E-04,-.3083E-04,-.3197E-04,-.3041E-04,-.3750E-04, .1484E-04, &
7762 &-.1941E-04,-.2626E-04,-.3349E-04,-.3463E-04,-.2896E-04,-.1716E-04, &
7763 &-.7231E-04,-.3920E-04,-.2893E-04,-.3540E-04,-.3311E-04,-.3734E-04, &
7764 &-.2550E-05,-.7650E-04,-.3159E-04,-.2778E-04,-.3121E-04,-.2169E-04, &
7765 &-.4365E-04,-.1546E-04,-.7916E-04,-.2931E-04,-.2854E-04,-.3654E-04, &
7766 &-.1979E-04,-.4811E-04,-.1435E-04/
7768 ! block data ckd17_new
7769 ! *********************************************************************
7770 ! hk is the interval in the g (cumulative probability) space from 0
7771 ! to one. coeh2o is the coefficient to calculate the H2O absorption
7772 ! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
7773 ! teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
7774 ! The spectral region is from 400 to 280 cm**-1.
7775 ! *********************************************************************
7776 real hk_17_new(7), coeh2o_17_new(3,19,7)
7777 data hk_17_new / .12, .26, .22, .20, .10, .085, .015 /
7778 data ( ( ( coeh2o_17_new(k,j,i), i = 1, 7), j = 1, 19), k = 1, 3)/ &
7779 &-.2255E+02,-.2000E+02,-.1703E+02,-.1282E+02,-.9215E+01,-.5938E+01, &
7780 &-.2009E+01,-.2209E+02,-.1997E+02,-.1657E+02,-.1236E+02,-.8764E+01, &
7781 &-.5499E+01,-.1582E+01,-.2163E+02,-.1993E+02,-.1611E+02,-.1191E+02, &
7782 &-.8324E+01,-.5061E+01,-.1170E+01,-.2117E+02,-.1990E+02,-.1565E+02, &
7783 &-.1146E+02,-.7889E+01,-.4631E+01,-.7737E+00,-.2071E+02,-.1987E+02, &
7784 &-.1519E+02,-.1100E+02,-.7440E+01,-.4179E+01,-.3719E+00,-.2026E+02, &
7785 &-.1985E+02,-.1473E+02,-.1054E+02,-.6995E+01,-.3721E+01, .0000E+00, &
7786 &-.2024E+02,-.1982E+02,-.1426E+02,-.1009E+02,-.6549E+01,-.3284E+01, &
7787 & .4053E+00,-.2022E+02,-.1980E+02,-.1381E+02,-.9639E+01,-.6097E+01, &
7788 &-.2821E+01, .8375E+00,-.2021E+02,-.1933E+02,-.1335E+02,-.9187E+01, &
7789 &-.5653E+01,-.2379E+01, .1272E+01,-.2010E+02,-.1503E+02,-.1125E+02, &
7790 &-.7665E+01,-.4492E+01,-.1893E+01, .1642E+01,-.1747E+02,-.1278E+02, &
7791 &-.9547E+01,-.6120E+01,-.3756E+01,-.1443E+01, .1995E+01,-.1529E+02, &
7792 &-.1095E+02,-.8107E+01,-.5036E+01,-.3182E+01,-.1032E+01, .2429E+01, &
7793 &-.1370E+02,-.9303E+01,-.6691E+01,-.4357E+01,-.2683E+01,-.6173E+00, &
7794 & .2805E+01,-.1150E+02,-.7859E+01,-.5618E+01,-.3843E+01,-.2234E+01, &
7795 &-.2171E+00, .2973E+01,-.9590E+01,-.6537E+01,-.4886E+01,-.3355E+01, &
7796 &-.1805E+01, .1615E+00, .3157E+01,-.7530E+01,-.5699E+01,-.4306E+01, &
7797 &-.2892E+01,-.1388E+01, .5448E+00, .3155E+01,-.6758E+01,-.5112E+01, &
7798 &-.3809E+01,-.2464E+01,-.9947E+00, .8713E+00, .3203E+01,-.6245E+01, &
7799 &-.4610E+01,-.3376E+01,-.2058E+01,-.6166E+00, .1073E+01, .3109E+01, &
7800 &-.5777E+01,-.4175E+01,-.2963E+01,-.1671E+01,-.2556E+00, .1241E+01, &
7801 & .3014E+01, .4264E-01, .1968E-02, .1863E-01, .1436E-01, .1101E-01, &
7802 & .1055E-01, .1281E-01, .4264E-01, .1989E-02, .1861E-01, .1438E-01, &
7803 & .1095E-01, .1030E-01, .1211E-01, .3996E-01, .1968E-02, .1861E-01, &
7804 & .1434E-01, .1103E-01, .1019E-01, .1160E-01, .3600E-01, .1947E-02, &
7805 & .1861E-01, .1442E-01, .1086E-01, .1003E-01, .1157E-01, .3203E-01, &
7806 & .5756E-02, .1861E-01, .1444E-01, .1080E-01, .9922E-02, .1151E-01, &
7807 & .2801E-01, .9713E-02, .1859E-01, .1446E-01, .1070E-01, .9880E-02, &
7808 & .1066E-01, .2393E-01, .1369E-01, .1859E-01, .1451E-01, .1057E-01, &
7809 & .9880E-02, .1072E-01, .1987E-01, .1767E-01, .1863E-01, .1451E-01, &
7810 & .1040E-01, .9880E-02, .1057E-01, .1572E-01, .2169E-01, .1863E-01, &
7811 & .1442E-01, .1022E-01, .9742E-02, .1036E-01, .3391E-02, .1884E-01, &
7812 & .1566E-01, .1105E-01, .1011E-01, .1001E-01, .1017E-01, .1982E-01, &
7813 & .1444E-01, .1189E-01, .1030E-01, .9859E-02, .9861E-02, .1038E-01, &
7814 & .1748E-01, .1321E-01, .9922E-02, .1068E-01, .1013E-01, .9937E-02, &
7815 & .9958E-02, .1346E-01, .9943E-02, .9566E-02, .1097E-01, .9815E-02, &
7816 & .9964E-02, .1059E-01, .9817E-02, .7159E-02, .8687E-02, .1114E-01, &
7817 & .1007E-01, .1014E-01, .1058E-01, .3370E-02, .7264E-02, .9378E-02, &
7818 & .1112E-01, .9767E-02, .1016E-01, .1101E-01, .2993E-02, .8017E-02, &
7819 & .9566E-02, .1116E-01, .9738E-02, .1025E-01, .1086E-01, .8331E-02, &
7820 & .8771E-02, .1001E-01, .1117E-01, .9847E-02, .1076E-01, .1084E-01, &
7821 & .7850E-02, .9378E-02, .1001E-01, .1105E-01, .9964E-02, .1113E-01, &
7822 & .1168E-01, .8038E-02, .9336E-02, .9817E-02, .1096E-01, .1024E-01, &
7823 & .1175E-01, .1107E-01,-.2188E-03,-.2283E-05,-.8069E-04,-.4415E-04, &
7824 &-.2284E-04,-.4491E-04,-.4518E-04,-.2196E-03,-.2665E-05,-.8107E-04, &
7825 &-.4301E-04,-.2398E-04,-.4795E-04,-.4693E-04,-.2683E-03,-.3045E-05, &
7826 &-.8107E-04,-.4301E-04,-.2246E-04,-.4757E-04,-.4152E-04,-.3403E-03, &
7827 &-.4187E-05,-.8031E-04,-.3996E-04,-.1865E-04,-.4301E-04,-.4350E-04, &
7828 &-.4118E-03, .6584E-04,-.8107E-04,-.4034E-04,-.1903E-04,-.4643E-04, &
7829 &-.4834E-04,-.4803E-03, .1378E-03,-.8069E-04,-.4072E-04,-.1713E-04, &
7830 &-.5176E-04,-.3460E-04,-.4099E-03, .2101E-03,-.8069E-04,-.3920E-04, &
7831 &-.1713E-04,-.5024E-04,-.3524E-04,-.3391E-03, .2809E-03,-.7992E-04, &
7832 &-.3616E-04,-.2017E-04,-.5633E-04,-.4886E-04,-.2668E-03, .2078E-03, &
7833 &-.8069E-04,-.3768E-04,-.2131E-04,-.5580E-04,-.5454E-04,-.2207E-04, &
7834 &-.8601E-04,-.4643E-04,-.2436E-04,-.4148E-04,-.5458E-04,-.4579E-04, &
7835 &-.5138E-04,-.2893E-04,-.3273E-04,-.3882E-04,-.3920E-04,-.5035E-04, &
7836 &-.3170E-04,-.2169E-04,-.3007E-04,-.2740E-04,-.5328E-04,-.4491E-04, &
7837 &-.4403E-04,-.6383E-04, .4834E-04,-.2702E-04,-.4453E-04,-.4339E-04, &
7838 &-.4457E-04,-.4551E-04,-.8133E-04, .3768E-04,-.7611E-06,-.2626E-04, &
7839 &-.4643E-04,-.4305E-04,-.4840E-04,-.5149E-04, .7193E-04,-.2169E-04, &
7840 &-.4491E-04,-.3996E-04,-.4483E-04,-.4487E-04,-.6698E-04,-.4834E-04, &
7841 &-.3463E-04,-.4986E-04,-.4377E-04,-.4514E-04,-.5377E-04,-.2626E-04, &
7842 &-.4187E-04,-.3692E-04,-.5100E-04,-.4651E-04,-.4392E-04,-.5386E-04, &
7843 &-.4643E-04,-.4301E-04,-.3578E-04,-.5176E-04,-.4594E-04,-.4551E-04, &
7844 &-.3920E-04,-.3425E-04,-.4491E-04,-.3654E-04,-.5138E-04,-.4377E-04, &
7845 &-.5614E-04,-.5758E-04,-.3600E-04/
7847 ! block data ckd18_new
7848 ! *********************************************************************
7849 ! hk is the interval in the g (cumulative probability) space from 0
7850 ! to one. coeh2o is the coefficient to calculate the H2O absorption
7851 ! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
7852 ! teen pressures, and eight cumulative probabilities ( Fu, 1991 ).
7853 ! The spectral region is from 280 to 0 cm**-1.
7854 ! *********************************************************************
7855 real hk_18_new(8), coeh2o_18_new(3,19,8)
7856 data hk_18_new / .07, .1, .2, .25, .2, .1, .03, .02 /
7857 data ( ( ( coeh2o_18_new(k,j,i), i = 1, 8), j = 1, 19), k = 1, 3)/ &
7858 &-.2121E+02,-.2002E+02,-.1676E+02,-.1274E+02,-.8780E+01,-.5167E+01, &
7859 &-.2692E+01,-.6275E+00,-.2075E+02,-.1996E+02,-.1630E+02,-.1228E+02, &
7860 &-.8324E+01,-.4718E+01,-.2260E+01,-.2303E+00,-.2029E+02,-.1990E+02, &
7861 &-.1584E+02,-.1182E+02,-.7868E+01,-.4269E+01,-.1806E+01, .1645E+00, &
7862 &-.2022E+02,-.1985E+02,-.1538E+02,-.1136E+02,-.7417E+01,-.3820E+01, &
7863 &-.1373E+01, .5657E+00,-.2018E+02,-.1981E+02,-.1492E+02,-.1090E+02, &
7864 &-.6965E+01,-.3369E+01,-.9319E+00, .9577E+00,-.2013E+02,-.1937E+02, &
7865 &-.1446E+02,-.1044E+02,-.6512E+01,-.2917E+01,-.4928E+00, .1376E+01, &
7866 &-.2009E+02,-.1891E+02,-.1400E+02,-.9984E+01,-.6063E+01,-.2466E+01, &
7867 &-.6887E-01, .1768E+01,-.2006E+02,-.1845E+02,-.1354E+02,-.9530E+01, &
7868 &-.5618E+01,-.2024E+01, .3615E+00, .2196E+01,-.2003E+02,-.1800E+02, &
7869 &-.1308E+02,-.9075E+01,-.5174E+01,-.1593E+01, .7820E+00, .2600E+01, &
7870 &-.1827E+02,-.1464E+02,-.1097E+02,-.7525E+01,-.3733E+01,-.1077E+01, &
7871 & .1204E+01, .3014E+01,-.1525E+02,-.1210E+02,-.9275E+01,-.5876E+01, &
7872 &-.2768E+01,-.6286E+00, .1622E+01, .3394E+01,-.1298E+02,-.1060E+02, &
7873 &-.7764E+01,-.4462E+01,-.2154E+01,-.2001E+00, .2034E+01, .3756E+01, &
7874 &-.1157E+02,-.8941E+01,-.5984E+01,-.3509E+01,-.1651E+01, .2279E+00, &
7875 & .2422E+01, .4066E+01,-.9986E+01,-.7062E+01,-.4794E+01,-.2818E+01, &
7876 &-.1196E+01, .6394E+00, .2791E+01, .4283E+01,-.8064E+01,-.5512E+01, &
7877 &-.3933E+01,-.2274E+01,-.7559E+00, .1036E+01, .3085E+01, .4444E+01, &
7878 &-.6440E+01,-.4863E+01,-.3219E+01,-.1791E+01,-.3279E+00, .1427E+01, &
7879 & .3304E+01, .4527E+01,-.5902E+01,-.4207E+01,-.2756E+01,-.1350E+01, &
7880 & .7686E-01, .1776E+01, .3475E+01, .4550E+01,-.5439E+01,-.3739E+01, &
7881 &-.2330E+01,-.9233E+00, .4612E+00, .2066E+01, .3564E+01, .4502E+01, &
7882 &-.5006E+01,-.3316E+01,-.1906E+01,-.5066E+00, .8352E+00, .2272E+01, &
7883 & .3587E+01, .4419E+01, .2338E-01, .1968E-02, .9503E-02, .3412E-02, &
7884 & .6280E-03,-.1109E-02,-.1089E-02,-.1026E-02, .1972E-01, .2093E-02, &
7885 & .9503E-02, .3391E-02, .6489E-03,-.1172E-02,-.1164E-02,-.1158E-02, &
7886 & .1603E-01, .3328E-02, .9524E-02, .3391E-02, .6489E-03,-.1277E-02, &
7887 &-.1229E-02,-.1296E-02, .1229E-01, .7138E-02, .9524E-02, .3370E-02, &
7888 & .6070E-03,-.1319E-02,-.1264E-02,-.1610E-02, .8478E-02, .1095E-01, &
7889 & .9566E-02, .3412E-02, .5652E-03,-.1382E-02,-.1266E-02,-.1566E-02, &
7890 & .4563E-02, .1480E-01, .9566E-02, .3412E-02, .5443E-03,-.1423E-02, &
7891 &-.1199E-02,-.1679E-02, .2261E-02, .1865E-01, .9608E-02, .3454E-02, &
7892 & .4815E-03,-.1423E-02,-.1296E-02,-.1555E-02, .2198E-02, .2250E-01, &
7893 & .9671E-02, .3412E-02, .4187E-03,-.1426E-02,-.1472E-02,-.1800E-02, &
7894 & .2072E-02, .2600E-01, .9734E-02, .3433E-02, .3977E-03,-.1428E-02, &
7895 &-.1541E-02,-.1591E-02, .1987E-01, .8645E-02, .6280E-02, .1298E-02, &
7896 &-.1151E-02,-.1509E-02,-.1662E-02,-.1570E-02, .4668E-02, .8373E-02, &
7897 & .3956E-02,-.4187E-04,-.1968E-02,-.1624E-02,-.1700E-02,-.1947E-02, &
7898 & .9231E-02, .5694E-02, .1444E-02,-.2512E-03,-.1827E-02,-.1662E-02, &
7899 &-.1576E-02,-.1633E-02, .8666E-02, .3077E-02,-.1737E-02,-.1277E-02, &
7900 &-.1507E-02,-.1757E-02,-.1612E-02,-.1612E-02, .8164E-03,-.4375E-02, &
7901 &-.1884E-02,-.1277E-02,-.1564E-02,-.1853E-02,-.1591E-02,-.1486E-02, &
7902 &-.1486E-02,-.2596E-02,-.1633E-02,-.1539E-02,-.1662E-02,-.1846E-02, &
7903 &-.1423E-02,-.1277E-02,-.1423E-02,-.2617E-02,-.1005E-02,-.1379E-02, &
7904 &-.1687E-02,-.1905E-02,-.1528E-02,-.1298E-02,-.1675E-03,-.1947E-02, &
7905 &-.5024E-03,-.1325E-02,-.1696E-02,-.1698E-02,-.1486E-02,-.1277E-02, &
7906 & .1047E-03,-.1109E-02,-.5861E-03,-.1363E-02,-.1620E-02,-.1666E-02, &
7907 &-.1507E-02,-.9210E-03, .1047E-03,-.1047E-02,-.8394E-03,-.1342E-02, &
7908 &-.1591E-02,-.1323E-02,-.1340E-02,-.9420E-03,-.1085E-03, .2283E-05, &
7909 &-.4719E-04,-.3807E-06,-.1522E-05,-.3425E-05,-.7612E-06, .1751E-05, &
7910 &-.1766E-03, .1523E-05,-.4719E-04,-.7609E-06,-.3807E-06,-.3045E-05, &
7911 & .1599E-05, .8723E-05,-.2443E-03, .1941E-04,-.4757E-04,-.1522E-05, &
7912 &-.3806E-06,-.1903E-05,-.2778E-05, .1294E-04,-.1838E-03, .8563E-04, &
7913 &-.4757E-04,-.1903E-05, .1142E-05,-.2664E-05,-.6090E-06, .1321E-04, &
7914 &-.1161E-03, .1526E-03,-.4757E-04,-.2664E-05,-.3805E-06,-.3806E-05, &
7915 &-.2093E-05, .2253E-04,-.4795E-04, .9248E-04,-.4757E-04,-.1903E-05, &
7916 & .0000E+00,-.3045E-05,-.7992E-06, .1393E-04,-.9134E-05, .2246E-04, &
7917 &-.4834E-04,-.2664E-05, .3804E-06,-.5328E-05,-.1510E-05, .1465E-04, &
7918 &-.1028E-04,-.4757E-04,-.4948E-04,-.1142E-05, .7614E-06,-.4910E-05, &
7919 &-.5709E-06, .1477E-04,-.1256E-04,-.1066E-03,-.4910E-04,-.1523E-05, &
7920 &-.3805E-06,-.3121E-05,-.2512E-05, .1142E-04,-.7878E-04,-.2664E-05, &
7921 &-.8373E-05,-.7612E-06, .1104E-04,-.3311E-05,-.1979E-05, .5709E-05, &
7922 &-.2626E-04,-.4872E-04,-.3808E-06,-.2283E-05, .2284E-05,-.3349E-05, &
7923 &-.4034E-05, .7231E-05,-.4910E-04, .1599E-04, .1256E-04,-.7612E-05, &
7924 & .1180E-05,-.1815E-05,-.7193E-05, .3045E-05, .1576E-09, .6470E-05, &
7925 &-.1408E-04,-.1903E-05, .1522E-05,-.4746E-05,-.4948E-05, .3806E-06, &
7926 & .9020E-04, .5214E-04, .6090E-05,-.1104E-04, .1180E-05,-.2778E-05, &
7927 &-.6090E-05,-.2664E-05,-.6737E-04,-.1218E-04,-.3806E-05,-.5214E-05, &
7928 &-.1066E-05,-.1294E-05,-.3045E-05,-.2664E-05,-.4643E-04, .1713E-04, &
7929 &-.1218E-04,-.6204E-05,-.2360E-05,-.1979E-05,-.1903E-05,-.3806E-05, &
7930 &-.3045E-04,-.1256E-04,-.9134E-05,-.6508E-05,-.1027E-05,-.7993E-06, &
7931 &-.1142E-05,-.7992E-05,-.3616E-04,-.1028E-04,-.1066E-04,-.6051E-05, &
7932 & .1066E-05,-.1751E-05,-.2284E-05,-.2284E-05,-.3920E-04,-.9895E-05, &
7933 &-.1321e-04,-.3844E-05,-.2055E-05,-.2512E-05,-.3806E-05,-.3425E-05/
7934 end module band_new
7937 !--------------------------------------------------------------------------------
7939 MODULE module_ra_FLG
7940 contains
7941 !******************************************************************************
7942 !* This subroutine drives the Fu-Liou radiation program which solves the solar
7943 !* and IR radiation in the atmosphere.
7944 !* ****************************************************************************
7945 subroutine RAD_FLG &
7946 & (peven, podd, t8w,degrees &
7947 & , pi3d &
7948 & , o3 &
7949 & , G, Cp &
7950 & , albedo &
7951 & , tskin &
7952 & , h2o,cld_iccld, cld_wlcld &
7953 & , cld_prwc, cld_pgwc &
7954 & , cld_snow &
7955 & , F_QV,F_QC,F_QR,F_QI,F_QS,F_QG &
7956 & , warm_rain &
7957 !-- for partly cloudy &
7958 & , cloudstrf &
7959 & , emiss &
7960 & , air_den &
7961 & , dz3d &
7962 & , SOLCON &
7963 & , declin &
7964 & , xtime, xlong, xlat, JULDAY, gmt, radt, degrad &
7965 & , dtcolumn &
7966 !-- change over
7967 !-- add for aerosol indirect effect
7968 ! & , vertical_w
7969 !-- add over
7970 & , ids,ide, jds,jde, kds,kde &
7971 & , ims,idim, jms,jdim, kms,kmax &
7972 & , its,ite, jts,jte, kts,kte &
7973 !-- output
7974 ! & , dswtop, dswbot, swinc &
7975 ! & , ulwtop, ulwbot, dlwbot, netlwstr, netlwbot &
7976 & , uswtop, ulwtop,NETSWBOT,DLWBOT,DSWBOT &
7977 & , deltat,dtshort, dtlongwv &
7978 !-- amontornes-bcodina (2014-04-29): return direct and diffuse fluxes at surface
7979 & , swddir,swddif,swddni &
7980 !-- for optional aerosol input
7981 ! & , tau_aer_2D, tau_aer_3D, fraca_in &
7982 !-- change over
7983 & )
7985 !C$Id: driver_rad.F,v 1.8 2002/04/17 18:40:13 gu Exp gu $
7986 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7987 !* Input:
7988 !* PEVEN = Even level Atmospheric Pressure (mb, = 1000pa = 1hpa)
7989 !* PODD = Odd level Atmospheric Pressure (mb)
7990 !* PBIG = odd level dimensionless pressure
7991 !* PHAT = even level dimensionless pressure (see eq. 4.14 AS83)
7992 !* DEGREES = Odd level Atmospheric Temperature(K)
7993 !* H2O = wate vapor mixing ratio (kg/kg)
7994 !* O3 = Ozone mixing ratio (kg/kg)
7995 !* CLD_ICCLD = Ice water mixing ratio (kg/kg). need to conver to content (g/m**3)
7996 !* CLD_WLCLD = Liquid water mixing ratio (kg/kg). Need to convert content (g/m**3)
7997 !* air_den: air density (kg/m**3)
7998 !* dz3d: dz between full levels
7999 !* COSZENTH = cosine of the zenith angle
8000 !* emiss = IR surface emissivity
8001 !* ALBEDO = surface albedo
8002 !* TSKIN = ground temperature (degrees k)
8003 !* TSURFACE = surface air temperature (degrees K)
8004 !* TBOUND = temperature at even level between the PBL and troposphere
8005 !* TEMP3D = temporary 3d array used to interpolate to pressure coord
8006 !* add by Yu for aerosol indirect effect
8007 !* VERTICAL_W = vertical velocity in m/s
8010 !* Output:
8011 !* USWTOP = upward solar flux at TOA (down-up)
8012 !* DSWTOP = net downward solar flux at TOA (down-up)
8013 !* DSWBOT = net downward solar flux at surface (down-up)
8014 !* swddir = direct horizontal irradiance (amontornes-bcodina, 2014-04-29)
8015 !* swddif = diffuse irradiance (amontornes-bcodina, 2014-04-29)
8016 !* swddni = direct normal irradiance (amontornes-bcodina, 2014-04-29)
8017 !* SWINC = solar flux incident at TOA
8018 !* DELTAT = total column physics increment to theta
8019 !
8020 !* ULWBOT = upward IR flux at surface
8021 !* DLWBOT = downward IR flux at surface
8022 !* ULWTOP = upward IR flux at TOA
8023 !* NETLWSTR = net IR flux at top of PBL stratus cloud layer
8024 !* NETLWBOT = net IR flux at surface (up-down)
8025 !* DELTAT = total column physics increment to theta (K)
8027 !* 1D array input to Fu-Liou program:
8028 !* pij = Atmospheric Pressure (mb)
8029 !* tij = Atmospheric Temperature (K)
8030 !* qij = Water vapor mixing ratio
8031 !* o3ij = Ozone mixing ratio
8032 !* piwc = Ice water content (g/m**3)
8033 !* plwc = Liquid water content (g/m**3)
8034 !* prwc = Rain water content (g/m**3)
8035 !* pgwc = graupel water content (g/m**3) or aerosol concentration (m-3)
8036 !* u0ij = cosine of the zenith angle
8037 !* as = Solar surface albedo
8038 !* tsij = Ground temperature
8039 !* ee = IR surface emissivity
8040 !
8041 !* Prescribed inaut to Fu-Liou program:
8042 !* pde = Effective size of ice cloud (um)
8043 !* pre = Effective radius of water cloud (um)
8044 !*****************************************************************************
8045 !* INCLUDE files
8046 !*****************************************************************************
8047 USE PARA_FILE
8048 ! USE module_wrf_error
8049 USE control_para
8050 !************************************************************************
8051 !* Declare all local variables
8052 !************************************************************************
8053 implicit none
8054 real weight, FAC, CNVERT
8055 integer i, j, k, icycle, i1,i2, j1,j2, k1x, k2x, ilo,ihi, jlo,jhi, ii
8056 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
8057 INTEGER, INTENT(IN ) :: ims,idim, jms,jdim, kms,kmax
8058 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
8059 INTEGER, INTENT(IN ) :: JULDAY
8060 LOGICAL, INTENT(IN ) :: F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
8061 LOGICAL, INTENT(IN ) :: warm_rain
8062 ! real, INTENT(IN ), optional :: tau_aer_2D(ims:idim,jms:jdim) &
8063 ! & ,tau_aer_3D(ims:idim,jms:jdim,kms:kmax)
8064 ! real, INTENT(IN ), optional :: fraca_in(mxac)
8065 real, INTENT(IN ) :: dtcolumn
8067 real declin, solcon, G, FP, CP
8068 real GMT, radt, degrad, xtime
8069 real pi3d(ims:idim,kms:kmax,jms:jdim)
8070 real peven(ims:idim,kms:kmax,jms:jdim)
8071 real podd(ims:idim, kms:kmax,jms:jdim)
8072 real dpeven(ims:idim,kms:kmax, jms:jdim)
8073 real degrees(ims:idim,kms:kmax, jms:jdim)
8074 real t8w(ims:idim,kms:kmax, jms:jdim)
8075 real dz3d(ims:idim,kms:kmax, jms:jdim)
8076 real air_den(ims:idim,kms:kmax, jms:jdim)
8077 real emiss(ims:idim, jms:jdim)
8078 real dz3dd(ims:idim,kms:kmax, jms:jdim)
8079 real h2o(ims:idim,kms:kmax, jms:jdim)
8080 real o3(ims:idim,kms:kmax, jms:jdim)
8081 real po3(ims:idim,kms:kmax, jms:jdim)
8082 real po3top(ims:idim, jms:jdim)
8083 real cld_iccld(ims:idim,kms:kmax, jms:jdim)
8084 real cld_wlcld(ims:idim,kms:kmax, jms:jdim)
8085 real cld_prwc(ims:idim,kms:kmax, jms:jdim)
8086 real cld_pgwc(ims:idim,kms:kmax, jms:jdim)
8087 real cld_snow(ims:idim,kms:kmax, jms:jdim)
8088 !--- change for fractional cloud
8089 real cloudstrf(ims:idim,kms:kmax, jms:jdim)
8091 !--- add for aerosol indirect effect
8092 ! real vertical_w(-1:idim, -1:jdim, kmax)
8093 !---- add over
8095 !--- add for cloud inhomogeneity
8096 real ccc_inho(ims:idim,kms:kmax,jms:jdim)
8097 real temp_inho_low(ims:idim,jms:jdim)
8098 real temp_inho_mid(ims:idim, jms:jdim)
8099 real temp_inho_high(ims:idim, jms:jdim)
8101 !-- change over
8102 !--- add by Yu for aerosol
8103 real,dimension(mxat,mxac) :: a_wlis,a_taus
8104 real,dimension(nvx,mxac) :: aprofs
8105 real :: sh_aer(mxac)
8106 ! integer, dimension(mxac) :: itps
8107 real :: tau_aer, tot = 0.0
8108 real, dimension(mxac) :: fraca = -9999., tauindividual = -9999.
8109 integer :: iac
8110 character :: reading = "Y"
8112 character*3 aerosol_type
8113 !-- add over
8115 !c--- add for de-iwc
8117 real amean(4),bmean(4),cmean(4)
8118 real amax(4),bmax(4),cmax(4)
8119 real amin(4),bmin(4),cmin(4)
8121 data amin /0.54763e01, 0, 0.43976e01, 0.47890e01/
8122 data bmin /0.55175, 0, 0.11286, 0.34200/
8123 data cmin /0.26934e-1, 0, 0, -0.58155e-2/
8125 data amean /0.54199e01, 0.43257e01, 0.52375e01, 0.4851e01/
8126 data bmean /0.35211, 0.26535, 0.13142, 0.33159/
8127 data cmean /0.1268e-1, 0.21864e-1, 0., 0.26189e-1/
8129 data amax /0.53544e01, 0.51222e01, 0.53341e01, 0.48755e01/
8130 data bmax /0.30605, 0.38239, 0.10258, 0.35331/
8131 data cmax /0.11531e-1, 0.27872e-1, 0, 0.36475e-1/
8133 real pdeiwc_mean(4), pdeiwc_max(4), pdeiwc_min(4)
8134 data pdeiwc_min /14.2067, 29, 0, 0/
8135 data pdeiwc_mean /19.6, 33.81, 0, 0/
8136 data pdeiwc_max /27.76, 45.18, 0, 55.7/
8138 real iwc_mean(4), iwc_max(4), iwc_min(4)
8139 data iwc_min /5.e-5, 0, 0, 0/
8140 data iwc_mean /9.2125e-7, 0.0024, 0, 0/
8141 data iwc_max /1.75e-6, 0.0011, 0, 0.0082/
8143 integer ncoef, nsat
8144 real temp_i, ran1, x
8145 real diff, diff_min, diff_max
8146 real pde_max, pde_mean, pde_min, pde_ran
8147 real pde_min_temp, pde_max_temp
8148 real palpha, pbeta, pgama, peta, pde0, piwc0, pco0, paot
8149 real a1denom, a2num, a2denom
8150 !c--- add over
8152 !C--- for NPDE = 3, De-IWC using satellite data
8153 logical clean
8154 real a_sat(2),b_sat(2)
8155 data a_sat /4.07, 4.03/
8156 data b_sat /0.032, 0.046/
8158 !C--- for NPDE = 4, De-IWC-AOT using satellite data
8159 real palpha_all(4),pbeta_all(4), pgamma_all(4), peta_all(4)
8160 real pde0_all(4), piwc0_all(4), pco0_all(4)
8161 !C--- dim: 1=Global; 2=South America; 3=Africa; 4=Asia
8162 data palpha_all /1.322, 1.396, 1.842, 1.509/
8163 data pbeta_all /0.544, 1.095, 1.823, 0.973/
8164 data pgamma_all /0.407, 0.533, 0.520, 0.921/
8165 data peta_all /0.085, 0.007, 0.005, 0.188/
8166 data pde0_all /48.383, 55.536, 53.144, 35.03/
8167 data piwc0_all /1.165, 1.7, 2.277, 2.204/
8168 data pco0_all /7.322, 88.532, 157.24, 6.723/
8169 !c--- add over
8171 real coszenth(ims:idim, jms:jdim), albedo(ims:idim, jms:jdim)
8172 real tskin(ims:idim,jms:jdim), tbound(ims:idim,jms:jdim)
8173 real tsurface(ims:idim,jms:jdim)
8174 real xlat(ims:idim,jms:jdim), xlong(ims:idim, jms:jdim)
8176 real dswtop(ims:idim,jms:jdim) , dswbot(ims:idim,jms:jdim)
8177 !c--- amontornes-bcodina (2014-04-29): for DHI, DIF and DNI outputs
8178 real swddir(ims:idim,jms:jdim)
8179 real swddif(ims:idim,jms:jdim)
8180 real swddni(ims:idim,jms:jdim)
8181 real uswtop(ims:idim,jms:jdim)
8182 real netswbot(ims:idim,jms:jdim)
8183 real swinc(ims:idim,jms:jdim)
8184 real ulwbot(ims:idim,jms:jdim), dlwbot(ims:idim,jms:jdim)
8185 real ulwtop(ims:idim,jms:jdim)
8186 real netlwstr(ims:idim,jms:jdim), netlwbot(ims:idim,jms:jdim)
8188 real dtshort(ims:idim,kms:kmax,jms:jdim)
8189 real dtlongwv(ims:idim,kms:kmax, jms:jdim)
8190 real deltat(ims:idim,kms:kmax,jms:jdim)
8192 ! add for ozone profile
8193 ! iprof = 1 : mid-latitude summer profile
8194 ! = 2 : mid-latitude winter profile
8195 ! = 3 : sub-arctic summer profile
8196 ! = 4 : sub-arctic winter profile
8197 ! = 5 : tropical profile
8198 integer :: iprof
8199 integer :: is_summer, ie_summer
8200 real :: center_lat
8202 integer :: NK
8203 real :: RZERO, tsij, xt24, tloctm, hrang, xxlat, u0ij, &
8204 & temp_iwc, temp_t, temp_de
8206 !************************************************************************
8207 !* Variables used in Fu-Liou code
8208 !************************************************************************
8210 real as(mbs),as1(10), ee(mbir)
8211 real pij(kmax), tij(kmax), qij(kmax), o3ij(kmax)
8212 real piwc(kmax-1), pde(kmax-1)
8213 real plwc(kmax-1), pre(kmax-1)
8214 real prwc(kmax-1), pgwc(kmax-1)
8215 real PHYD(kmax)
8216 !C-- change for fractional cloud
8217 real cldamnt(kmax-1)
8218 real cc_inho(kmax-1)
8219 !C-- change over
8220 real fds(kmax), fus(kmax), dts(kmax-1)
8221 real fdir(kmax), fuir(kmax), dtir(kmax-1)
8222 real fd(kmax), fu(kmax), dt_rad(kmax-1)
8223 !C-- amontornes-bcodina (2014-04-29): direct and diffuse fluxes
8224 real fdsdir(kmax), fdsdif(kmax)
8226 !***************************************************************************
8227 !* Use Fu-Liou radiation routine and algorithm
8228 !***************************************************************************
8230 !C FAC CONVERTS TO DEGREES / TIME STEP
8231 ! FAC = 9.8d-01 * dtcolumn / (1.0030d04)
8232 FAC = 0.01*G /Cp
8234 !C CNVERT INCLUDES STEFAN BOLTZMAN CONSTANT FOR CALCULATION OF netlwstr
8236 CNVERT = 1.171d-07*420.0d0/864.0d0
8237 RZERO = 0.
8239 !C*************************************************************************
8240 if (ngas.eq.0) then
8241 umco = 0.0
8242 umo2 = 0.0
8243 umno = 0.0
8244 umso2 = 0.0
8245 umno2 = 0.0
8246 umch3cl = 0.0
8247 umCFC11 = 0.0
8248 umCFC12 = 0.0
8249 end if
8252 !************************************************************************************
8254 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8256 !C--- aerosol input
8257 !C---- No aerosol
8258 if (NAERO.eq.0) then
8259 ! do j=jms,jdim
8260 ! do i=ims,idim
8261 tau_aer = 0.0
8262 endif
8264 if (NAERO.eq.1) then
8265 ! do j=jms,jdim
8266 ! do i=ims,idim
8267 tau_aer = 0.2
8268 endif
8270 !C---- aerosol data use uniform optical depth
8271 ! if (NAERO.eq.2) then
8272 ! do j=jms,jdim
8273 ! do i=ims,idim
8274 ! if (present(fraca_in)) then
8275 ! fraca = fraca_in
8276 ! nfraca = 0
8277 ! if (present(tau_aer_3D)) ivd = 2
8278 ! end if
8279 ! endif
8282 !C--- get aerosol data from file
8283 ! if (NAERO.eq.2) then
8284 !C print *, 'b4 read aero'
8285 ! open (unit=97,file='aero_gcm_annual.climo_4x5', status='old')
8286 ! read(97,*) ((tau_aer_2D(i,j), i=1,72),j=1,44)
8287 !c open (unit=87,file='aero_gcm_annual_china.climo_4x5', status='old')
8288 !c read(87,*) tau_aer_2D
8289 !C print *, 'a4 read aero'
8290 !c close(87)
8291 ! close(97)
8292 ! endif
8294 !C-- add over
8296 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8298 !********************************************************************************
8299 !* Begin loop over the horizontal domain
8300 !* Note: The vertical levels of radiation program starts from top, end at surface
8301 !********************************************************************************
8302 !**** start column ***********************
8303 HORIZONTAL_J: do j = jts,jte
8304 HORIZONTAL_I: do i = its,ite
8305 ! do 300 j=jms, jmid
8306 ! do 200 i=ims,imid
8307 !C--- Zero out all water contents
8308 VERTICAL_PROFILE: do k=kts,kte
8309 piwc(k) = rzero
8310 pde(k) = rzero
8311 plwc(k) = rzero
8312 pre(k) = rzero
8313 prwc(k) = rzero
8314 pgwc(k) = rzero
8315 o3ij(k) = rzero
8316 !c--- change for fractional cloud
8317 cldamnt(k) = rzero
8318 !c--- add for inhomogeneous cloud
8319 if (ninho.eq.0) then
8320 cc_inho(k) = 1.0
8321 else
8322 cc_inho(k) = 0.7
8323 endif
8324 !C--- change over
8325 fds(k)=rzero
8326 fus(k)=rzero
8327 fdir(k)=rzero
8328 fuir(k)=rzero
8329 fd(k)=rzero
8330 fu(k)=rzero
8331 dts(k)=rzero
8332 dtir(k)=rzero
8333 dt_rad(k)=rzero
8334 !C--- amontornes-bcodina (2014-04-29): direct and diffuse fluxes
8335 fdsdir(k)=rzero
8336 fdsdif(k)=rzero
8338 enddo VERTICAL_PROFILE
8340 fds(kmax)=rzero
8341 fus(kmax)=rzero
8342 fdir(kmax)=rzero
8343 fuir(kmax)=rzero
8344 fd(kmax)=rzero
8345 fu(kmax)=rzero
8346 !C--- amontornes-bcodina (2014-04-29): direct and diffuse fluxes
8347 fdsdir(kmax)=rzero
8348 fdsdif(kmax)=rzero
8349 o3ij(kmax) = rzero
8352 !C---- ee is the IR surface emissivity
8353 ee(1:mbir) = emiss(i,j)
8355 ! *** the model k=1 start from sfc. need to reverse variable for radiation
8356 ! calculation
8358 !C
8359 tsij = tskin(i,j)
8360 !C-- change by 2Yu, 12/05/01, deal with too big ts
8361 if (tsij.gt.320.) tsij = 320.
8362 if (tsij.lt.180.) tsij = 180.
8363 !C--- change over
8365 qij(1) = h2o(i,kmax,j)
8366 qij(kmax) = h2o(i,1,j)
8367 !C---- give a larger value for surface qij if too small. by Yu Gu 11/13/01
8368 !C---- not necessary now when rad.F set minimum deltau value
8369 if (qij(kmax).lt. 1.0e-20) qij(kmax) = 1.0e-20
8370 if (qij(1).lt. 1.0e-20) qij(1) = 1.0e-20
8371 !C
8373 ! *** calculate coszenth
8374 xt24 = mod(xtime + radt * 0.5, 1440.)
8375 tloctm = GMT + xt24 / 60. + XLONG(i,j) / 15.
8376 hrang = 15. * (tloctm - 12.) * degrad
8377 xxlat = XLAT(i,j) * degrad
8378 u0ij = sin(xxlat) * sin(declin) + &
8379 cos(xxlat) * cos(declin) * cos(hrang)
8381 !C--- as is the solar surface albedo
8382 as(1:mbs) = albedo(i,j)
8384 ! *** begin to assign column values for radiation calculations ***!
8385 ! *** need to vertically reverse variables
8387 ! NEED HYDROSTATIC PRESSURE HERE (MONOTONIC CHANGE WITH HEIGHT)
8388 ! PHYD REPLACES P8W, PHYDMID REPLACES P3D
8389 PHYD(kts) = peven(I,kts,J)
8391 DO K = KTS,KTE
8392 PHYD(K+1) = peven(I,k+1,J)
8393 ENDDO
8395 ! pij(1) = peven(i,kmax,j)/100.
8396 ! pij(kmax) = peven(i,1,j)/100.
8397 pij(1) = PHYD(kmax)/100.
8398 pij(kmax) = PHYD(1)/100.
8400 !--- get ozone profile
8401 if (NOZONE.eq.0.) then ! no ozone
8402 po3(i,kms:kmax,j) = 0.
8403 else if (NOZONE.eq.1) then ! prescribed ozone profile
8404 !*******************************************************************!
8405 !**************************************************************************
8406 !--- add ozone profile
8407 ! need to change iprof, which is function of lat and julian day
8408 ! iprof = 1 : mid-latitude summer profile
8409 ! = 2 : mid-latitude winter profile
8410 ! = 3 : sub-arctic summer profile
8411 ! = 4 : sub-arctic winter profile
8412 ! = 5 : tropical profile
8413 center_lat = xlat(i,j)
8414 is_summer = 80 !Northern Hemisphere summer start
8415 ie_summer = 265 !Northern Hemisphere summer end
8417 IF (abs(center_lat) .le. 30. ) THEN ! tropic
8418 iprof = 5
8419 ELSE
8420 IF (center_lat .gt. 0.) THEN
8421 IF (center_lat .gt. 60. ) THEN ! arctic
8422 IF (JULDAY .gt. is_summer .and. JULDAY .lt. ie_summer ) THEN
8423 ! arctic summer
8424 iprof = 3
8425 ELSE
8426 ! arctic winter
8427 iprof = 4
8428 ENDIF
8429 ELSE ! midlatitude
8430 IF (JULDAY .gt. is_summer .and. JULDAY .lt. ie_summer ) THEN
8431 ! north midlatitude summer
8432 iprof = 1
8433 ELSE
8434 ! north midlatitude winter
8435 iprof = 2
8436 ENDIF
8437 ENDIF
8439 ELSE
8440 IF (center_lat .lt. -60. ) THEN ! antarctic
8441 IF (JULDAY .lt. is_summer .or. JULDAY .gt. ie_summer ) THEN
8442 ! antarctic summer
8443 iprof = 3
8444 ELSE
8445 ! antarctic winter
8446 iprof = 4
8447 ENDIF
8448 ELSE ! midlatitude
8449 IF (JULDAY .lt. is_summer .or. JULDAY .gt. ie_summer ) THEN
8450 ! south midlatitude summer
8451 iprof = 1
8452 ELSE
8453 ! south midlatitude winter
8454 iprof = 2
8455 ENDIF
8456 ENDIF
8457 ENDIF
8458 ENDIF
8459 !--- iprof change over
8460 call o3prof(iprof,kms,kmax,PHYD(kms:kmax)/100.,po3(i,kms:kmax,j))
8462 else if (NOZONE.eq.2) then !ozone profile passed from WRF
8463 ! no input at this time; do nothing
8464 endif
8465 o3ij(1) = po3(i,kmax,j)
8466 o3ij(kmax) = po3(i,1,j)
8468 tij(1) = t8w(i,kmax,j)
8469 tij(kmax) = t8w(i,1,j)
8470 !C--- if temp > 320, set to 320. by yu Gu, 11/14/01, if < 180, set to 180
8471 !C--- if change rad.F, no need to do it here
8472 !c if (tij(1) . gt. 320.) tij(1) = 320.
8473 !c if (tij(1) . lt. 180.) tij(1) = 180.
8474 !c if (tij(kmax) . gt. 320.) tij(1) = 320.
8475 !c if (tij(kmax) . lt. 180.) tij(1) = 180.
8477 !!!!!!!!!!!!!!! Assign Column Profile -----
8478 VERTICAL_PROFILE2: do k=2,kte
8479 NK=kmax-k+kms !mark
8480 pij(k) = PHYD(NK)/100.
8481 tij(k) = t8w(i,NK,j)
8483 o3ij(k)= po3(i,NK,j)
8486 !c--- for water vapor
8487 IF (F_QV) THEN
8488 qij(k) = h2o(i,NK,j)
8489 ENDIF
8490 if (qij(k).lt. 1.0e-20) qij(k) = 1.0e-20
8491 !C
8492 !c--- for liquid water
8493 IF (F_QC) THEN
8494 plwc(k) = cld_wlcld(i,NK-1,j)*air_den(i,NK-1,j)
8495 ! --- convert water content to g/m**3
8496 plwc(k) = plwc(k)*1.e3
8497 ENDIF
8500 !c--- for rain water and graupel
8501 IF (F_QR) THEN
8502 prwc(k) = cld_prwc(i,NK-1,j)*air_den(i,NK-1,j)
8503 prwc(k) = prwc(k)*1.e3
8504 ENDIF
8506 IF (F_QG) THEN
8507 pgwc(k) = cld_pgwc(i,NK-1,j)*air_den(i,NK-1,j)
8508 pgwc(k) = pgwc(k)*1.e3
8509 ENDIF
8511 !c--- for ice water
8512 IF ( F_QI ) THEN
8513 ! -- add snow into ice
8514 piwc(k) = (cld_iccld(i,NK-1,j)+cld_snow(i,NK-1,j)) &
8515 *air_den(i,NK-1,j)
8516 piwc(k) = piwc(k)*1.e3
8517 ELSE
8518 IF (.not.warm_rain) THEN
8519 IF (tij(k).lt.273.15) then
8520 ! assign liquid as ice
8521 piwc(k) = plwc(k)
8522 plwc(k) = 0.
8523 ! assign rain as snow and add into ice
8524 piwc(k) = piwc(k) + prwc(k)
8525 prwc(k) = 0.
8526 ENDIF
8527 ENDIF
8528 ENDIF
8530 ! --- radius of liquid water droplet
8531 if (plwc(k).gt.0) then
8532 !c pre(k) = 20.
8533 !C--- test change to 10 um (04/23/02)
8534 pre(k) = 10.
8535 if (k.eq.kmax-1) pre(k) = 10.
8536 endif
8538 !C******************************************************************
8539 !C******************************************************************
8540 !C--- calculate ice crystal size
8541 !C******************************************************************
8542 !C******************************************************************
8544 !C******************************************************************
8545 !C--- NPDE=1, papa. in terms of IWC & T (Gu & Liou, 2006)
8546 !C***********************************************************************
8547 if (NPDE.eq.1.and.piwc(k) .gt. 1.e-7) then
8548 !C--- for temperature between 213K and 253K
8549 if (degrees(i,NK,j).lt.253. &
8550 .and.degrees(i,NK,j).gt.213.) then !mchen
8551 TEMP_IWC = exp(-7.6 &
8552 +4.*exp(-0.2443e-3*(253.-degrees(i,NK,j))**2.445)) !mchen
8554 TEMP_T = degrees(i,NK,j) - 273. !mchen
8555 TEMP_DE = 326.3+12.42*TEMP_T+0.197*TEMP_T*TEMP_T &
8556 !c TEMP_DE = 326.3+12.42*TEMP_T-0.197*TEMP_T*TEMP_T
8557 +0.0012*TEMP_T**3
8558 pde(k) = (piwc(k)/TEMP_IWC)**(1./3.)*TEMP_DE
8560 if (pde(k).gt.150.) pde(k)=150.
8561 if (pde(k).lt.10.) pde(k)=10.
8564 else
8565 !C--- for temperature outside 213K and 253K
8566 pde(k) = 85.
8567 endif
8568 !c--- end if temperature for NPDE=1
8569 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8571 !C***********************************************************************
8572 !C---- NPDE=2, new de para. in terms of iwc (Liou et al. 2008)
8573 !C***********************************************************************
8574 else if (NPDE.eq.2.and.piwc(k) .gt. 1.e-7) then
8575 !C--- for tropics
8576 ! if (j.ge.17.and.j.le.28) ncoef = 1
8577 if (abs(xlat(i,j)).lt.30.) ncoef = 1
8578 !C--- for midlatitude
8579 ! if (j.lt.17.and.j.gt.7.or.j.gt.28.and.j.le.38) then
8580 if (abs(xlat(i,j)).ge.30.and.abs(xlat(i,j)).le.60.) then
8581 !C--- for cold cirrus
8582 if (degrees(i,NK,j).lt.233) then !mchen
8583 ncoef = 2
8584 else ! for warm cirrus
8585 ncoef = 3
8586 endif
8587 endif
8589 !C--- for polar region
8590 if (abs(xlat(i,j)).gt.60.) ncoef = 4
8591 !C--- calculate ln(De)
8592 temp_i = log(piwc(k))
8593 pde_mean = amean(ncoef)+bmean(ncoef)*temp_i &
8594 +cmean(ncoef)*temp_i**2.
8595 pde_max = amax(ncoef)+bmax(ncoef)*temp_i &
8596 +cmax(ncoef)*temp_i**2.
8597 pde_min = amin(ncoef)+bmin(ncoef)*temp_i &
8598 +cmin(ncoef)*temp_i**2.
8600 !C--- calculate de
8602 pde_mean = exp(pde_mean)
8603 pde_max = exp(pde_max)
8604 pde_min = exp(pde_min)
8606 !C--- if IWC smaller than critical, use a constant value
8607 if (piwc(k).le.iwc_mean(ncoef)) pde_mean = pdeiwc_mean(ncoef)
8608 if (piwc(k).le.iwc_max(ncoef)) pde_max = pdeiwc_max(ncoef)
8609 if (piwc(k).le.iwc_min(ncoef)) pde_min = pdeiwc_min(ncoef)
8610 if (pde_max.eq.1) pde_max = pdeiwc_max(ncoef)
8611 if (pde_min.eq.1) pde_min = pdeiwc_min(ncoef)
8613 ! -- generate a random number between pde_min and pde_max
8614 call random_number(x)
8615 ran1 = x
8616 diff_max = pde_max - pde_mean
8617 diff_min = pde_mean - pde_min
8618 diff = diff_max
8620 !C-- using smaller difference
8621 !c if (diff_min.lt.diff_max) diff = diff_min
8622 !C-- using larger difference
8623 if (diff_min.gt.diff_max) diff = diff_min
8625 pde_min_temp = pde_mean - diff
8626 pde_max_temp = pde_mean + diff
8628 pde_ran = (pde_max_temp-pde_min_temp)*ran1 + pde_min_temp
8630 !C---- constraint for larger difference if needed
8631 !c if (pde_ran .gt. pde_max) pde_ran = pde_max
8632 !c if (pde_ran .lt. pde_min) pde_ran = pde_min
8633 !c print *, 'pde_mean, max, min,ran=', pde_mean,pde_max,pde_min
8634 !c & , pde_ran
8635 !C--- calculate De
8636 if (pderandom) then
8637 pde(k) = pde_ran
8638 else
8639 pde(k) = pde_mean
8640 endif
8642 !C--- end for different region
8644 !C--- if para. out of De range
8645 if (pde(k).gt.150.) pde(k)=150.
8646 if (pde(k).lt.10.) pde(k)=10.
8647 !c--- end of npde=2
8648 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8650 !C******************************************************************
8651 !C--- NPDE = 3
8652 !C******************************************************************
8653 else if (NPDE.eq.3.and.piwc(k).gt.0.) then
8655 !C---- for clean
8656 if (clean) then
8657 ncoef = 1
8658 else
8659 ncoef = 2
8660 endif
8662 !C--- calculate ln(De)
8663 temp_i = log(piwc(k))
8664 pde_mean = a_sat(ncoef)+b_sat(ncoef)*temp_i
8666 !C--- calculate de
8667 pde_mean = exp(pde_mean)
8668 pde(k) = pde_mean
8670 !C--- if para. out of De range
8671 if (pde(k).gt.150.) pde(k)=150.
8672 if (pde(k).lt.10.) pde(k)=10.
8673 !c--- end of npde=3
8674 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8676 !C******************************************************************
8677 !C--- NPDE =4
8678 !C--- De-IWC-AOT relations from satellite data
8679 !C******************************************************************
8680 else if (NPDE.eq.4.and.piwc(k).gt.0.) then
8682 !C--- Coefficients for De parameterizations
8683 !c--- for South America: -40<lat<15(j), 270<lon<355(i)
8684 if (j.ge.13.and.j.le.27.and.i.ge.19.and.i.le.32) then
8685 NSAT = 2
8687 palpha = palpha_all(nsat)
8688 pbeta =pbeta_all(nsat)
8689 pgama = pgamma_all(nsat)
8690 peta = peta_all(nsat)
8691 pde0 = pde0_all(nsat)
8692 piwc0 = piwc0_all(nsat)
8693 pco0 = pco0_all(nsat)
8695 !C--- AOT for polluted (0.5) or clean (0.2)
8696 !c paot = tau_aer_2D(i,j)
8697 paot = 0.5
8698 !C****piwc use mg/m**3
8699 a1denom = (piwc(k)*1000./piwc0)**(-palpha) + 1.
8700 a2num = (peta*paot-1.1108)**pgama
8701 a2denom = (peta*paot-1.1108)**pbeta + 1.
8702 !C--- effective radius
8703 pde(k) = (pde0/a1denom)*(a2num/a2denom)
8704 !C--- convert to mean effective size for hexagonal (Fu 1996)
8705 !c pde(k) = pde(k) * 8./(3*sqrt(3))
8706 !C--- convert to mean effective size for mixture
8707 !C----(Francis et al 1994; Chou et al 2002)
8708 pde(k) = 2. * pde(k)
8709 !c print *, pde(k)
8710 !C--- if para. out of De range
8711 if (pde(k).gt.150.) pde(k)=150.
8712 !c if (pde(k).lt.10.) pde(k)=10.
8713 if (pde(k).le.15.) pde(k)=15.
8715 !C--- for outside South America, use prescribed De
8716 else
8717 pde(k) = 85.
8718 end if
8720 !c--- end of npde=4
8721 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8723 !c--- NPDE=0, prescribed pde
8724 !C******************************************************************
8725 else
8726 if (piwc(k).gt.0.) then
8727 !CCCCCCCCCCCC-------- CTRL value --------CCCCCCCCCCCCCC
8728 pde(k) = 85.
8729 endif
8731 endif
8732 !C------------ Over for pde calculation
8733 !C***************************************************************************
8735 !!!!!!!!!!!!!!!--- Cloud Fraction-----------
8736 !C--- add for fractional cloud
8737 if (nfract.eq.1) then
8738 if (plwc(k).gt.0. .or. piwc(k).gt.0.) then
8739 cldamnt(k) = cloudstrf(i,NK,j)
8740 endif
8741 endif
8743 !--- if nfract=0, no cloud fraction
8744 if (nfract.eq.0) then
8745 if (plwc(k).gt.0. .or. piwc(k).gt.0.) then
8746 cldamnt(k) = 1.
8747 endif
8748 endif
8750 end do VERTICAL_PROFILE2
8752 !100 continue
8754 !C--- add by Yu for aerosol
8756 if (NAERO.ge.1) then
8758 if (nfraca.eq.0) then ! -- aerosol type information from driver
8759 do iac = 1, mxac
8760 if (fraca(iac).gt.0.0) itps(iac) =1
8761 end do
8762 else if (nfraca.eq.1) then ! -- precribed aerosol type information
8763 fraca(2) = 0.9 !fraction of continental aerosols
8764 fraca(11) = 0.1 !fraction of soot aerosols
8765 do iac = 1, mxac
8766 if (fraca(iac).gt.0.0) itps(iac) = 1
8767 end do
8768 else if (nfraca.eq.2) then ! -- type in aerosol types and fractions
8770 else if (nfraca.eq.3) then ! -- type in aerosol optical depth for each type
8772 end if
8775 ! if (present(tau_aer_3D)) then
8776 ! tau_aer = sum(tau_aer_3D(i,j,1:kmax-1))
8777 ! else if (present(tau_aer_2D)) then
8778 ! tau_aer = tau_aer_2D(i,j)
8779 ! else
8780 ! tau_aer = 0.2
8781 ! end if
8783 do iac = 1, mxac
8784 if (itps(iac).eq.1) then
8785 Select case (ivd)
8786 case default
8787 CALL wrf_error_fatal('ivd: No VERTICAL Aerosol Profile') !mchen
8789 case(0)
8791 case(1)
8792 sh_aer(iac) = 3.
8793 call aer_scale_hgt(kmax-1,pij,sh_aer(iac),aprofs(1:kmax-1,iac))
8795 ! case(2)
8796 ! aprofs(1:kmax-1,iac) = tau_aer_3D(i,j,1:kmax-1) / tau_aer
8798 ! case(3) !ivd=3, inpput vertical AOD profile for each aerosol type
8801 end Select
8802 a_wlis(1,iac)= 0.53 !Wavelength (microns) corresponding to "a_tau"
8803 a_taus(1,iac)= tau_aer * fraca(iac)
8804 end if
8805 end do
8806 end if
8808 !C--- aerosol type
8809 ! itp=0
8810 ! if( aerosol_type(1:3) == 'mar' ) itp=1
8811 ! if( aerosol_type(1:3) == 'con' ) itp=2
8812 ! if( aerosol_type(1:3) == 'urb' ) itp=3
8813 ! if( aerosol_type(1:3) == '0.5' ) itp=4
8814 ! if( aerosol_type(1:3) == '1.0' ) itp=5
8815 ! if( aerosol_type(1:3) == '2.0' ) itp=6
8816 ! if( aerosol_type(1:3) == '4.0' ) itp=7
8817 ! if( aerosol_type(1:3) == '8.0' ) itp=8
8818 ! if( aerosol_type(1:3) == 'INS' ) itp=9
8819 ! if( aerosol_type(1:3) == 'WAS' ) itp=10
8820 ! if( aerosol_type(1:3) == 'SOO' ) itp=11
8821 ! if( aerosol_type(1:3) == 'SSA' ) itp=12
8822 ! if( aerosol_type(1:3) == 'SSC' ) itp=13
8823 ! if( aerosol_type(1:3) == 'MIN' ) itp=14
8824 ! if( aerosol_type(1:3) == 'MIA' ) itp=15
8825 ! if( aerosol_type(1:3) == 'MIC' ) itp=16
8826 ! if( aerosol_type(1:3) == 'MIT' ) itp=17
8827 ! if( aerosol_type(1:3) == 'SUS' ) itp=18
8829 !C--- aerosol humidity dependence
8830 ! ifg = 0
8832 !C--- aerosol composition
8833 !C--- fraction for the second type
8834 ! iafrac = 2
8835 !C--- only one type
8836 !c iafrac = 0
8838 ! if( iafrac == 0) fraca=0
8839 ! if( iafrac == 1) fraca=0.01
8840 ! if( iafrac == 2) fraca=0.10
8841 ! if( iafrac == 3) fraca=0.50
8842 ! if( iafrac == 4) fraca=1.0
8844 !c do iclrcld=1,1 !!!! 0,1
8845 !C-- cloudy(1) or clear (1)
8846 ! iclrcld = 1
8848 ! a_wlis =-9999.
8849 ! a_taus =-9999.
8850 ! itps = -9999
8852 !C--- aerosol constiuents
8853 !C-- two constituents
8854 ! nac=2
8855 !C-- one constituent
8856 ! nac=1
8858 ! itps(1)=itp ! PRIMARY
8859 ! itps(2)=11 ! soot
8861 ! sh_aer(1)=3.
8862 ! sh_aer(2)=3.
8864 ! do iac=1,nac
8865 ! ivd=0 !! AEROSOL VERTICAL PROFILE
8866 ! ivd=1 !! USER PROVIDED AEROSOL VERTICAL PROFILE
8868 !c print *, "b4 scale"
8870 ! if( ivd == 1) then
8871 ! call aer_scale_hgt(nv,pij,sh_aer(iac),aprofs(1:nv,iac))
8872 ! endif
8874 ! iaform = 3
8875 ! if (iaform == 1) then
8876 ! n_atau = 1
8877 ! a_wlis(1,iac)= 0.53
8879 ! a_taus(1,1)= tau_aer* (1.0-fraca)
8880 ! a_taus(1,2)= tau_aer* fraca
8881 ! a_taus(1,3)= tau_aer*0.20
8882 !MFRSR
8883 ! n_atau = 5
8884 ! a_wlis(1:n_atau,iac) =(/0.413,0.500,0.609,0.664,0.860/)
8885 ! a_taus(1:n_atau,iac) =(/0.179,0.137,0.099,0.094,0.06/)
8886 ! a_taus(1:n_atau,iac) = a_taus(1:n_atau,iac)* (tau_aer/ a_taus(2,iac))
8887 !CIMEL
8888 ! else if ( iaform == 3 ) then
8889 ! n_atau = 7
8890 ! a_wlis(1:n_atau,iac) = (/ .340, .380, .440, .500, .670, .870, 1.020/)
8891 ! a_taus(1:n_atau,iac) = (/0.275,0.232 , 0.180, 0.147, 0.087, 0.067, 0.063/)
8893 ! a_taus(1:n_atau,iac)=a_taus(1:n_atau,iac)*(tau_aer/ a_taus(4,iac))/float(nac)
8894 ! endif
8896 !c print*,' Aerosol Constituent' ,iac ,itps(iac)
8897 !c write(6,'(a15,10f8.4)') 'Wavelength :',a_wlis(1:n_atau,iac)
8898 !c write(6,'(a15,10f8.4)') 'AEROSOL TAU :',a_taus(1:n_atau,iac)
8900 ! enddo
8902 ! endif
8903 !C--- add for aerosol over
8905 !--- calculate nclouds
8906 nsubcld = (kmax-2)/ngroup
8907 nclouds = nsubcld * ngroup
8908 !*****************************************************************
8909 !* Call Fu-Liou radiation program
8910 !*****************************************************************
8911 !C call rad(as, u0ij, solcon, tsij, ee)
8912 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8913 !C---- unified program to include all choices
8914 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8915 call rad_all ( kmax-1, kmax, &
8916 & as, u0ij, solcon, tsij, ee &
8917 !C--- atmospheric profile
8918 & , pij, tij, qij, o3ij &
8919 !C--- cloud water content and sizes
8920 & , piwc, pde, plwc, pre, prwc, pgwc &
8921 !C--- cloud amount
8922 & , cldamnt &
8923 !c--- cloud inhomogeneity factor
8924 & , cc_inho &
8925 !c--- for aerosol
8926 & , a_wlis, a_taus, aprofs &
8927 !C--- output: fluxes and heating rates
8928 & , fds, fus, dts, fdir, fuir, dtir &
8929 & , fd, fu, dt_rad &
8930 !C--- amontornes-bcodina (2014-04-29): new to save the direct and diffuse fluxes
8931 & , fdsdir, fdsdif &
8932 & )
8933 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8936 !**********************************************************************
8937 !* Store the output from Fu-Liou code into standard arrays
8938 !**********************************************************************
8939 !*** surface
8940 !*** net solar at sfc
8941 netswbot(i,j) = fds(kmax) - fus(kmax)
8942 !*** downward solar at sfc
8943 dswbot(i,j) = fds(kmax)
8944 !*** DNI, DIR and DIF values (amontornes-bcodina 2014-04-29)
8945 if(u0ij .gt. 0.0001) then
8946 swddni(i,j) = fdsdir(kmax)/u0ij
8947 swddir(i,j) = fdsdir(kmax)
8948 swddif(i,j) = fdsdif(kmax)
8949 else
8950 swddni(i,j) = 0.
8951 swddir(i,j) = 0.
8952 swddif(i,j) = 0.
8953 endif
8954 !*** downward IR at sfc
8955 dlwbot(i,j) = fdir(kmax)
8956 !*** upward IR at sfc
8957 ulwbot(i,j) = fuir(kmax)
8958 !*** net IR at sfc
8959 netlwbot(i,j) = fuir(kmax) - fdir(kmax)
8960 !*** TOA
8961 !*** downward solar at top
8962 swinc(i,j) = fds(1)
8963 !*** upward solar at toa
8964 uswtop = fus(1)
8965 !*** net solar at toa
8966 dswtop(i,j) = fds(1) - fus(1)
8967 !*** upward IR at TOA
8968 ulwtop(i,j) = fuir(1)
8971 !*** value test
8972 if (abs(ulwtop(i,j)).gt.1000.) then
8973 ! write (0,*) 'i=',i,' j=',j,' ulwtop=',ulwtop(i,j)
8974 ! write(0,*) 'fd=', fds
8975 ! write(0,*) 'fus=', fus
8976 ! write(0,*) 'fdir=', fdir
8977 ! write(0,*) 'fuir=', fuir
8978 ! write (0,*) '---------------------------'
8979 ! write (0,*) as, u0ij, solcon, tsij,ee
8980 ! write (0,*) '---------------------------'
8981 ! do ii=1,kmax
8982 ! write (0,*) pij(ii), tij(ii), qij(ii), o3ij(ii)
8983 ! enddo
8984 ! write (0,*) '---------------------------'
8985 ! do ii=1,kmax-1
8986 ! write (0,*) piwc(ii), pde(ii), plwc(ii), pre(ii),prwc(ii), pgwc(ii) &
8987 ! , cldamnt(ii)
8988 ! enddo
8989 CALL wrf_error_fatal('Flux out of range. Stop program') !mchen
8990 endif
8991 !C---test oevr
8995 !**********************************************************************************
8996 !* Update the total column physics increment to theta
8997 !**********************************************************************************
8998 do k = 1,kte
8999 NK=kte-k+kms
9000 !--- heating rate in k s-1
9001 dtshort(i,k,j) = dts(NK) * FAC/pi3d(i,k,j)
9002 dtlongwv(i,k,j) = dtir(NK) * FAC/pi3d(i,k,j)
9003 ! deltat(i,k,j) = dt_rad(NK) * FAC
9004 deltat(i,k,j) = deltat(i,k,j) + dt_rad(Nk) * FAC/pi3d(i,k,j)
9005 !--- heating rate in pa k s-1
9006 ! dtshort(i,k,j) = dtshort(i,k,j)*(pij(NK)-pij(NK-1))*100.
9007 ! dtlongwv(i,k,j) = dtlongwv(i,k,j)*(pij(NK)-pij(NK-1))*100.
9008 ! deltat(i,k,j) = deltat(i,k,j)*(pij(NK)-pij(NK-1))*100.
9009 ! dtshort(i,k,j) = dts(NK) * FAC/pi3d(i,K,j)
9010 ! dtlongwv(i,k,j) = dtir(NK) * FAC/pi3d(i,k,j)
9012 !*** Value test
9013 if (abs(dtir(Nk)).gt.100.) then
9014 CALL wrf_error_fatal('Heating rate out of range. Stop program') !mchen
9015 endif
9016 !C---test oevr
9018 enddo
9020 200 continue
9023 300 end do HORIZONTAL_I
9024 end do HORIZONTAL_J
9026 !*************************************************************************
9027 !* End of routine driver_rad.F
9028 !*************************************************************************
9029 return
9030 end subroutine RAD_FLG
9032 !c
9033 !c Liner interpolation between two points.
9034 !c
9036 subroutine intrpl(x1,y1,x2,y2,x,y)
9037 implicit none
9038 real x1, x2, y1, y2, x, y, slope
9040 if (x2.eq.x1) then
9041 y = y1
9042 else
9043 !C--- use p
9044 slope=(y2-y1)/(x2-x1)
9045 y=y1+slope*(x-x1)
9046 !C--- use log(p)
9047 !c if (x2.eq.x1) then
9048 !c y = y1
9049 !c else
9050 !c slope=(y2-y1)/(alog(x2/x1))
9051 !c y=y1+slope*(alog(x/x1))
9052 endif
9054 return
9055 end subroutine intrpl
9057 subroutine aer_scale_hgt(nv,pp,h,aprof)
9058 implicit none
9059 integer nv
9060 real pp(nv+1)
9061 real aprof(nv)
9062 real pbar, z, tot, h
9063 integer i
9065 do i=1,nv
9066 pbar= ( pp(i)+pp(i+1) ) *0.5
9067 z= 8.0* log( pp(nv+1) /pbar )
9068 aprof(i)= exp(-z/h)
9069 ! print'(4f10.1,f10.2)',pp(i),pp(i+1),pbar,z,aprof(i)
9070 enddo
9071 tot= sum(aprof(1:nv))
9072 ! print*,tot
9073 aprof = 100*(aprof/tot) !! aprof in %
9074 return
9075 end subroutine aer_scale_hgt
9081 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9082 !C---- radiation program for UCLA AGCM
9083 !C-----with all modifications
9084 !C---- with fractional cloud cover and aerosol
9085 !C---- with new ice parameterization and gases
9086 !C---- Control by parameters
9087 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9088 subroutine rad_all ( nv, nv1 &
9089 & , asij, u0, ss, pts, eeij &
9090 !C--- atmospheric profile
9091 & , pij, tij, qij, o3ij &
9092 !C--- cloud water content and sizes
9093 & , piwcij, pdeij, plwcij, preij &
9094 & , prwcij, pgwcij &
9095 !C--- cloud amount
9096 & , cldamntij &
9097 !c--- cloud inhomogeneity factor
9098 & , cc_inhoij &
9099 !c--- for aerosol
9100 & , a_wlisij, a_tausij, aprofsij &
9101 !C--- output: fluxes and heating rates
9102 & , fdsij, fusij, dtsij &
9103 & , fdirij, fuirij, dtirij &
9104 & , fdij, fuij, dtij &
9105 !C--- amontornes-bcodina (2014-04-29): new to save the direct and diffuse fluxes
9106 & , fdsdir, fdsdif &
9107 & )
9109 !c *********************************************************************
9110 !c In this radiation scheme, six and 12 bands are selected for solar
9111 !c and thermal IR regions, respectively. The spectral division is below:
9112 !c 0.2 - 0.7 um, 0.7 - 1.3 um, 1.3 - 1.9 um, 1.9 - 2.5 um, 2.5 -3.5 um, &
9113 !c 3.5 - 4.0 um, and 2200 - 1900 cm**-1, 1900 - 1700 cm**-1, 1700 -1400
9114 !c cm**-1, 1400 - 1250 cm**-1, 1250 - 1100 cm**-1, 1100 - 980 cm**-1, &
9115 !c 980 - 800 cm**-1, 800 - 670 cm**-1, 670 - 540 cm**-1, 540 - 400 cm
9116 !c **-1, 400 - 280 cm**-1, 280 - 0 cm**-1, where the index for the
9117 !c spectral band ( ib = 1, 2, ..., 18 ) is defined.
9118 !c
9119 !c **********************
9120 !c * INPUT PARAMETERS *
9121 !c **********************
9122 !c as(mbs) solar surface albedo, mbs = 6
9123 !c u0 cosine of solar zenith angle
9124 !c ss solar constant ( W / m ** 2 )
9125 !c pts surface temperature ( K )
9126 !c ee(mbir) IR surface emissivity, mbir = 12
9127 !c pp(nv1) atmospheric pressure ( mb )
9128 !c pt(nv1) atmospheric temperature ( K )
9129 !c ph(nv1) water vapor mixing ratio ( kg / kg )
9130 !c po(nv1) ozone mixing ratio ( kg / kg )
9131 !c pre(nv) effective radius of water cloud ( um )
9132 !c plwc(nv) liquid water content ( g / m ** 3 )
9133 !c pde(nv) effective size of ice cloud ( um )
9134 !c piwc(nv) ice water content ( g / m ** 3 )
9135 !c prwc(nv) rain water content ( g / m ** 3 )
9136 !c pgwc(nv) graupel water content ( g / m ** 3 )
9137 !c or aerosol concentration (m-3)
9138 !c umco2 concentration of CO2 (ppmv)
9139 !c umch4 concentration of CH4 (ppmv)
9140 !c umn2o concentration of N2O (ppmv)
9141 !c
9142 !c Note: (1) as(mbs) and ee(mbir) consider the substantial wavelength
9143 !c dependence of surface albedos and emissivities.
9144 !c (2) For CO2, CH4 and N2O, uniform mixing is assumed through
9145 !c the atmosphere with concentrations of 330, 1.6 and 0.28
9146 !c ppmv, respectively. The concentrations can be changed
9147 !c through 'common /umcon/ umco2, umch4, umn2o '.
9148 !c (3) nv, nv1, nv, nv1, nv * 4, mb, mbs, mbir, and nc are
9149 !c given through 'para.file'.
9150 !c (4) nv1 and 1 are the surface and top levels, respectively.
9151 !c
9152 !c **********************
9153 !c * OUTPUT PARAMETERS *
9154 !c **********************
9155 !c fds(nv1) downward solar flux ( W / m ** 2 )
9156 !c fus(nv1) upward solar flux ( W / m **2 )
9157 !c dts(nv) solar heating rate ( K / day )
9158 !c fdir(nv1) downward IR flux ( W / m ** 2 )
9159 !c fuir(nv1) upward IR flux ( W / m **2 )
9160 !c dtir(nv) IR heating rate ( K / day )
9161 !c fd(nv1) downward net flux ( W / m ** 2 )
9162 !c fu(nv1) upward net flux ( W / m **2 )
9163 !c dt(nv) net heating rate ( K / day )
9164 !c
9165 !c Note: Solar, IR, and net represent 0.2 - 0.4 um, 2200 - 0 cm**-1, &
9166 !c and entire spectral regions, respectively.
9167 !c
9168 !c *********************************************************************
9169 !# include "para.file"
9170 USE PARA_FILE
9171 USE control_para, fourssl=>d4s,twossl=>d2s,foursir=>d4ir,twosir=>d2ir
9172 implicit none
9173 integer :: nv, nv1
9174 !C--- input from GCM
9175 real pij(nv1), tij(nv1), qij(nv1), o3ij(nv1)
9176 real piwcij(nv), pdeij(nv)
9177 real cldamntij(nv)
9178 real cc_inhoij(nv)
9180 real plwcij(nv), preij(nv)
9181 real prwcij(nv), pgwcij(nv)
9182 real fdsij(nv1), fusij(nv1), dtsij(nv)
9183 real fdirij(nv1), fuirij(nv1), dtirij(nv)
9184 real fdij(nv1), fuij(nv1), dtij(nv)
9186 !C--- aerosol optical properties
9187 real, dimension(mxat,mxac) :: a_wlisij,a_tausij
9188 real, dimension(nvx,mxac) :: aprofsij
9189 ! integer, dimension(mxac) :: itpsij
9191 !C--- variables in the offline version
9192 real, dimension(nv1) :: pp, pt, ph, po
9193 real, dimension(nv1) :: fds, fus, fdir, fuir, fd, fu
9194 !C--- amontornes-bcodina (2014-04-29): new to save the direct and diffuse information
9195 real, dimension(nv1) :: fdsdir, fdsdif
9196 real, dimension(nv) :: dts, dtir, dt
9197 real, dimension(nv) :: piwc, plwc, pgwc, prwc, &
9198 & pde, pre, cldamnt
9199 real :: asij(mbs), eeij(mbir)
9200 real :: as(mbs), ss, ee(mbir)
9201 real :: pts, u0
9203 real, dimension(nv1) :: fu1, fd1
9204 !C--- amontornes-bcodina (2014-04-29): new to save the direct and diffuse information
9205 real, dimension(nv1) :: ffddir,ffdif
9206 real :: bf(nv1), bs
9207 real, dimension(nv) :: wc1, wc2, wc3, wc4, wc, tt
9208 ! -- add for partial clouds
9209 real :: area_group(3,2), cld_group(3)
9210 integer :: n_group(3), nb(3), n_loop(3)
9211 real, dimension(nv,2) :: wc1_2, wc2_2, wc3_2, wc4_2, wc_2, &
9212 & tt_2, tc_2
9213 integer :: nc1, nc2, nc3, k, kl, kk
9214 ! -- add for partial clouds
9215 real, dimension(nv1) :: fds_tot, fus_tot, fdir_tot, fuir_tot, &
9216 & fd_tot, fu_tot
9217 real :: ctau(nv)
9218 real :: hk, fuq1, fuq2, xx, dz(nv), trp(nv)
9219 integer :: ib, mbn, kg1_num, kg2_num, iac, ig1, ig2, i !cycle control
9220 real, dimension(nvx,mbx,mxac) :: &
9221 & a_tau1,a_ssa1,a_asy1, &
9222 & a_tau2,a_ssa2,a_asy2
9223 real, dimension(mxat,mxac) :: a_wlis,a_taus
9224 real, dimension(nvx,mxac) :: aprofs
9225 ! integer, dimension(mxac) :: itps
9226 real :: ti(nv), wi(nv), wwi(nv,4)
9227 real :: tw(nv), ww(nv), www(nv,4)
9228 real :: trn(nv), wrn(nv), wwrn(nv,4)
9229 real :: tgr(nv), wgr(nv), wwgr(nv,4)
9230 real :: tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
9231 real :: tgm(nv)
9232 real :: tr(nv), wr(nv), wwr (nv,4), tg(nv)
9233 real :: area
9234 real :: cc_inho(nv)
9237 !c kg(mb) is the number of intervals to perform the g-quadrature in
9238 !c each band to consider the nongray gaseous absorption. In total, &
9239 !c we need to perform 121 spectral calculations in the scattering
9240 !c problem for each atmospheric profile.
9241 integer, dimension(mb) :: kg, kg1, kg2
9242 data kg / 10, 8, 12, 7, 12, 5, &
9243 & 2, 3, 4, 4, 3, 5, 2, 10, 12, 7, 7, 8 /
9244 !!!!! -- change by Zhang Feng for trace gases
9245 data kg1 / 10, 12, 12, 20, 20, 20, &
9246 & 2, 3, 4, 4, 3, 5, 2, 10, 12, 7, 7, 8 /
9247 data kg2 /1, 12, 1, 20, 20, 1, &
9248 & 1, 1, 1, 1, 1, 1, 1, 1 , 1, 1, 1, 1 /
9249 !CCCCCCCCCC-- change over
9251 real :: f0 = 1.0 / 3.14159
9253 !C-- add for aerosol
9254 if (naero.ge.1) then
9255 a_wlis = a_wlisij
9256 a_taus = a_tausij
9257 aprofs = aprofsij
9258 ! itps = itpsij
9259 !
9260 end if
9261 !C-- over
9262 !C---
9263 do i = 1, nv1
9264 !C---- assign input to fu-liou variables
9265 pp(i) = pij(i)
9266 pt(i) = tij(i)
9267 ph(i) = qij(i)
9268 po(i) = o3ij(i)
9269 !C-----
9270 fds(i) = 0.0
9271 fus(i) = 0.0
9272 fdir(i) = 0.0
9273 fuir(i) = 0.0
9274 !C--- amontornes-bcodina (2014-04-29): Added for direct and diffuse computations
9275 fdsdir(i) = 0.0
9276 fdsdif(i) = 0.0
9277 10 end do
9279 as = asij
9280 ee = eeij
9282 do i = 1, nv
9283 !C---- assign input to fu-liou variables
9284 piwc(i) = piwcij(i)
9285 pde(i) = pdeij(i)
9286 plwc(i) = plwcij(i)
9287 pre(i) = preij(i)
9288 prwc(i) = prwcij(i)
9289 pgwc(i) = pgwcij(i)
9290 cldamnt(i) = cldamntij(i)
9291 cc_inho(i) = cc_inhoij(i)
9292 end do
9293 !C---
9294 call thicks(nv,nv1,pp,pt,ph,po,dz)
9295 call rayle2(nv,nv1,pp,pt,ph,po,trp)
9297 !C--- add by Yu (01/2003) for aerosol
9298 if (naero.ge.1) then
9299 call aerosol_init(nv,nv1,pp,pt,ph,po,dz, &
9300 a_tau1,a_ssa1,a_asy1, &
9301 a_tau2,a_ssa2,a_asy2, &
9302 a_wlis,a_taus,aprofs &
9303 )
9304 end if
9305 !C-- over
9307 if ( u0 .le. 1.0e-4 ) then
9308 mbn = mbs + 1
9309 else
9310 mbn = 1
9311 endif
9312 do ib = mbn, mb
9313 if (nice.eq.1) then
9314 ! --------- using new coefficients
9315 call ice_new_ZF ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9316 else if (nice.eq.2) then
9317 ! --------- using new coefficients by Qing for combine
9318 call ice_new_comb ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9319 else if (nice.eq.3) then
9320 ! --------- using new coefficients by Qing for tropics
9321 call ice_new_trop ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9322 else if (nice.eq.4) then
9323 ! --------- using new coefficients by Qing for midlat
9324 call ice_new_midlat ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9325 else if (nice.eq.5) then
9326 ! --------- using FLIce98
9327 call ice_98 ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9328 else if (nice.eq.6) then
9329 ! --------- using single ice by Feng using new data Ping Yang 2000
9330 call ice_singleice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9331 else if (nice.eq.7) then
9332 ! --------- using single ice by Qing using new data Ping Yang 2005
9333 call ice_new_Single ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9334 else
9335 ! --------- use old ice coefficients FLIce93
9336 call ice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
9337 endif
9339 call water_fl ( nv,nv1,ib,pre,plwc,pde,piwc,dz,tw,ww,www )
9340 call rain ( nv,nv1,ib,prwc,dz,trn,wrn,wwrn )
9341 call graup ( nv,nv1,ib,pgwc,dz, tgr,wgr,wwgr )
9344 !C--- add for aerosol by Yu (01/2003)
9345 !c---------- 4/1/97 (3)
9346 ! No more ipr option
9347 !c if (ib.ne.1) then
9348 !C-- nor sub-intervals
9349 if (naero.ge.1) then
9350 call aerosolxy (nv,nv1,ib,'x',a_tau1,a_ssa1,a_asy1, &
9351 & a_tau2,a_ssa2,a_asy2,tae,wae,wwae &
9352 & )
9353 ctau(ib)=0.
9354 do i=1,nv
9355 do iac=1,mxac
9356 if (itps(iac).eq.1) ctau(ib)=ctau(ib)+tae(i,iac)
9357 end do
9358 end do
9359 endif
9360 !c print *, 'ctau=',ctau
9361 !c endif
9362 !c---------- 4/1/97 (3)
9363 !C-- over
9365 call rayle ( nv,nv1,ib,trp,tr,wr,wwr,u0 )
9366 call gascon ( nv,nv1,ib,tgm,pp,pt,ph,po )
9367 if ( ib .gt. mbs ) then
9368 call planck ( nv,nv1,ib,pts,pp,pt,ph,po,bf,bs )
9369 endif
9371 !C---- change by Yu for new trace gases
9372 if (ngas.eq.0) then
9373 kg1_num=kg(ib)
9374 kg2_num=1
9375 end if
9376 if (ngas.eq.1) then
9377 kg1_num=kg1(ib)
9378 kg2_num=kg2(ib)
9379 end if
9382 !c do 30 ig = 1, kg(ib)
9383 do ig1 = 1, kg1_num
9384 do ig2 = 1, kg2_num
9385 ! -- changed by Yu for new gases, 11/2006
9386 if (ngas.eq.0) then
9387 ! call gases ( ib, ig, hk )
9388 call gases ( nv,nv1,ib, ig1, hk,pp,pt,ph,po,tg )
9389 end if
9390 if (ngas.eq.1) then
9391 call gases_new ( nv,nv1,ib, ig1,ig2, hk,pp,pt,ph,po,tg )
9392 end if
9393 !C--- change over
9396 !C--- with aerosol, partly cloudy, depending on parameter
9397 call comscp_aero_cld ( nv,nv1 &
9398 & ,cldamnt,area_group,cld_group &
9399 & ,n_group,nb &
9400 & ,ti,wi,wwi,tw,ww,www &
9401 & ,trn,wrn,wwrn,tgr,wgr,wwgr &
9402 & ,tr,wr,wwr,tgm,tg,tae,wae,wwae &
9403 & ,wc1,wc2,wc3,wc4,wc,tt,tc_2 &
9404 & ,wc1_2,wc2_2,wc3_2,wc4_2,wc_2,tt_2 &
9405 & ,cc_inho &
9406 & )
9408 !C--- 02/13/02 Yu Gu
9409 !C--- change by Yu for fractional cloud - calculate radiation for each section
9411 do nc1 = nb(1), n_group(1)
9412 do nc2 = nb(2), n_group(2)
9413 do nc3 = nb(3), n_group(3)
9414 n_loop(1) = nc1
9415 n_loop(2) = nc2
9416 n_loop(3) = nc3
9417 !c--- fractional area for each section
9418 area = area_group(1,nc1)*area_group(2,nc2) &
9419 & *area_group(3,nc3)
9420 !c print *, 'area=', area
9422 !c--- calculated total tao for layer above cloud layers
9423 tt_2(1,1) = tc_2(1,1)
9424 tt_2(1,2) = tc_2(1,2)
9425 ! do i = 2, nv-nclouds
9426 do i = 2, nv-nsubcld*ngroup
9427 tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
9428 tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
9429 220 end do
9431 !C--- assign the optical properties for each section
9432 !c--- for layers above clouds
9433 ! do k = 1,nv-nclouds
9434 do k = 1,nv-nsubcld*ngroup
9435 wc1(k) = wc1_2(k,1)
9436 wc2(k) = wc2_2(k,1)
9437 wc3(k) = wc3_2(k,1)
9438 wc4(k) = wc4_2(k,1)
9439 wc(k) = wc_2(k,1)
9440 tt(k) = tt_2(k,1)
9441 enddo
9443 ! -- for cloudy layers
9444 do k=1,ngroup
9445 ! kl = (k-1)*nsubcld + nv1-nclouds
9446 kl = (k-1)*nsubcld + nv1-nsubcld*ngroup
9447 do kk = kl, kl+nsubcld-1
9448 wc1(kk) = wc1_2(kk, n_loop(k))
9449 wc2(kk) = wc2_2(kk, n_loop(k))
9450 wc3(kk) = wc3_2(kk, n_loop(k))
9451 wc4(kk) = wc4_2(kk, n_loop(k))
9452 wc(kk) = wc_2(kk, n_loop(k))
9453 tt(kk) = tt(kk-1) + tc_2(kk,n_loop(k))
9454 !c tt_2(kk,n_loop(k)) = tt_2(kk-1,n_loop(k)) + tc_2(kk,n_loop(k))
9455 !c tt(kk) = tt_2(kk, n_loop(k))
9456 enddo
9457 enddo
9459 !c 11/4/95 (begin)
9460 if ( ib .le. mbs ) then
9461 if ( fourssl ) then
9462 !c amontornes-bcodina (2014-04-29): this line was modified to introduce the direct and diffuse fluxes
9463 call qfts ( nv,nv1,ib, as(ib), u0, f0, &
9464 & wc1,wc2,wc3,wc4,wc,tt,fu1,fd1,ffddir,ffdif )
9465 endif
9466 if ( twossl ) then
9467 quadra = .false.
9468 hemisp = .false.
9469 edding = .true.
9470 call qftsts ( nv,nv1,ib, as(ib), u0, f0, &
9471 & wc1,wc2,wc3,wc4,wc,tt,fu1,fd1 )
9472 endif
9473 do i = 1, nv1
9474 ! fds(i) = fds(i) + fd1(i) * hk
9475 ! fus(i) = fus(i) + fu1(i) * hk
9476 fds(i) = fds(i) + fd1(i) * hk * area
9477 fus(i) = fus(i) + fu1(i) * hk * area
9478 !c amontornes-bcodina (2014-04-29): this line was added for the direct and diffuse outputs
9479 fdsdir(i) = fdsdir(i) + ffddir(i) * hk * area
9480 fdsdif(i) = fdsdif(i) + ffdif(i) * hk * area
9481 40 end do
9482 else
9483 if ( foursir ) then
9484 call qfti ( nv,nv1,ib, ee(ib-mbs), bf, bs, &
9485 & wc1,wc2,wc3,wc4,wc,tt,fu1,fd1 )
9486 endif
9487 if ( twosir ) then
9488 quadra = .false.
9489 edding = .false.
9490 hemisp = .true.
9491 ! -- 2-4-stream combination for IR
9492 call qftisf ( nv,nv1,ib, ee(ib-mbs), bf, bs, &
9493 & wc1, wc2, wc3, wc4, wc, tt, &
9494 & fu1, fd1 )
9495 ! -- 2-stream for IR
9496 ! call qftits ( ib, ee(ib-mbs) )
9497 endif
9498 !c 11/4/95 (end)
9499 do i = 1, nv1
9500 ! fdir(i) = fdir(i) + fd1(i) * hk
9501 ! fuir(i) = fuir(i) + fu1(i) * hk
9502 fdir(i) = fdir(i) + fd1(i) * hk * area
9503 fuir(i) = fuir(i) + fu1(i) * hk * area
9504 50 end do
9505 endif
9506 end do
9507 end do
9508 end do
9509 31 end do
9510 30 end do
9511 20 end do
9512 fuq1 = ss / 1340.0
9513 !c In this model, we used the solar spectral irradiance determined by
9514 !c Thekaekara (1973), and 1340.0 W/m**2 is the solar energy contained
9515 !c in the spectral region 0.2 - 4.0 um.
9516 fuq2 = bs * 0.03 * 3.14159 * ee(12)
9517 !c fuq2 is the surface emitted flux in the band 0 - 280 cm**-1 with a
9518 !c hk of 0.03.
9519 do i = 1, nv1
9520 fds(i) = fds(i) * fuq1
9521 fus(i) = fus(i) * fuq1
9522 !c amontornes-bcodina (2014-04-29): direct and diffuse fluxes
9523 fdsdir(i) = fdsdir(i) * fuq1
9524 fdsdif(i) = fdsdif(i) * fuq1
9525 fuir(i) = fuir(i) + fuq2
9526 fd(i) = fds(i) + fdir(i)
9527 fu(i) = fus(i) + fuir(i)
9529 !C--- assign result to output variables
9530 fdsij(i) = fds(i)
9531 fusij(i) = fus(i)
9532 fdirij(i) = fdir(i)
9533 fuirij(i) = fuir(i)
9534 fdij(i) = fd(i)
9535 fuij(i) = fu(i)
9536 !C---
9537 60 end do
9539 do i = 1, nv
9540 xx = fds(i) -fus(i) - fds(i+1) + fus(i+1)
9541 !c dts(i) = 8.4392 * xx / ( pp(i+1) - pp(i) )
9542 dts(i) = xx / ( pp(i+1) - pp(i) )
9543 xx = fdir(i) -fuir(i) - fdir(i+1) + fuir(i+1)
9544 !c dtir(i) = 8.4392 * xx / ( pp(i+1) - pp(i) )
9545 dtir(i) = xx / ( pp(i+1) - pp(i) )
9546 dt(i) = dts(i) + dtir(i)
9547 !C--- assign result to output variables
9548 dtsij(i) = dts(i)
9549 dtirij(i) = dtir(i)
9550 dtij(i) = dt(i)
9551 !C---
9552 70 end do
9553 return
9554 end subroutine rad_all
9557 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9561 subroutine thicks(nv,nv1,pp,pt,ph,po,dz)
9562 ! *********************************************************************
9563 ! dz is the thickness of a layer in units of km.
9564 ! *********************************************************************
9565 implicit none
9566 integer :: nv, nv1
9567 real, dimension(nv1) :: pp, pt, ph, po
9568 real, dimension(nv) :: dz(nv)
9569 integer i
9570 do i = 1, nv
9571 dz(i) = 0.0146337 * ( pt(i) + pt(i+1) ) &
9572 & * alog( pp(i+1) / pp(i) )
9573 end do
9574 return
9575 end subroutine thicks
9577 subroutine gases_new ( nv,nv1,ib, ig1, ig2, hk,pp,pt,ph,po,tg )
9578 !c *********************************************************************
9579 !c tg(nv) are the optical depthes due to nongray gaseous absorption, in
9580 !c nv layers for a given band ib and cumulative probability ig.
9581 !c *********************************************************************
9582 !# include "para.file"
9583 USE PARA_FILE
9584 USE band_new, only: hk1=>hk_1_new,fk1o3=>fko3_1_new, &
9585 & hk2=>hk_2_new,c2hh2=>coehh22_2_new, &
9586 & c2o2=>coeo2_2_new,c2h2o=>coeh2o_2_new, &
9587 & hk3=>hk_3_new,c3hh2=>coehh32_3_new, &
9588 & c3h2o=>coeh2o_3_new, &
9589 & hk4=>hk_4_new,c4hh2=>coehh42_4_new, &
9590 & c4co2=>coeco2_4_new,c4co=>coeco_4_new, &
9591 & c4h2o=>coeh2o_4_new, &
9592 & hk5=>hk_5_new,c5hh2=>coehh52_5_new, &
9593 & c5co2=>coeco2_5_new,c5n2o=>coen2o_5_new, &
9594 & c5ch4=>coech4_5_new,c5h2o=>coeh2o_5_new, &
9595 & hk6=>hk_6_new,c6hh2=>coehh62_6_new, &
9596 & c6so2=>coeso2_6_new,c6h2o=>coeh2o_6_new, &
9597 & hk7=>hk_7_new,c7h2o=>coeh2o_7_new, &
9598 & hk8=>hk_8_new,c8h2o=>coeh2o_8_new, &
9599 & c8no=>coeno_8_new, &
9600 & hk9=>hk_9_new,c9h2o=>coeh2o_9_new, &
9601 & c9no2=>coeno2_9_new, &
9602 & hk10=>hk_10_new,c10h2o=>coeh2o_10_new, &
9603 & c10ch4=>coech4_10_new,c10n2o=>coen2o_10_new, &
9604 & c10so2=>coeso2_10_new, &
9605 & hk11=>hk_11_new,c11h2o=>coeh2o_11_new, &
9606 & c11ch4=>coech4_11_new,c11n2o=>coen2o_11_new, &
9607 & c11CFC11=>c11CFC11_11_new, &
9608 & c11CFC12=>c11CFC12_11_new, &
9609 & hk12=>hk_12_new,c12o3=>coeo3_12_new, &
9610 & c12h2o=>coeh2o_12_new, &
9611 & c12CFC11=>c12CFC11_12_new, &
9612 & c12CFC12=>c12CFC12_12_new, &
9613 & hk13=>hk_13_new,c13h2o=>coeh2o_13_new, &
9614 & c13CFC11=>c13CFC11_13_new, &
9615 & c13CFC12=>c13CFC12_13_new, &
9616 & hk14=>hk_14_new,c14hca=>coehca_14_new, &
9617 & c14hcb=>coehcb_14_new, &
9618 & c14ch3cl=>coech3cl_14_new, &
9619 & hk15=>hk_15_new,c15hca=>coehca_15_new, &
9620 & c15hcb=>coehcb_15_new, &
9621 & hk16=>hk_16_new,c16h2o=>coeh2o_16_new, &
9622 & hk17=>hk_17_new,c17h2o=>coeh2o_17_new, &
9623 & hk18=>hk_18_new,c18h2o=>coeh2o_18_new
9624 USE control_para, only: umco2,umch4,umn2o,umo2, &
9625 & umno,umso2,umno2,umch3cl, &
9626 & umco,umCFC11,umCFC12, &
9627 & no2s,nco2s,nso2s,nch4s,nnol, &
9628 & nno2l,nso2l,nch3cll,ncos, &
9629 & nn2os,nh2ocs,nh2os,no3s, &
9630 & nh2ol,no3l,nco2l,nn2ol, &
9631 & nch4l,nCFC11l,nCFC12l
9633 implicit none
9635 integer :: nv, nv1
9636 real, dimension(nv1) :: pp, pt, ph, po
9637 real :: tg(nv)
9638 integer :: ib, ig, ig1, ig2
9639 real :: hk
9641 real, dimension(nv1) :: fkg, fkga, fkgb, fkgc, fkgd, fkge, &
9642 & pq, fkg1
9643 real, dimension(nv) :: tg1, tg2, tg3, tg4, tg5
9644 real :: fk
9645 integer :: i
9647 select case(ib)
9648 case default
9649 stop
9650 case(1)
9651 1 ig=ig1
9652 if(no3s.eq.1) then
9653 fk = fk1o3(ig)
9654 call qopo3s ( nv,nv1,fk,tg,pp,pt,ph,po )
9655 ! write(*,*)'tg=',tg
9656 else
9657 do i=1,nv
9658 tg(i)=0.0
9659 end do
9660 end if
9661 hk = 619.618 * hk1(ig)
9662 ! In this band ( 50000 - 14500 cm**-1 ), we have considered the nongray
9663 ! gaseous absorption of O3. 619.618 is the solar energy contained in
9664 ! the band in units of Wm**-2.
9665 case(2)
9666 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
9667 ! 2nd --- 6 nd bands have been changed by Z.F.in Jun.,2003
9668 !
9669 2 do i=1,nv1
9670 fkg(i)=0.0
9671 end do
9672 call qks ( nv,nv1,c2hh2(1,1,ig1), fkgb,pp,pt,ph,po )
9673 do i = 1, nv1
9674 fkg(i) = fkgb(i)*ph(i)
9675 end do
9676 call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po )
9677 call qks(nv,nv1,c2o2(1,1,ig2),fkgb,pp,pt,ph,po )
9678 call qopo2 (nv,nv1,fkgb, tg2,pp,pt,ph,po )
9679 do i=1,nv
9680 tg(i)=tg1(i)+tg2(i)*umo2/2.0948E+05
9681 end do
9682 hk = 484.295 * hk2(ig1)*hk2(ig2)
9683 ! In this band ( 14500 - 7700 cm**-1 ), we have considered the nongray
9684 ! gaseous absorption of H2O. 484.295 is the solar energy contained in
9685 ! the band in units of Wm**-2.
9686 case(3)
9687 3 ig=ig1
9688 do i=1,nv1
9689 fkg(i)=0.0
9690 end do
9691 call qks ( nv,nv1,c3hh2(1,1,ig), fkgb,pp,pt,ph,po )
9692 do i = 1, nv1
9693 fkg(i) = fkgb(i)*ph(i)
9694 end do
9695 call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
9696 hk = 149.845 * hk3(ig)
9697 ! In this band ( 7700 - 5250 cm**-1 ), we have considered the nongray
9698 ! gaseous absorption of H2O. 149.845 is the solar energy contained in
9699 ! the band in units of Wm**-2.
9700 case(4)
9701 4 do i=1,nv1
9702 fkg(i)=0.0
9703 end do
9704 call qks ( nv,nv1,c4hh2(1,1,ig1), fkgb,pp,pt,ph,po )
9705 do i = 1, nv1
9706 fkg(i) = fkgb(i)*ph(i)
9707 end do
9708 call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
9709 call qks ( nv,nv1,c4co2(1,1,ig2), fkgb,pp,pt,ph,po )
9710 call qopco2(nv,nv1,fkgb,tg2,pp,pt,ph,po)
9711 call qks(nv,nv1,c4co,fkgc,pp,pt,ph,po)
9712 call qopco(nv,nv1,fkgc,tg3,pp,pt,ph,po)
9713 do i=1,nv
9714 tg(i)=tg1(i)+tg2(i)/330.*umco2+tg3(i)/0.16*umco
9715 end do
9716 hk = 48.7302 * hk4(ig1)*hk4(ig2)
9717 ! In this band ( 5250 - 4000 cm**-1 ), we have considered the nongray
9718 ! gaseous absorption of H2O. 48.7302 is the solar energy contained in
9719 ! the band in units of Wm**-2.
9720 case(5)
9721 5 do i=1,nv1
9722 fkg(i)=0.0
9723 end do
9724 call qks ( nv,nv1,c5hh2(1,1,ig1), fkgb,pp,pt,ph,po )
9725 do i = 1, nv1
9726 fkg(i) = fkgb(i)*ph(i)
9727 end do
9728 call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
9729 call qks ( nv,nv1,c5co2(1,1,ig2), fkgb,pp,pt,ph,po )
9730 call qopco2(nv,nv1,fkgb,tg2,pp,pt,ph,po)
9731 call qks(nv,nv1,c5n2o,fkgc,pp,pt,ph,po)
9732 call qopn2o(nv,nv1,fkgc,tg3,pp,pt,ph,po)
9733 call qks(nv,nv1,c5ch4,fkgd,pp,pt,ph,po)
9734 call qopch4(nv,nv1,fkgd,tg4,pp,pt,ph,po)
9735 do i=1,nv
9736 tg(i)=tg1(i)+tg2(i)/330.*umco2+tg3(i)/0.28*umn2o+ &
9737 & tg4(i)/1.6*umch4
9738 end do
9739 hk = 31.6576 * hk5(ig1)*hk5(ig2)
9740 ! In this band ( 4000 - 2850 cm**-1 ), we have considered the nongray
9741 ! gaseous absorption of H2O. 31.6576 is the solar energy contained in
9742 ! the band in units of Wm**-2.
9743 case(6)
9744 6 ig=ig1
9745 do i=1,nv1
9746 fkg(i)=0.0
9747 end do
9748 call qks ( nv,nv1,c6hh2(1,1,ig), fkgb,pp,pt,ph,po )
9749 do i = 1, nv1
9750 fkg(i) = fkgb(i)*ph(i)
9751 end do
9752 call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
9753 call qks(nv,nv1,c6so2,fkgb,pp,pt,ph,po)
9754 call qopso2(nv,nv1,fkgb,tg2,pp,pt,ph,po)
9755 do i=1,nv
9756 tg(i)=tg1(i)+tg2(i)/0.001*umso2
9757 end do
9758 hk = 5.79927 * hk6(ig)
9759 ! In this band ( 2850 - 2500 cm**-1 ), we have considered the nongray
9760 ! gaseous absorption of H2O. 5.79927 is the solar energy contained in
9761 ! the band in units of Wm**-2.
9762 case(7)
9763 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!cZ.F.
9764 7 ig=ig1
9765 if(nh2ol.eq.1) then
9766 call qki ( nv,nv1,c7h2o(1,1,ig), fkg,pp,pt,ph,po )
9767 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
9768 else
9769 do i=1,nv
9770 tg(i)=0.0
9771 end do
9772 end if
9773 hk = hk7(ig)
9774 ! In this band ( 2200 - 1900 cm**-1 ), we have considered the nongray
9775 ! gaseous absorption of H2O.
9776 case(8)
9777 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
9778 ! 8th---10th bands have been changed by Z.F. in Jun.2003
9779 !
9780 8 ig=ig1
9781 if(nh2ol.eq.1) then
9782 call qki ( nv,nv1,c8h2o(1,1,ig), fkg,pp,pt,ph,po )
9783 call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
9784 else
9785 do i=1,nv
9786 tg1(i)=0.0
9787 end do
9788 end if
9789 call qki(nv,nv1,c8no,fkgb,pp,pt,ph,po)
9790 call qopno(nv,nv1,fkgb,tg2,pp,pt,ph,po)
9791 ! print *, 'band 8, no, tg1=, tg2=', tg1,tg2
9792 do i=1,nv
9793 tg(i)=tg1(i)+tg2(i)*umno/0.0005
9794 end do
9795 hk = hk8(ig)
9796 ! In this band ( 1900 - 1700 cm**-1 ), we have considered the nongray
9797 ! gaseous absorption of H2O.
9798 case(9)
9799 9 ig=ig1
9800 if(nh2ol.eq.1) then
9801 call qki ( nv,nv1,c9h2o(1,1,ig), fkg,pp,pt,ph,po )
9802 call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
9803 else
9804 do i=1,nv
9805 tg1(i)=0.0
9806 end do
9807 end if
9808 call qki(nv,nv1,c9no2,fkgb,pp,pt,ph,po)
9809 call qopno(nv,nv1,fkgb,tg2,pp,pt,ph,po)
9810 ! print *, 'band 9, no, tg2=', tg1, tg2
9811 do i=1,nv
9812 tg(i)=tg1(i)+tg2(i)*umno2/0.001
9813 end do
9814 hk = hk9(ig)
9815 ! In this band ( 1700 - 1400 cm**-1 ), we have considered the nongray
9816 ! gaseous absorption of H2O.
9817 case(10)
9818 10 ig=ig1
9819 if(nh2ol.eq.1) then
9820 call qki ( nv,nv1,c10h2o(1,1,ig), fkg,pp,pt,ph,po )
9821 call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
9822 else
9823 do i=1,nv
9824 tg1(i)=0.0
9825 end do
9826 end if
9827 if(nch4l.eq.1) then
9828 call qki ( nv,nv1,c10ch4, fkg,pp,pt,ph,po )
9829 call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
9830 else
9831 do i=1,nv
9832 tg2(i)=0.0
9833 end do
9834 end if
9835 if(nn2ol.eq.1) then
9836 call qki ( nv,nv1,c10n2o, fkg,pp,pt,ph,po )
9837 call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
9838 else
9839 do i=1,nv
9840 tg3(i)=0.0
9841 end do
9842 end if
9843 call qki(nv,nv1,c10so2,fkgb,pp,pt,ph,po)
9844 call qopso2(nv,nv1,fkgb,tg4,pp,pt,ph,po)
9845 do i=1,nv
9846 tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o &
9847 & +tg4(i)/0.001*umso2
9848 end do
9849 hk = hk10(ig)
9850 ! In this band ( 1400 - 1250 cm**-1 ), we have considered the overlapping
9851 ! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
9852 ! In this band ( 1400 - 1250 cm**-1 ), we have considered the overlapping
9853 ! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
9854 case(11)
9855 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Z.F.
9856 11 ig=ig1
9857 if(nh2ol.eq.1) then
9858 call qki ( nv,nv1,c11h2o(1,1,ig), fkg,pp,pt,ph,po )
9859 call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
9860 else
9861 do i=1,nv
9862 tg1(i)=0.0
9863 end do
9864 end if
9865 if(nch4l.eq.1) then
9866 call qki ( nv,nv1,c11ch4, fkg,pp,pt,ph,po )
9867 call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
9868 else
9869 do i=1,nv
9870 tg2(i)=0.0
9871 end do
9872 end if
9873 if(nn2ol.eq.1) then
9874 call qki ( nv,nv1,c11n2o, fkg,pp,pt,ph,po )
9875 call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
9876 else
9877 do i=1,nv
9878 tg3(i)=0.0
9879 end do
9880 end if
9881 if(nCFC11l.eq.1) then
9882 call qopCFC11(nv,nv1,c11CFC11,tg4,pp,pt,ph,po)
9883 else
9884 do i=1,nv
9885 tg4(i)=0.0
9886 enddo
9887 end if
9888 if(nCFC12l.eq.1) then
9889 call qopCFC12(nv,nv1,c11CFC12,tg5,pp,pt,ph,po)
9890 else
9891 do i=1,nv
9892 tg5(i)=0.0
9893 enddo
9894 end if
9895 do i = 1, nv
9896 tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o + &
9897 & tg4(i)/0.22e-3*umCFC11 + tg5(i)/0.375e-3*umCFC12
9898 end do
9899 hk = hk11(ig)
9900 ! In this band ( 1250 - 1100 cm**-1 ), we have considered the overlapping
9901 ! absorption of H2O, CH4, N2O, CFC11 and CFC12 by approach one of Fu(1991).
9902 case(12)
9903 12 ig=ig1
9904 if(no3l.eq.1) then
9905 call qkio3 ( nv,nv1,c12o3(1,1,ig), fkg,pp,pt,ph,po )
9906 call qopo3i ( nv,nv1,fkg, tg1,pp,pt,ph,po )
9907 else
9908 do i=1,nv
9909 tg1(i)=0.0
9910 end do
9911 end if
9912 if(nh2ol.eq.1) then
9913 call qki ( nv,nv1,c12h2o, fkg,pp,pt,ph,po )
9914 call qoph2o ( nv,nv1,fkg, tg2,pp,pt,ph,po )
9915 else
9916 do i=1,nv
9917 tg2(i)=0.0
9918 end do
9919 end if
9920 if(nCFC11l.eq.1) then
9921 call qopCFC11(nv,nv1,c12CFC11,tg3,pp,pt,ph,po)
9922 else
9923 do i=1,nv
9924 tg3(i)=0.0
9925 enddo
9926 end if
9927 if(nCFC12l.eq.1) then
9928 call qopCFC12(nv,nv1,c12CFC12,tg4,pp,pt,ph,po)
9929 else
9930 do i=1,nv
9931 tg4(i)=0.0
9932 enddo
9933 end if
9934 do i = 1, nv
9935 tg(i) = tg1(i) + tg2(i) + tg3(i)/0.22e-3*umCFC11 &
9936 & +tg4(i)/0.375e-3*umCFC12
9937 end do
9938 hk = hk12(ig)
9939 ! In this band ( 1100 - 980 cm**-1 ), we have considered the overlapping
9940 ! absorption of H2O and O3, CFC11, CFC12 by approach one of Fu(1991).
9941 case(13)
9942 13 ig=ig1
9943 if(nh2ol.eq.1) then
9944 call qki ( nv,nv1,c13h2o(1,1,ig), fkg,pp,pt,ph,po )
9945 call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
9946 else
9947 do i=1,nv
9948 tg1(i)=0.0
9949 end do
9950 end if
9951 if(nCFC11l.eq.1) then
9952 call qopCFC11(nv,nv1,c13CFC11,tg2,pp,pt,ph,po)
9953 else
9954 do i=1,nv
9955 tg2(i)=0.0
9956 enddo
9957 end if
9958 if(nCFC12l.eq.1) then
9959 call qopCFC12(nv,nv1,c13CFC12,tg3,pp,pt,ph,po)
9960 else
9961 do i=1,nv
9962 tg3(i)=0.0
9963 enddo
9964 end if
9965 do i = 1, nv
9966 tg(i) = tg1(i) + tg2(i)/0.22e-3*umCFC11 + &
9967 & tg3(i)/0.375e-3*umCFC12
9968 enddo
9969 hk = hk13(ig)
9970 ! In this band ( 980 - 800 cm**-1 ), we have considered the overlapping
9971 ! absorption of H2O, CFC11 and CFC12 by approach one of fu (1991).
9972 case(14)
9973 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!c
9974 ! 14th band has been changed by Z.F. in Jun,2003
9975 !
9976 14 ig=ig1
9977 do i = 1, nv1
9978 if ( pp(i) .ge. 63.1 ) then
9979 pq(i) = ph(i)
9980 else
9981 pq(i) = 0.0
9982 endif
9983 333 end do
9984 if(nco2l.eq.1) then
9985 call qki ( nv,nv1,c14hca(1,1,ig), fkga,pp,pt,ph,po )
9986 else
9987 do i=1,nv1
9988 fkga(i)=0.0
9989 end do
9990 end if
9991 if(nh2ol.eq.1) then
9992 call qki ( nv,nv1,c14hcb(1,1,ig), fkgb,pp,pt,ph,po )
9993 else
9994 do i=1,nv1
9995 fkgb(i)=0.0
9996 end do
9997 end if
9998 do i = 1, nv1
9999 fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
10000 343 end do
10001 call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
10002 call qki(nv,nv1,c14ch3cl,fkgb,pp,pt,ph,po)
10003 call qopch3cl(nv,nv1,fkgb,tg2,pp,pt,ph,po)
10004 do i=1,nv
10005 tg(i)=tg1(i)+tg2(i)*umch3cl/0.5e-3
10006 end do
10007 hk = hk14(ig)
10008 ! In this band ( 800 - 670 cm**-1), we have considered the overlapping
10009 ! absorption of H2O and CO2 by approach two of Fu(1991).
10010 case(15)
10011 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Z.F.
10012 15 ig=ig1
10013 do i = 1, nv1
10014 if ( pp(i) .ge. 63.1 ) then
10015 pq(i) = ph(i)
10016 else
10017 pq(i) = 0.0
10018 endif
10019 353 end do
10020 if(nco2l.eq.1) then
10021 call qki ( nv,nv1,c15hca(1,1,ig), fkga,pp,pt,ph,po )
10022 else
10023 do i=1,nv1
10024 fkga(i)=0.0
10025 end do
10026 end if
10027 if(nh2ol.eq.1) then
10028 call qki ( nv,nv1,c15hcb(1,1,ig), fkgb,pp,pt,ph,po )
10029 else
10030 do i=1,nv1
10031 fkgb(i)=0.0
10032 end do
10033 end if
10034 do i = 1, nv1
10035 fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
10036 363 end do
10037 call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
10038 hk = hk15(ig)
10039 ! In this band ( 670 - 540 cm**-1), we have considered the overlapping
10040 ! absorption of H2O and CO2 by approach two of Fu(1991).
10041 case(16)
10042 16 ig=ig1
10043 if(nh2ol.eq.1) then
10044 call qki ( nv,nv1,c16h2o(1,1,ig), fkg,pp,pt,ph,po )
10045 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
10046 else
10047 do i=1,nv
10048 tg(i)=0.0
10049 end do
10050 end if
10051 hk = hk16(ig)
10052 ! In this band ( 540 - 400 cm**-1 ), we have considered the nongray
10053 ! gaseous absorption of H2O.
10054 case(17)
10055 17 ig=ig1
10056 if(nh2ol.eq.1) then
10057 call qki ( nv,nv1,c17h2o(1,1,ig), fkg,pp,pt,ph,po )
10058 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
10059 else
10060 do i=1,nv
10061 tg(i)=0.0
10062 end do
10063 end if
10064 hk = hk17(ig)
10065 ! In this band ( 400 - 280 cm**-1 ), we have considered the nongray
10066 ! gaseous absorption of H2O.
10067 case(18)
10068 18 ig=ig1
10069 if(nh2ol.eq.1) then
10070 call qki ( nv,nv1,c18h2o(1,1,ig), fkg,pp,pt,ph,po )
10071 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
10072 else
10073 do i=1,nv
10074 tg(i)=0.0
10075 end do
10076 end if
10077 hk = hk18(ig)
10078 ! In this band ( 280 - 000 cm**-1 ), we have considered the nongray
10079 ! gaseous absorption of H2O.
10080 20 end select
10081 return
10082 end subroutine gases_new
10085 subroutine ice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10086 ! *********************************************************************
10087 ! ti, wi, and wwi are the optical depth, single scattering albedo,
10088 ! and expansion coefficients of the phase function ( 1, 2, 3, and
10089 ! 4) due to the scattering of ice clouds for a given layer.
10090 ! *********************************************************************
10091 use para_file
10092 use ice0
10093 implicit none
10095 integer :: nv, nv1
10096 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10097 real :: ti(nv), wi(nv), wwi(nv,4)
10098 real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4, fd
10099 integer :: i ,ib, ibr
10101 do i = 1, nv
10102 if ( piwc(i) .lt. 1.0e-5 ) then
10103 ti(i) = 0.0
10104 wi(i) = 0.0
10105 wwi(i,1) = 0.0
10106 wwi(i,2) = 0.0
10107 wwi(i,3) = 0.0
10108 wwi(i,4) = 0.0
10109 else
10110 ! The constant 1000.0 below is to consider the units of dz(i) is km.
10111 fw1 = pde(i)
10112 fw2 = fw1 * pde(i)
10113 fw3 = fw2 * pde(i)
10114 ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10115 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10116 wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
10117 & bp(3,ib) * fw2 + bp(4,ib) * fw3 )
10119 !C--- test for 10% more high clouds but 10% reduced single-scattering albedo
10120 !c if (i.ge.7.and.i.le.9) then
10121 !c wi(i) = wi(i) * 0.98
10122 !c endif
10123 !c--- end test
10125 if ( ib .le. mbs ) then
10126 fd = dps(1,ib) + dps(2,ib) * fw1 + &
10127 & dps(3,ib) * fw2 + dps(4,ib) * fw3
10128 wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
10129 & cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
10130 wwi(i,1) = ( 1.0 - fd ) * wf1 + 3.0 * fd
10131 wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
10132 & cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
10133 wwi(i,2) = ( 1.0 - fd ) * wf2 + 5.0 * fd
10134 wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
10135 & cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
10136 wwi(i,3) = ( 1.0 - fd ) * wf3 + 7.0 * fd
10137 wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
10138 & cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
10139 wwi(i,4) = ( 1.0 - fd ) * wf4 + 9.0 * fd
10140 else
10141 ibr = ib - mbs
10142 gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
10143 & cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
10144 x1 = gg
10145 x2 = x1 * gg
10146 x3 = x2 * gg
10147 x4 = x3 * gg
10148 wwi(i,1) = 3.0 * x1
10149 wwi(i,2) = 5.0 * x2
10150 wwi(i,3) = 7.0 * x3
10151 wwi(i,4) = 9.0 * x4
10152 endif
10153 endif
10154 10 end do
10155 return
10156 end subroutine
10158 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10159 !C--- using new coefficients for ice single-scattering parameterization
10160 subroutine ice_new_ZF ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10161 !c *********************************************************************
10162 !c ti, wi, and wwi are the optical depth, single scattering albedo, &
10163 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10164 !c 4) due to the scattering of ice clouds for a given layer.
10165 !c *********************************************************************
10166 !# include "para.file"
10167 USE PARA_FILE
10168 USE ice1
10169 implicit none
10171 integer :: nv, nv1
10172 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10173 real :: ti(nv), wi(nv), wwi(nv,4)
10174 real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
10175 integer :: i, ib, ibr
10176 ! changed by Z.F.
10177 ! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
10178 ! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
10179 ! changing over
10180 do i = 1, nv
10181 if ( piwc(i) .lt. 1.0e-5 ) then
10182 ti(i) = 0.0
10183 wi(i) = 0.0
10184 wwi(i,1) = 0.0
10185 wwi(i,2) = 0.0
10186 wwi(i,3) = 0.0
10187 wwi(i,4) = 0.0
10188 else
10189 ! The constant 1000.0 below is to consider the units of dz(i) is km.
10190 fw1 = pde(i)
10191 fw2 = fw1 * pde(i)
10192 fw3 = fw2 * pde(i)
10193 ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10194 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10195 if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
10196 wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
10197 & bp(3,ib) * fw2 + bp(4,ib) * fw3 )
10198 if ( ib .le. mbs ) then
10199 ! changed by Z.F.
10200 wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
10201 & cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
10202 wwi(i,1) = wf1
10203 wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
10204 & cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
10205 wwi(i,2) = wf2
10206 wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
10207 & cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
10208 wwi(i,3) = wf3
10209 wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
10210 & cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
10211 wwi(i,4) = wf4
10212 ! changing over
10213 else
10214 ibr = ib - mbs
10215 gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
10216 & cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
10217 x1 = gg
10218 x2 = x1 * gg
10219 x3 = x2 * gg
10220 x4 = x3 * gg
10221 wwi(i,1) = 3.0 * x1
10222 wwi(i,2) = 5.0 * x2
10223 wwi(i,3) = 7.0 * x3
10224 wwi(i,4) = 9.0 * x4
10225 endif
10226 endif
10227 10 end do
10228 ! added by Z.F.
10229 ! if(ib.le.mbs) then
10230 ! do i=1,nv
10231 ! tizfs(i,ib)=ti(i)
10232 ! wizfs(i,ib)=wi(i)
10233 ! wwi1s(i,ib)=wwi(i,1)
10234 ! wwi2s(i,ib)=wwi(i,2)
10235 ! wwi3s(i,ib)=wwi(i,3)
10236 ! wwi4s(i,ib)=wwi(i,4)
10237 ! end do
10238 ! end if
10240 ! write(*,*)'ti=',ti
10241 ! write(*,*)'wi=',wi
10242 ! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
10243 ! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
10244 ! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
10245 ! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
10247 ! adding over
10248 return
10249 end subroutine
10251 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10252 !C--- using new coefficients for ice single-scattering parameterization
10253 !C--- by Qing Yue 2006
10254 subroutine ice_new_comb ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10255 !c *********************************************************************
10256 !c ti, wi, and wwi are the optical depth, single scattering albedo, &
10257 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10258 !c 4) due to the scattering of ice clouds for a given layer.
10259 !c *********************************************************************
10260 !# include "para.file"
10261 USE PARA_FILE
10262 USE ice2
10263 implicit none
10265 integer :: nv, nv1
10266 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10267 real :: ti(nv), wi(nv), wwi(nv,4)
10268 real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
10269 integer :: i, ib, ibr
10271 ! changed by Z.F.
10272 ! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
10273 ! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
10274 ! changing over
10275 do i = 1, nv
10276 if ( piwc(i) .lt. 1.0e-5 ) then
10277 ti(i) = 0.0
10278 wi(i) = 0.0
10279 wwi(i,1) = 0.0
10280 wwi(i,2) = 0.0
10281 wwi(i,3) = 0.0
10282 wwi(i,4) = 0.0
10283 else
10284 ! The constant 1000.0 below is to consider the units of dz(i) is km.
10285 fw1 = pde(i)
10286 fw2 = fw1 * pde(i)
10287 fw3 = fw2 * pde(i)
10288 ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10289 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10291 ! -- uncomment the following if want to output optical depth for each band
10292 ! write(*,*)'level=', i, 'optical depth of ice=',ti(i)
10294 wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
10295 & bp(3,ib) * fw2 + bp(4,ib) * fw3 )
10296 if ( ib .le. mbs ) then
10297 ! changed by Z.F.
10298 wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
10299 & cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
10300 wwi(i,1) = wf1
10301 wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
10302 & cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
10303 wwi(i,2) = wf2
10304 wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
10305 & cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
10306 wwi(i,3) = wf3
10307 wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
10308 & cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
10309 wwi(i,4) = wf4
10310 ! changing over
10311 else
10312 ibr = ib - mbs
10313 gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
10314 & cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
10315 x1 = gg
10316 x2 = x1 * gg
10317 x3 = x2 * gg
10318 x4 = x3 * gg
10319 wwi(i,1) = 3.0 * x1
10320 wwi(i,2) = 5.0 * x2
10321 wwi(i,3) = 7.0 * x3
10322 wwi(i,4) = 9.0 * x4
10323 endif
10324 endif
10325 10 end do
10326 ! added by Z.F.
10327 ! if(ib.le.mbs) then
10328 ! do i=1,nv
10329 ! tizfs(i,ib)=ti(i)
10330 ! wizfs(i,ib)=wi(i)
10331 ! wwi1s(i,ib)=wwi(i,1)
10332 ! wwi2s(i,ib)=wwi(i,2)
10333 ! wwi3s(i,ib)=wwi(i,3)
10334 ! wwi4s(i,ib)=wwi(i,4)
10335 ! end do
10336 ! end if
10338 ! write(*,*)'ti=',ti
10339 ! write(*,*)'wi=',wi
10340 ! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
10341 ! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
10342 ! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
10343 ! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
10344 ! adding over
10345 return
10346 end subroutine
10348 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10349 !C--- using new coefficients for ice single-scattering parameterization
10350 !C--- for tropics
10351 subroutine ice_new_trop ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10352 !c *********************************************************************
10353 !c ti, wi, and wwi are the optical depth, single scattering albedo, &
10354 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10355 !c 4) due to the scattering of ice clouds for a given layer.
10356 !c *********************************************************************
10357 !# include "para.file"
10358 USE PARA_FILE
10359 USE ice3
10360 implicit none
10361 integer :: nv, nv1
10362 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10363 real :: ti(nv), wi(nv), wwi(nv,4)
10364 real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
10365 integer :: i ,ib, ibr
10367 ! changed by Z.F.
10368 ! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
10369 ! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
10370 ! changing over
10371 do i = 1, nv
10372 if ( piwc(i) .lt. 1.0e-5 ) then
10373 ti(i) = 0.0
10374 wi(i) = 0.0
10375 wwi(i,1) = 0.0
10376 wwi(i,2) = 0.0
10377 wwi(i,3) = 0.0
10378 wwi(i,4) = 0.0
10379 else
10380 ! The constant 1000.0 below is to consider the units of dz(i) is km.
10381 fw1 = pde(i)
10382 fw2 = fw1 * pde(i)
10383 fw3 = fw2 * pde(i)
10384 ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10385 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10386 if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
10387 wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
10388 & bp(3,ib) * fw2 + bp(4,ib) * fw3 )
10389 if ( ib .le. mbs ) then
10390 ! changed by Z.F.
10391 wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
10392 & cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
10393 wwi(i,1) = wf1
10394 wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
10395 & cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
10396 wwi(i,2) = wf2
10397 wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
10398 & cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
10399 wwi(i,3) = wf3
10400 wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
10401 & cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
10402 wwi(i,4) = wf4
10403 ! changing over
10404 else
10405 ibr = ib - mbs
10406 gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
10407 & cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
10408 x1 = gg
10409 x2 = x1 * gg
10410 x3 = x2 * gg
10411 x4 = x3 * gg
10412 wwi(i,1) = 3.0 * x1
10413 wwi(i,2) = 5.0 * x2
10414 wwi(i,3) = 7.0 * x3
10415 wwi(i,4) = 9.0 * x4
10416 endif
10417 endif
10418 10 end do
10419 ! added by Z.F.
10420 ! if(ib.le.mbs) then
10421 ! do i=1,nv
10422 ! tizfs(i,ib)=ti(i)
10423 ! wizfs(i,ib)=wi(i)
10424 ! wwi1s(i,ib)=wwi(i,1)
10425 ! wwi2s(i,ib)=wwi(i,2)
10426 ! wwi3s(i,ib)=wwi(i,3)
10427 ! wwi4s(i,ib)=wwi(i,4)
10428 ! end do
10429 ! end if
10431 ! write(*,*)'ti=',ti
10432 ! write(*,*)'wi=',wi
10433 ! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
10434 ! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
10435 ! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
10436 ! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
10437 ! adding over
10438 return
10439 end subroutine
10441 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10442 !C--- using new coefficients for ice single-scattering parameterization
10443 subroutine ice_new_midlat ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10444 !c *********************************************************************
10445 !c ti, wi, and wwi are the optical depth, single scattering albedo, &
10446 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10447 !c 4) due to the scattering of ice clouds for a given layer.
10448 !c *********************************************************************
10449 !# include "para.file"
10450 USE PARA_FILE
10451 USE ice4
10452 implicit none
10454 integer :: nv, nv1
10455 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10456 real :: ti(nv), wi(nv), wwi(nv,4)
10457 real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
10458 integer :: i, ib, ibr
10460 ! changed by Z.F.
10461 ! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
10462 ! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
10463 ! changing over
10464 do i = 1, nv
10465 if ( piwc(i) .lt. 1.0e-5 ) then
10466 ti(i) = 0.0
10467 wi(i) = 0.0
10468 wwi(i,1) = 0.0
10469 wwi(i,2) = 0.0
10470 wwi(i,3) = 0.0
10471 wwi(i,4) = 0.0
10472 else
10473 ! The constant 1000.0 below is to consider the units of dz(i) is km.
10474 fw1 = pde(i)
10475 fw2 = fw1 * pde(i)
10476 fw3 = fw2 * pde(i)
10477 ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10478 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10479 if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
10480 wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
10481 & bp(3,ib) * fw2 + bp(4,ib) * fw3 )
10482 if ( ib .le. mbs ) then
10483 ! changed by Z.F.
10484 wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
10485 & cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
10486 wwi(i,1) = wf1
10487 wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
10488 & cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
10489 wwi(i,2) = wf2
10490 wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
10491 & cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
10492 wwi(i,3) = wf3
10493 wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
10494 & cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
10495 wwi(i,4) = wf4
10496 ! changing over
10497 else
10498 ibr = ib - mbs
10499 gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
10500 & cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
10501 x1 = gg
10502 x2 = x1 * gg
10503 x3 = x2 * gg
10504 x4 = x3 * gg
10505 wwi(i,1) = 3.0 * x1
10506 wwi(i,2) = 5.0 * x2
10507 wwi(i,3) = 7.0 * x3
10508 wwi(i,4) = 9.0 * x4
10509 endif
10510 endif
10511 10 end do
10512 ! added by Z.F.
10513 ! if(ib.le.mbs) then
10514 ! do i=1,nv
10515 ! tizfs(i,ib)=ti(i)
10516 ! wizfs(i,ib)=wi(i)
10517 ! wwi1s(i,ib)=wwi(i,1)
10518 ! wwi2s(i,ib)=wwi(i,2)
10519 ! wwi3s(i,ib)=wwi(i,3)
10520 ! wwi4s(i,ib)=wwi(i,4)
10521 ! end do
10522 ! end if
10524 ! write(*,*)'ti=',ti
10525 ! write(*,*)'wi=',wi
10526 ! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
10527 ! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
10528 ! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
10529 ! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
10530 ! adding over
10531 return
10532 end subroutine
10535 !************************************************
10536 !C--- using FLIce98 for ice single-scattering parameterization
10537 subroutine ice_98 ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10538 !c *********************************************************************
10539 !c ti, wi, and wwi are the optical depth, single scattering albedo, &
10540 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10541 !c 4) due to the scattering of ice clouds for a given layer.
10542 !c *********************************************************************
10543 !# include "para.file"
10544 !c USE RadParams
10545 USE PARA_FILE
10546 USE ice5
10547 implicit none
10549 integer :: nv, nv1
10550 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10551 real ti(nv), wi(nv), wwi(nv,4)
10552 real fw1, fw2, fw3, tau, omega, asy, fd, f, fw, &
10553 & gg, x1, x2, x3, x4, betae, betaa
10554 integer i, ib, ibr
10556 do i = 1, nv
10557 if ( piwc(i) .lt. 1.0e-5 ) then
10558 ti(i) = 0.0
10559 wi(i) = 0.0
10560 wwi(i,1) = 0.0
10561 wwi(i,2) = 0.0
10562 wwi(i,3) = 0.0
10563 wwi(i,4) = 0.0
10564 else
10565 fw1 = pde(i)
10566 fw2 = fw1 * pde(i)
10567 fw3 = fw2 * pde(i)
10568 if ( ib .le. mbs ) then
10569 tau = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10570 & ap(2,ib) / fw1 )
10571 omega = 1.0 - ( bps(1,ib) + bps(2,ib) * fw1 + &
10572 & bps(3,ib) * fw2 + bps(4,ib) * fw3 )
10573 asy = cp(1,ib) + cp(2,ib) * fw1 + &
10574 & cp(3,ib) * fw2 + cp(4,ib) * fw3
10575 fd = dps(1,ib) + dps(2,ib) * fw1 + &
10576 & dps(3,ib) * fw2 + dps(4,ib) * fw3
10577 f = 0.5 / omega + fd
10578 fw = f * omega
10579 ti(i) = ( 1.0 - fw ) * tau
10580 wi(i) = ( 1.0 - f ) * omega / ( 1.0 - fw )
10581 gg = ( asy - f ) / ( 1.0 - f )
10582 x1 = gg
10583 x2 = x1 * gg
10584 x3 = x2 * gg
10585 x4 = x3 * gg
10586 wwi(i,1) = 3.0 * x1
10587 wwi(i,2) = 5.0 * x2
10588 wwi(i,3) = 7.0 * x3
10589 wwi(i,4) = 9.0 * x4
10590 else
10591 ibr = ib - mbs
10592 betae = piwc(i) * ( ap(1,ib) + &
10593 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10594 betaa = piwc(i) / fw1 * ( bpir(1,ibr) + bpir(2,ibr) * &
10595 & fw1 + bpir(3,ibr) * fw2 + bpir(4,ibr) * fw3 )
10596 asy = cp(1,ib) + cp(2,ib) * fw1 + &
10597 & cp(3,ib) * fw2 + cp(4,ib) * fw3
10598 ti(i) = dz(i) * 1000.0 * betae
10599 wi(i) = 1.0 - betaa / betae
10600 gg = asy
10601 x1 = gg
10602 x2 = x1 * gg
10603 x3 = x2 * gg
10604 x4 = x3 * gg
10605 wwi(i,1) = 3.0 * x1
10606 wwi(i,2) = 5.0 * x2
10607 wwi(i,3) = 7.0 * x3
10608 wwi(i,4) = 9.0 * x4
10609 endif
10610 endif
10611 10 end do
10612 return
10613 end subroutine
10614 !c Fu 07-08-98
10617 !************************************************
10618 !C--- ice single-scattering parameterization by Feng using Ping Yang 2000 data
10619 subroutine ice_singleice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10620 !c *********************************************************************
10621 !c ti, wi, and wwi are the optical depth, single scattering albedo, &
10622 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10623 !c 4) due to the scattering of ice clouds for a given layer.
10624 !c *********************************************************************
10625 !# include "para.file"
10626 USE PARA_FILE
10627 USE ice6
10628 implicit none
10630 integer :: nv, nv1
10631 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10632 real :: ti(nv), wi(nv), wwi(nv,4)
10633 real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4, fd
10634 integer :: i, ib, ibr
10636 do i = 1, nv
10637 if ( piwc(i) .lt. 1.0e-5 ) then
10638 ti(i) = 0.0
10639 wi(i) = 0.0
10640 wwi(i,1) = 0.0
10641 wwi(i,2) = 0.0
10642 wwi(i,3) = 0.0
10643 wwi(i,4) = 0.0
10644 else
10645 ! The constant 1000.0 below is to consider the units of dz(i) is km.
10646 fw1 = pde(i)
10647 fw2 = fw1 * pde(i)
10648 fw3 = fw2 * pde(i)
10649 ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10650 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10651 wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
10652 & bp(3,ib) * fw2 + bp(4,ib) * fw3 )
10653 if ( ib .le. mbs ) then
10654 fd = dps(1,ib) + dps(2,ib) * fw1 + &
10655 & dps(3,ib) * fw2 + dps(4,ib) * fw3
10656 wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
10657 & cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
10658 wwi(i,1) = ( 1.0 - fd ) * wf1 + 3.0 * fd
10659 wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
10660 & cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
10661 wwi(i,2) = ( 1.0 - fd ) * wf2 + 5.0 * fd
10662 wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
10663 & cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
10664 wwi(i,3) = ( 1.0 - fd ) * wf3 + 7.0 * fd
10665 wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
10666 & cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
10667 wwi(i,4) = ( 1.0 - fd ) * wf4 + 9.0 * fd
10668 else
10669 ibr = ib - mbs
10670 gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
10671 & cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
10672 x1 = gg
10673 x2 = x1 * gg
10674 x3 = x2 * gg
10675 x4 = x3 * gg
10676 wwi(i,1) = 3.0 * x1
10677 wwi(i,2) = 5.0 * x2
10678 wwi(i,3) = 7.0 * x3
10679 wwi(i,4) = 9.0 * x4
10680 endif
10681 endif
10682 10 end do
10683 return
10684 end subroutine
10687 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10688 !C--- using new coefficients for ice single habit
10689 !C--- by Qing Yue 2006
10690 subroutine ice_new_Single ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
10691 !c *********************************************************************
10692 !c ti, wi, and wwi are the optical depth, single scattering albedo, &
10693 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10694 !c 4) due to the scattering of ice clouds for a given layer.
10695 !c *********************************************************************
10696 !# include "para.file"
10697 USE PARA_FILE
10698 USE ice7
10699 implicit none
10701 integer :: nv, nv1
10702 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10703 real :: ti(nv), wi(nv), wwi(nv,4)
10704 real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
10705 integer :: i, ib, ibr
10707 ! changed by Z.F.
10708 ! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
10709 ! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
10710 ! changing over
10711 do i = 1, nv
10712 if ( piwc(i) .lt. 1.0e-5 ) then
10713 ti(i) = 0.0
10714 wi(i) = 0.0
10715 wwi(i,1) = 0.0
10716 wwi(i,2) = 0.0
10717 wwi(i,3) = 0.0
10718 wwi(i,4) = 0.0
10719 else
10720 ! The constant 1000.0 below is to consider the units of dz(i) is km.
10721 fw1 = pde(i)
10722 fw2 = fw1 * pde(i)
10723 fw3 = fw2 * pde(i)
10724 ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
10725 & ap(2,ib) / fw1 + ap(3,ib) / fw2 )
10726 if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
10727 wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
10728 & bp(3,ib) * fw2 + bp(4,ib) * fw3 )
10729 if ( ib .le. mbs ) then
10730 ! changed by Z.F.
10731 wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
10732 & cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
10733 wwi(i,1) = wf1
10734 wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
10735 & cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
10736 wwi(i,2) = wf2
10737 wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
10738 & cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
10739 wwi(i,3) = wf3
10740 wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
10741 & cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
10742 wwi(i,4) = wf4
10743 ! changing over
10744 else
10745 ibr = ib - mbs
10746 gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
10747 & cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
10748 x1 = gg
10749 x2 = x1 * gg
10750 x3 = x2 * gg
10751 x4 = x3 * gg
10752 wwi(i,1) = 3.0 * x1
10753 wwi(i,2) = 5.0 * x2
10754 wwi(i,3) = 7.0 * x3
10755 wwi(i,4) = 9.0 * x4
10756 endif
10757 endif
10758 10 end do
10759 ! added by Z.F.
10760 ! if(ib.le.mbs) then
10761 ! do i=1,nv
10762 ! tizfs(i,ib)=ti(i)
10763 ! wizfs(i,ib)=wi(i)
10764 ! wwi1s(i,ib)=wwi(i,1)
10765 ! wwi2s(i,ib)=wwi(i,2)
10766 ! wwi3s(i,ib)=wwi(i,3)
10767 ! wwi4s(i,ib)=wwi(i,4)
10768 ! end do
10769 ! end if
10771 ! write(*,*)'ti=',ti
10772 ! write(*,*)'wi=',wi
10773 ! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
10774 ! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
10775 ! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
10776 ! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
10777 ! adding over
10778 return
10779 end subroutine
10781 subroutine water_fl ( nv,nv1,ib,pre,plwc,pde,piwc,dz,tw,ww,www )
10782 !c *********************************************************************
10783 !c tw, ww, and www are the optical depth, single scattering albedo, &
10784 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10785 !c 4) due to the Mie scattering of water clouds for a given layer.
10786 !c By using the mean single scattering properties of the eight drop
10787 !c size distributions in each spectral band, the single scattering
10788 !c properties of a water cloud with the given liquid water content
10789 !c and effective radius are obtained by interpolating (Eqs. 4.25 -
10790 !c 4.27 of Fu, 1991).
10791 !c *********************************************************************
10792 !# include "para.file"
10793 USE PARA_FILE
10794 USE water1
10795 implicit none
10797 integer :: nv, nv1
10798 real, dimension(nv) :: pre, plwc, pde, piwc, dz
10799 real :: tw(nv), ww(nv), www(nv,4)
10800 integer :: ib
10801 real :: x1, x2, x3, x4, gg
10802 integer :: i, j
10804 do i = 1, nv
10805 if ( plwc(i) .lt. 1.0e-5 ) then
10806 tw(i) = 0.0
10807 ww(i) = 0.0
10808 www(i,1) = 0.0
10809 www(i,2) = 0.0
10810 www(i,3) = 0.0
10811 www(i,4) = 0.0
10812 else
10813 if ( pre(i) .le. re(1) ) then
10814 ! A cloud with the effective radius smaller than 4.18 um is assumed
10815 ! to have an effective radius of 4.18 um with respect to the single
10816 ! scattering properties.
10817 tw(i) = dz(i) * plwc(i) * bz(1,ib) / fl(1)
10818 ww(i) = wz(1,ib)
10819 x1 = gz(1,ib)
10820 x2 = x1 * gz(1,ib)
10821 x3 = x2 * gz(1,ib)
10822 x4 = x3 * gz(1,ib)
10823 www(i,1) = 3.0 * x1
10824 www(i,2) = 5.0 * x2
10825 www(i,3) = 7.0 * x3
10826 www(i,4) = 9.0 * x4
10827 elseif ( pre(i) .ge. re(nc) ) then
10828 ! A cloud with the effective radius larger than 31.23 um is assumed
10829 ! to have an effective radius of 31.18 um with respect to the single
10830 ! scattering properties.
10831 tw(i) = dz(i) * plwc(i) * bz(nc,ib) / fl(nc)
10832 ww(i) = wz(nc,ib)
10833 x1 = gz(nc,ib)
10834 x2 = x1 * gz(nc,ib)
10835 x3 = x2 * gz(nc,ib)
10836 x4 = x3 * gz(nc,ib)
10837 www(i,1) = 3.0 * x1
10838 www(i,2) = 5.0 * x2
10839 www(i,3) = 7.0 * x3
10840 www(i,4) = 9.0 * x4
10841 else
10842 j = nc
10843 do while (pre(i) .lt. re(j))
10844 j = j - 1
10845 end do
10846 tw(i) = dz(i) * plwc(i) * ( bz(j,ib) / fl(j) + &
10847 & ( bz(j+1,ib) / fl(j+1) - bz(j,ib) / fl(j) ) / &
10848 & ( 1.0 / re(j+1) - 1.0 / re(j) ) * ( 1.0 / pre(i) &
10849 & - 1.0 / re(j) ) )
10850 ww(i) = wz(j,ib) + ( wz(j+1,ib) - wz(j,ib) ) / &
10851 & ( re(j+1) - re(j) ) * ( pre(i) - re(j) )
10852 gg = gz(j,ib) + ( gz(j+1,ib) - gz(j,ib) ) / &
10853 & ( re(j+1) - re(j) ) * ( pre(i) - re(j) )
10854 x1 = gg
10855 x2 = x1 * gg
10856 x3 = x2 * gg
10857 x4 = x3 * gg
10858 www(i,1) = 3.0 * x1
10859 www(i,2) = 5.0 * x2
10860 www(i,3) = 7.0 * x3
10861 www(i,4) = 9.0 * x4
10862 endif
10863 endif
10864 10 end do
10865 return
10866 end subroutine
10869 subroutine rayle2(nv,nv1,pp,pt,ph,po,trp)
10870 !c *********************************************************************
10871 !c trp is P(mb)/T(K)*DZ(m) and the constant 14.6337=R(287)/g(9.806)/2.
10872 !c *********************************************************************
10873 !# include "para.file"
10874 USE PARA_FILE
10875 implicit none
10876 integer :: nv, nv1
10877 real, dimension(nv1) :: pp, pt, ph, po
10878 real :: trp(nv)
10879 integer :: i
10880 do i = 1, nv
10881 trp(i) = 14.6337 * ( pp(i) + pp(i+1) ) &
10882 & * alog( pp(i+1) / pp(i) )
10883 end do
10884 return
10885 end subroutine
10888 subroutine rayle ( nv,nv1,ib,trp,tr,wr,wwr,u0 )
10889 !c *********************************************************************
10890 !c tr, wr, and wwr are the optical depth, single scattering albedo, &
10891 !c and expansion coefficients of the phase function ( 1, 2, 3, and
10892 !c 4 ) due to the Rayleigh scattering for a given layer.
10893 !c *********************************************************************
10894 !# include "para.file"
10895 USE PARA_FILE
10896 use rayle1
10897 implicit none
10898 integer :: nv, nv1
10899 real :: u0
10900 real :: trp(nv)
10901 real :: tr(nv), wr(nv), wwr(nv,4)
10902 integer :: ib, i
10903 real :: x
10905 if ( ib .le. mbs ) then
10906 if ( ib .eq. 1 ) then
10907 x = -3.902860e-6 * u0 * u0+6.120070e-6 * u0+4.177440e-6
10908 else
10909 x = ri(ib)
10910 endif
10911 do i = 1, nv
10912 tr(i) = trp(i) * x
10913 wr(i) = 1.0
10914 wwr(i,1) = 0.0
10915 wwr(i,2) = 0.5
10916 wwr(i,3) = 0.0
10917 wwr(i,4) = 0.0
10918 100 end do
10919 else
10920 do i = 1, nv
10921 tr(i) = 0.0
10922 wr(i) = 0.0
10923 wwr(i,1) = 0.0
10924 wwr(i,2) = 0.0
10925 wwr(i,3) = 0.0
10926 wwr(i,4) = 0.0
10927 200 end do
10928 endif
10929 return
10930 end subroutine
10933 subroutine rain ( nv,nv1,ib,prwc,dz,trn,wrn,wwrn )
10934 !c *********************************************************************
10935 !c trn, wrn, and wwrn are the optical depth, single scattering albedo, &
10936 !c and expansion coefficients of the phase function ( 1, 2, 3, and 4 )
10937 !c due to the Mie scattering of rain for a given layer.
10938 !c Jan. 19, 1993
10939 !c *********************************************************************
10940 !# include "para.file"
10941 USE PARA_FILE
10942 USE rain1
10943 implicit none
10944 integer :: nv, nv1
10945 real :: prwc(nv), dz(nv)
10946 real :: trn(nv), wrn(nv), wwrn(nv,4)
10947 integer :: ib, i
10948 real :: x1, x2, x3, x4, y1, y2, y3, y4
10950 x1 = grn(ib)
10951 x2 = x1 * grn(ib)
10952 x3 = x2 * grn(ib)
10953 x4 = x3 * grn(ib)
10954 y1 = 3.0 * x1
10955 y2 = 5.0 * x2
10956 y3 = 7.0 * x3
10957 y4 = 9.0 * x4
10958 do i = 1, nv
10959 if ( prwc(i) .lt. 1.0e-5 ) then
10960 trn(i) = 0.0
10961 wrn(i) = 0.0
10962 wwrn(i,1) = 0.0
10963 wwrn(i,2) = 0.0
10964 wwrn(i,3) = 0.0
10965 wwrn(i,4) = 0.0
10966 else
10967 trn(i) = dz(i) * prwc(i) * brn(ib) / rwc
10968 wrn(i) = wrnf(ib)
10969 wwrn(i,1) = y1
10970 wwrn(i,2) = y2
10971 wwrn(i,3) = y3
10972 wwrn(i,4) = y4
10973 endif
10974 10 end do
10975 return
10976 end subroutine
10979 subroutine graup ( nv,nv1,ib,pgwc,dz, tgr,wgr,wwgr )
10980 !c *********************************************************************
10981 !c tgr, wgr, and wwgr are the optical depth, single scattering albedo, &
10982 !c and expansion coefficients of the phase function ( 1, 2, 3, and 4 )
10983 !c due to the Mie scattering of graupel for a given layer.
10984 !c Jan. 19, 1993
10985 !c *********************************************************************
10986 !# include "para.file"
10987 USE PARA_FILE
10988 USE graup1
10989 implicit none
10990 integer :: nv, nv1
10991 real :: pgwc(nv), dz(nv)
10992 real :: tgr(nv), wgr(nv), wwgr(nv,4)
10993 integer :: ib, i
10994 real :: x1, x2, x3, x4, y1, y2, y3, y4
10995 x1 = gg(ib)
10996 x2 = x1 * gg(ib)
10997 x3 = x2 * gg(ib)
10998 x4 = x3 * gg(ib)
10999 y1 = 3.0 * x1
11000 y2 = 5.0 * x2
11001 y3 = 7.0 * x3
11002 y4 = 9.0 * x4
11003 do i = 1, nv
11004 if ( pgwc(i) .lt. 1.0e-5 ) then
11005 tgr(i) = 0.0
11006 wgr(i) = 0.0
11007 wwgr(i,1) = 0.0
11008 wwgr(i,2) = 0.0
11009 wwgr(i,3) = 0.0
11010 wwgr(i,4) = 0.0
11011 else
11012 tgr(i) = dz(i) * pgwc(i) * bg(ib) / gwc
11013 wgr(i) = wgf(ib)
11014 wwgr(i,1) = y1
11015 wwgr(i,2) = y2
11016 wwgr(i,3) = y3
11017 wwgr(i,4) = y4
11018 endif
11019 10 end do
11020 return
11021 end subroutine
11025 subroutine gascon ( nv,nv1,ib,tgm,pp,pt,ph,po )
11026 !c *********************************************************************
11027 !c tgm(nv) are the optical depthes due to water vapor continuum absorp-
11028 !c tion in nv layers for a given band ib. We include continuum absorp-
11029 !c tion in the 280 to 1250 cm**-1 region. vv(11)-vv(17) are the central
11030 !c wavenumbers of each band in this region.
11031 !c *********************************************************************
11032 !# include "para.file"
11033 USE PARA_FILE
11034 implicit none
11035 integer :: nv, nv1
11036 real, dimension(nv1) :: pp, pt, ph, po
11037 real :: tgm(nv)
11038 real :: vv(18) = (/ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
11039 0.0, 0.0, 1175.0, 1040.0, 890.0, 735.0, &
11040 & 605.0, 470.0, 340.0, 0.0 /)
11041 integer :: ib, i
11042 if ( ib .gt. 10 .and. ib .lt. 18 ) then
11043 call qopcon ( nv, nv1, vv(ib),tgm,pp,pt,ph,po )
11044 else
11045 do i = 1, nv
11046 tgm(i) = 0.0
11047 10 end do
11048 endif
11049 return
11050 end subroutine
11053 subroutine gases ( nv,nv1,ib,ig,hk,pp,pt,ph,po,tg )
11054 ! *********************************************************************
11055 ! tg(nv) are the optical depthes due to nongray gaseous absorption, in
11056 ! nv layers for a given band ib and cumulative probability ig.
11057 ! *********************************************************************
11058 USE PARA_FILE
11059 USE band, only: hk1=>hk_1,fk1o3=>fko3_1, &
11060 & hk2=>hk_2,c2h2o=>coeh2o_2, &
11061 & hk3=>hk_3,c3h2o=>coeh2o_3, &
11062 & hk4=>hk_4,c4h2o=>coeh2o_4, &
11063 & hk5=>hk_5,c5h2o=>coeh2o_5, &
11064 & hk6=>hk_6,c6h2o=>coeh2o_6, &
11065 & hk7=>hk_7,c7h2o=>coeh2o_7, &
11066 & hk8=>hk_8,c8h2o=>coeh2o_8, &
11067 & hk9=>hk_9,c9h2o=>coeh2o_9, &
11068 & hk10=>hk_10,c10h2o=>coeh2o_10, &
11069 & c10ch4=>coech4_10,c10n2o=>coen2o_10,&
11070 & hk11=>hk_11,c11h2o=>coeh2o_11, &
11071 & c11ch4=>coech4_11,c11n2o=>coen2o_11,&
11072 & hk12=>hk_12,c12o3=>coeo3_12, &
11073 & c12h2o=>coeh2o_12, &
11074 & hk13=>hk_13,c13h2o=>coeh2o_13, &
11075 & hk14=>hk_14,c14hca=>coehca_14, &
11076 & c14hcb=>coehcb_14, &
11077 & hk15=>hk_15,c15hca=>coehca_15, &
11078 & c15hcb=>coehcb_15, &
11079 & hk16=>hk_16,c16h2o=>coeh2o_16, &
11080 & hk17=>hk_17,c17h2o=>coeh2o_17, &
11081 & hk18=>hk_18,c18h2o=>coeh2o_18
11083 use control_para, only: umco2,umch4,umn2o,umo2, &
11084 & umno,umso2,umno2,umch3cl, &
11085 & umco,umCFC11,umCFC12, &
11086 & nco2s,nso2s,nch4s,nnol,no2s, &
11087 & nno2l,nso2l,nch3cll,ncos, &
11088 & nn2os,nh2ocs,nh2os,no3s, &
11089 & nh2ol,no3l,nco2l,nn2ol, &
11090 & nch4l,nCFC11l,nCFC12l
11091 implicit none
11092 integer :: nv, nv1
11093 real, dimension(nv1) :: pp, pt, ph, po
11094 real :: tg(nv)
11095 integer :: ib, ig
11096 real :: hk
11097 !!!!!!!!!!!!!!!!!c
11098 real, dimension(nv1) :: fkg, fkga, fkgb, pq
11099 real, dimension(nv) :: tg1, tg2, tg3
11100 real :: fk
11101 integer :: i
11103 select case(ib)
11104 case default
11105 stop
11106 !-------------------------------------
11107 case(1)
11108 1 fk = fk1o3(ig)
11109 call qopo3s ( nv,nv1,fk,tg,pp,pt,ph,po )
11110 hk = 619.618 * hk1(ig)
11111 ! In this band ( 50000 - 14500 cm**-1 ), we have considered the nongray
11112 ! gaseous absorption of O3. 619.618 is the solar energy contained in
11113 ! the band in units of Wm**-2.
11114 case(2)
11115 2 call qks ( nv,nv1,c2h2o(1,1,ig),fkg,pp,pt,ph,po )
11116 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11117 hk = 484.295 * hk2(ig)
11118 ! In this band ( 14500 - 7700 cm**-1 ), we have considered the nongray
11119 ! gaseous absorption of H2O. 484.295 is the solar energy contained in
11120 ! the band in units of Wm**-2.
11121 case(3)
11122 3 call qks ( nv,nv1,c3h2o(1,1,ig),fkg,pp,pt,ph,po )
11123 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11124 hk = 149.845 * hk3(ig)
11125 ! In this band ( 7700 - 5250 cm**-1 ), we have considered the nongray
11126 ! gaseous absorption of H2O. 149.845 is the solar energy contained in
11127 ! the band in units of Wm**-2.
11128 case(4)
11129 4 call qks ( nv,nv1,c4h2o(1,1,ig),fkg,pp,pt,ph,po )
11130 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11131 hk = 48.7302 * hk4(ig)
11132 ! In this band ( 5250 - 4000 cm**-1 ), we have considered the nongray
11133 ! gaseous absorption of H2O. 48.7302 is the solar energy contained in
11134 ! the band in units of Wm**-2.
11135 case(5)
11136 5 call qks ( nv,nv1,c5h2o(1,1,ig),fkg,pp,pt,ph,po )
11137 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11138 hk = 31.6576 * hk5(ig)
11139 ! In this band ( 4000 - 2850 cm**-1 ), we have considered the nongray
11140 ! gaseous absorption of H2O. 31.6576 is the solar energy contained in
11141 ! the band in units of Wm**-2.
11142 case(6)
11143 6 call qks ( nv,nv1,c6h2o(1,1,ig),fkg,pp,pt,ph,po )
11144 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11145 hk = 5.79927 * hk6(ig)
11146 ! In this band ( 2850 - 2500 cm**-1 ), we have considered the nongray
11147 ! gaseous absorption of H2O. 5.79927 is the solar energy contained in
11148 ! the band in units of Wm**-2.
11149 case(7)
11150 7 call qki ( nv,nv1,c7h2o(1,1,ig), fkg,pp,pt,ph,po )
11151 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11152 hk = hk7(ig)
11153 ! In this band ( 2200 - 1900 cm**-1 ), we have considered the nongray
11154 ! gaseous absorption of H2O.
11155 case(8)
11156 8 call qki ( nv,nv1,c8h2o(1,1,ig), fkg,pp,pt,ph,po )
11157 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11158 hk = hk8(ig)
11159 ! In this band ( 1900 - 1700 cm**-1 ), we have considered the nongray
11160 ! gaseous absorption of H2O.
11161 case(9)
11162 9 call qki ( nv,nv1,c9h2o(1,1,ig), fkg,pp,pt,ph,po )
11163 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11164 hk = hk9(ig)
11165 ! In this band ( 1700 - 1400 cm**-1 ), we have considered the nongray
11166 ! gaseous absorption of H2O.
11167 case(10)
11168 10 call qki ( nv,nv1,c10h2o(1,1,ig), fkg,pp,pt,ph,po )
11169 call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
11170 call qki ( nv,nv1,c10ch4, fkg,pp,pt,ph,po )
11171 call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
11172 call qki ( nv,nv1,c10n2o, fkg,pp,pt,ph,po )
11173 call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
11174 do i = 1, nv
11175 tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o
11176 205 end do
11177 hk = hk10(ig)
11178 ! In this band ( 1400 - 1250 cm**-1 ), we have considered the overlapping
11179 ! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
11180 case(11)
11181 11 call qki ( nv,nv1,c11h2o(1,1,ig), fkg,pp,pt,ph,po )
11182 call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
11183 call qki ( nv,nv1,c11ch4, fkg,pp,pt,ph,po )
11184 call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
11185 call qki ( nv,nv1,c11n2o, fkg,pp,pt,ph,po )
11186 call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
11187 do i = 1, nv
11188 tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o
11189 215 end do
11190 hk = hk11(ig)
11191 ! In this band ( 1250 - 1100 cm**-1 ), we have considered the overlapping
11192 ! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
11193 case(12)
11194 12 call qkio3 ( nv,nv1,c12o3(1,1,ig), fkg,pp,pt,ph,po )
11195 call qopo3i ( nv,nv1,fkg, tg1,pp,pt,ph,po )
11196 call qki ( nv,nv1,c12h2o, fkg,pp,pt,ph,po )
11197 call qoph2o ( nv,nv1,fkg, tg2,pp,pt,ph,po )
11198 do i = 1, nv
11199 tg(i) = tg1(i) + tg2(i)
11200 225 end do
11201 hk = hk12(ig)
11202 ! In this band ( 1100 - 980 cm**-1 ), we have considered the overlapping
11203 ! absorption of H2O and O3 by approach one of Fu(1991).
11204 case(13)
11205 13 call qki ( nv,nv1,c13h2o(1,1,ig), fkg,pp,pt,ph,po )
11206 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11207 hk = hk13(ig)
11208 ! In this band ( 980 - 800 cm**-1 ), we have considered the nongray
11209 ! gaseous absorption of H2O.
11210 case(14)
11211 14 do i = 1, nv1
11212 if ( pp(i) .ge. 63.1 ) then
11213 pq(i) = ph(i)
11214 else
11215 pq(i) = 0.0
11216 endif
11217 333 end do
11218 call qki ( nv,nv1,c14hca(1,1,ig), fkga,pp,pt,ph,po )
11219 call qki ( nv,nv1,c14hcb(1,1,ig), fkgb,pp,pt,ph,po )
11220 do i = 1, nv1
11221 fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
11222 343 end do
11223 call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
11224 hk = hk14(ig)
11225 ! In this band ( 800 - 670 cm**-1), we have considered the overlapping
11226 ! absorption of H2O and CO2 by approach two of Fu(1991).
11227 case(15)
11228 15 do i = 1, nv1
11229 if ( pp(i) .ge. 63.1 ) then
11230 pq(i) = ph(i)
11231 else
11232 pq(i) = 0.0
11233 endif
11234 353 end do
11235 call qki ( nv,nv1,c15hca(1,1,ig), fkga,pp,pt,ph,po )
11236 call qki ( nv,nv1,c15hcb(1,1,ig), fkgb,pp,pt,ph,po )
11237 do i = 1, nv1
11238 fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
11239 363 end do
11240 call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
11241 hk = hk15(ig)
11242 ! In this band ( 670 - 540 cm**-1), we have considered the overlapping
11243 ! absorption of H2O and CO2 by approach two of Fu(1991).
11244 case(16)
11245 16 call qki ( nv,nv1,c16h2o(1,1,ig), fkg,pp,pt,ph,po )
11246 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11247 hk = hk16(ig)
11248 ! In this band ( 540 - 400 cm**-1 ), we have considered the nongray
11249 ! gaseous absorption of H2O.
11250 case(17)
11251 17 call qki ( nv,nv1,c17h2o(1,1,ig), fkg,pp,pt,ph,po )
11252 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11253 hk = hk17(ig)
11254 ! In this band ( 400 - 280 cm**-1 ), we have considered the nongray
11255 ! gaseous absorption of H2O.
11256 case(18)
11257 18 call qki ( nv,nv1,c18h2o(1,1,ig), fkg,pp,pt,ph,po )
11258 call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11259 hk = hk18(ig)
11260 ! In this band ( 280 - 000 cm**-1 ), we have considered the nongray
11261 ! gaseous absorption of H2O.
11262 end select
11263 return
11264 end subroutine
11267 subroutine qks ( nv,nv1,coefks,fkg,pp,pt,ph,po )
11268 !c *********************************************************************
11269 !c fkg(nv1) are the gaseous absorption coefficients in units of (cm-atm)
11270 !c **-1 for a given cumulative probability in nv1 layers. coefks(3,11)
11271 !c are the coefficients to calculate the absorption coefficient at the
11272 !c temperature t for the 11 pressures by
11273 !c ln k = a + b * ( t - 245 ) + c * ( t - 245 ) ** 2
11274 !c and the absorption coefficient at conditions other than those eleven
11275 !c pressures is interpolated linearly with pressure (Fu, 1991).
11276 !c *********************************************************************
11277 !# include "para.file"
11278 USE PARA_FILE
11279 implicit none
11280 integer :: nv, nv1
11281 real, dimension(nv1) :: pp, pt, ph, po, fkg
11282 real :: coefks(3,11)
11283 real :: stanp(11) = (/ 10.0, 15.8, 25.1, 39.8, 63.1, 100.0, &
11284 & 158.0, 251.0, 398.0, 631.0, 1000.0 /)
11285 integer :: i1, i
11286 real :: x1, x2, y1
11288 i1 = 1
11289 do i = 1, nv1
11290 if ( pp(i) .lt. stanp(1) ) then
11291 x1 = exp ( coefks(1,1) + coefks(2,1) * ( pt(i) - 245.0 ) &
11292 & + coefks(3,1) * ( pt(i) - 245.0 ) ** 2 )
11293 fkg(i) = x1 * pp(i) / stanp(1)
11294 elseif ( pp(i) .ge. stanp(11) ) then
11295 y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
11296 x1 = exp ( coefks(1,10) + coefks(2,10) * ( pt(i) - 245.0 ) &
11297 & + coefks(3,10) * y1 )
11298 x2 = exp ( coefks(1,11) + coefks(2,11) * ( pt(i) - 245.0 ) &
11299 & + coefks(3,11) * y1 )
11300 fkg(i) = x1 + ( x2 - x1 ) / ( stanp(11) - stanp(10) ) &
11301 & * ( pp(i) - stanp(10) )
11302 else
11304 do while ( pp(i) .ge. stanp(i1) )
11305 i1 = i1 + 1
11306 end do
11307 y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
11308 x1 = exp ( coefks(1,i1-1) + coefks(2,i1-1) * (pt(i)-245.0) &
11309 & + coefks(3,i1-1) * y1 )
11310 x2 = exp ( coefks(1,i1) + coefks(2,i1) * ( pt(i) - 245.0 ) &
11311 & + coefks(3,i1) * y1 )
11312 fkg(i) = x1 + ( x2 - x1 ) / ( stanp(i1) - stanp(i1-1) ) &
11313 & * ( pp(i) - stanp(i1-1) )
11314 endif
11315 end do
11316 return
11317 end subroutine
11319 subroutine qki ( nv,nv1,coefki, fkg,pp,pt,ph,po )
11320 !c *********************************************************************
11321 !c fkg(nv1) are the gaseous absorption coefficients in units of (cm-atm)
11322 !c **-1 for a given cumulative probability in nv1 layers. coefki(3,19)
11323 !c are the coefficients to calculate the absorption coefficient at the
11324 !c temperature t for the 19 pressures by
11325 !c ln k = a + b * ( t - 245 ) + c * ( t - 245 ) ** 2
11326 !c and the absorption coefficient at conditions other than those 19
11327 !c pressures is interpolated linearly with pressure (Fu, 1991).
11328 !c *********************************************************************
11329 !# include "para.file"
11330 USE PARA_FILE
11331 implicit none
11332 integer :: nv, nv1
11333 real, dimension(nv1) :: pp, pt, ph, po, fkg
11334 real :: coefki(3,19)
11335 integer :: i, i1
11336 real :: x1, x2, y1
11337 real :: stanp(19) = (/ 0.251, 0.398, 0.631, 1.000, 1.58, 2.51, &
11338 & 3.98, 6.31, 10.0, 15.8, 25.1, 39.8, 63.1, &
11339 & 100.0, 158.0, 251.0, 398.0, 631.0, 1000.0 /)
11341 i1 = 1
11342 do i = 1, nv1
11343 ! -test
11344 if (pt(i).gt.345.) then
11345 pt(i) = 345.
11346 endif
11347 if (pt(i).lt.180.) then
11348 pt(i) = 180.
11349 endif
11350 ! -test over
11351 if ( pp(i) .lt. stanp(1) ) then
11352 x1 = exp ( coefki(1,1) + coefki(2,1) * ( pt(i) - 245.0 ) &
11353 & + coefki(3,1) * ( pt(i) - 245.0 ) ** 2 )
11354 fkg(i) = x1 * pp(i) / stanp(1)
11355 elseif ( pp(i) .ge. stanp(19) ) then
11356 y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
11357 x1 = exp ( coefki(1,18) + coefki(2,18) * ( pt(i) - 245.0 ) &
11358 & + coefki(3,18) * y1 )
11359 x2 = exp ( coefki(1,19) + coefki(2,19) * ( pt(i) - 245.0 ) &
11360 & + coefki(3,19) * y1 )
11361 fkg(i) = x1 + ( x2 - x1 ) / ( stanp(19) - stanp(18) ) &
11362 & * ( pp(i) - stanp(18) )
11363 else
11364 do while ( pp(i) .ge. stanp(i1) )
11365 i1 = i1 + 1
11366 end do
11367 y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
11368 x1 = exp ( coefki(1,i1-1) + coefki(2,i1-1) * (pt(i)-245.0) &
11369 & + coefki(3,i1-1) * y1 )
11370 x2 = exp ( coefki(1,i1) + coefki(2,i1) * ( pt(i) - 245.0 ) &
11371 & + coefki(3,i1) * y1 )
11372 fkg(i) = x1 + ( x2 - x1 ) / ( stanp(i1) - stanp(i1-1) ) &
11373 & * ( pp(i) - stanp(i1-1) )
11374 endif
11375 end do
11376 return
11377 end subroutine
11379 subroutine qkio3 ( nv,nv1,coefki, fkg,pp,pt,ph,po )
11380 !c *********************************************************************
11381 !c fkg(nv1) are the gaseous absorption coefficients in units of (cm-atm)
11382 !c **-1 for a given cumulative probability in nv1 layers. coefki(3,19)
11383 !c are the coefficients to calculate the absorption coefficient at the
11384 !c temperature t for the 19 pressures by
11385 !c ln k = a + b * ( t - 250 ) + c * ( t - 250 ) ** 2
11386 !c and the absorption coefficient at conditions other than those 19
11387 !c pressures is interpolated linearly with pressure (Fu, 1991).
11388 !c *********************************************************************
11389 !# include "para.file"
11390 USE PARA_FILE
11391 implicit none
11392 integer :: nv, nv1
11393 real, dimension(nv1) :: pp, pt, ph, po
11394 real :: coefki(3,19), fkg(nv1)
11395 integer :: i, i1
11396 real :: x1, x2, y1
11397 real :: stanp(19) = (/0.251, 0.398, 0.631, 1.000, 1.58, 2.51, &
11398 & 3.98, 6.31, 10.0, 15.8, 25.1, 39.8, 63.1, &
11399 & 100.0, 158.0, 251.0, 398.0, 631.0, 1000.0/)
11401 i1 = 1
11402 do i = 1, nv1
11403 if ( pp(i) .lt. stanp(1) ) then
11404 x1 = exp ( coefki(1,1) + coefki(2,1) * ( pt(i) - 250.0 ) &
11405 & + coefki(3,1) * ( pt(i) - 250.0 ) ** 2 )
11406 fkg(i) = x1 * pp(i) / stanp(1)
11407 elseif ( pp(i) .ge. stanp(19) ) then
11408 y1 = ( pt(i) - 250.0 ) * ( pt(i) - 250.0 )
11409 x1 = exp ( coefki(1,18) + coefki(2,18) * ( pt(i) - 250.0 ) &
11410 & + coefki(3,18) * y1 )
11411 x2 = exp ( coefki(1,19) + coefki(2,19) * ( pt(i) - 250.0 ) &
11412 & + coefki(3,19) * y1 )
11413 fkg(i) = x1 + ( x2 - x1 ) / ( stanp(19) - stanp(18) ) &
11414 & * ( pp(i) - stanp(18) )
11415 else
11416 do while ( pp(i) .ge. stanp(i1) )
11417 i1 = i1 + 1
11418 end do
11419 y1 = ( pt(i) - 250.0 ) * ( pt(i) - 250.0 )
11420 x1 = exp ( coefki(1,i1-1) + coefki(2,i1-1) * (pt(i)-250.0) &
11421 & + coefki(3,i1-1) * y1 )
11422 x2 = exp ( coefki(1,i1) + coefki(2,i1) * ( pt(i) - 250.0 ) &
11423 & + coefki(3,i1) * y1 )
11424 fkg(i) = x1 + ( x2 - x1 ) / ( stanp(i1) - stanp(i1-1) ) &
11425 & * ( pp(i) - stanp(i1-1) )
11426 end if
11427 5 end do
11428 return
11429 end subroutine
11431 !---------------------------------------------------
11432 subroutine qopo3s ( nv,nv1,fk,tg,pp,pt,ph,po )
11433 !# include "para.file"
11434 USE PARA_FILE
11435 implicit none
11436 integer :: nv, nv1
11437 real, dimension(nv1) :: pp, pt, ph, po
11438 real, dimension(nv) :: tg
11439 real :: fk, fq
11440 integer :: i
11441 fq = 238.08 * fk
11442 do i = 1, nv
11443 tg(i) = ( po(i) + po(i+1) ) * ( pp(i+1) - pp(i) ) * fq
11444 10 end do
11445 ! do 20 i = 1, nv
11446 ! tg(i) = tg(i) * 476.16 * fk
11447 !20 continue
11448 ! 476.16 = 2.24e4 / M * 10.0 / 9.8, where M = 48 for O3.?
11449 return
11450 end subroutine
11452 !----------------------------------------------------
11453 subroutine qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11454 !# include "para.file"
11455 USE PARA_FILE
11456 implicit none
11457 integer :: nv, nv1
11458 real, dimension(nv1) :: pp, pt, ph, po
11459 real :: fkg(nv1), tg(nv)
11460 integer :: i
11462 do i = 1, nv
11463 tg(i) = ( fkg(i) * ph(i) + fkg(i+1) * ph(i+1) ) &
11464 & * ( pp(i+1) - pp(i) ) * 634.9205
11465 10 end do
11466 ! do 20 i = 1, nv
11467 ! tg(i) = tg(i) * 1269.841
11468 !20 continue
11469 ! 1269.841 = 2.24e4 / M * 10.0 / 9.8, where M = 18 for H2O.
11470 return
11471 end subroutine
11473 !-----------------------------------------------------
11475 subroutine qopch4 ( nv,nv1,fkg, tg,pp,pt,ph,po )
11476 !# include "para.file"
11477 USE PARA_FILE
11478 implicit none
11479 integer :: nv, nv1
11480 real, dimension(nv1) :: pp, pt, ph, po
11481 real :: fkg(nv1), tg(nv)
11482 integer :: i
11484 do i = 1, nv
11485 tg(i) = ( fkg(i)+fkg(i+1) ) *( pp(i+1)-pp(i) )* 6.3119e-4
11486 10 end do
11487 ! do 20 i = 1, nv
11488 ! tg(i) = tg(i) * 1.26238e-3
11489 !20 continue
11490 ! 1.26238e-3 = 2.24e4 / M * 10.0 / 9.8 * 1.6e-6 * M / 28.97, where
11491 ! M = 16 for CH4.
11492 return
11493 end subroutine
11495 !-------------------------------------------------------
11497 subroutine qopn2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
11498 !# include "para.file"
11499 USE PARA_FILE
11500 implicit none
11501 integer :: nv, nv1
11502 real, dimension(nv1) :: pp, pt, ph, po
11503 real :: fkg(nv1), tg(nv)
11504 integer :: i
11506 do i = 1, nv
11507 tg(i) = ( fkg(i)+fkg(i+1) ) * (pp(i+1)-pp(i))*1.10459e-4
11508 10 end do
11509 ! do 20 i = 1, nv
11510 ! tg(i) = tg(i) * 2.20918e-4
11511 !20 continue
11512 ! 2.20918e-4 = 2.24e4 / M * 10.0 / 9.8 * 0.28e-6 * M / 28.97, where
11513 ! M = 44 for N2O.
11514 return
11515 end subroutine
11517 !--------------------------------------------------------
11519 subroutine qopo3i ( nv,nv1,fkg, tg,pp,pt,ph,po )
11520 !# include "para.file"
11521 USE PARA_FILE
11522 implicit none
11523 integer :: nv, nv1
11524 real, dimension(nv1) :: pp, pt, ph, po
11525 real :: fkg(nv1), tg(nv)
11526 integer :: i
11528 do i = 1, nv
11529 tg(i) = ( fkg(i) * po(i) + fkg(i+1) * po(i+1) ) &
11530 & * ( pp(i+1) - pp(i) ) * 238.08
11531 10 end do
11532 ! do 20 i = 1, nv
11533 ! tg(i) = tg(i) * 476.16
11534 !20 continue
11535 return
11536 end subroutine
11538 !----------------------------------------------
11540 subroutine qophc ( nv,nv1,fkg, tg,pp,pt,ph,po )
11541 !# include "para.file"
11542 USE PARA_FILE
11543 implicit none
11544 integer :: nv, nv1
11545 real, dimension(nv1) :: pp, pt, ph, po
11546 real :: fkg(nv1), tg(nv)
11547 integer :: i
11549 do i = 1, nv
11550 tg(i) = ( fkg(i) + fkg(i+1) ) * ( pp(i+1) - pp(i) ) * 0.5
11551 10 end do
11552 ! See page 86 of Fu (1991).
11553 return
11554 end subroutine
11556 !----------------------------------------------
11558 subroutine qopcon ( nv,nv1,vv,tg,pp,pt,ph,po )
11559 !# include "para.file"
11560 USE PARA_FILE
11561 implicit none
11562 integer :: nv, nv1
11563 real, dimension(nv1) :: pp, pt, ph, po, &
11564 & ff, pe
11565 real :: vv, tg(nv)
11566 real :: x, y, z, r, s, w
11567 integer :: i
11569 x = 4.18
11570 y = 5577.8
11571 z = 0.00787
11572 r = 0.002
11573 s = ( x + y * exp ( - z * vv ) ) / 1013.25
11574 do i = 1, nv1
11575 pe(i) = pp(i) * ph(i) / ( 0.622 + 0.378 * ph(i) )
11576 w = exp ( 1800.0 / pt(i) - 6.08108 )
11577 ff(i) = s * ( pe(i) + r * pp(i) ) * w
11578 end do
11579 do i = 1, nv
11580 tg(i) = ( ff(i) * ph(i) + ff(i+1) * ph(i+1) )* &
11581 & ( pp(i+1) - pp(i) ) * 0.5098835
11582 end do
11583 ! do 7 i = 1, nv
11584 ! tg(i) = tg(i) * 10.0 / 9.80616
11585 !7 continue
11586 return
11587 end subroutine
11588 !c function fk ( v, e, p, t )
11589 !c The units of fk is cm**2/g. See Eq. (A.19) of Fu (1991).
11590 !c x = 4.18
11591 !c y = 5577.8
11592 !c z = 0.00787
11593 !c r = 0.002
11594 !c w = exp ( 1800.0 / t - 6.08108 )
11595 !c fk = ( x + y * exp ( -z * v ) ) * ( e + r * p ) * w / 1013.25
11596 !c return
11597 !c end
11599 !C--- add for new gases
11601 !-------------------------------------------------------------
11602 subroutine qopo2 ( nv,nv1,fkg, tg,pp,pt,ph,po )
11603 !# include "para.file"
11604 USE PARA_FILE
11605 implicit none
11606 integer :: nv, nv1
11607 real, dimension(nv1) :: pp, pt, ph, po
11608 real :: fkg(nv1), tg(nv)
11609 integer :: i
11610 real :: am=32
11611 do i = 1, nv
11612 tg(i) = 0.5*(fkg(i)+fkg(i+1)) *(pp(i+1)-pp(i)) * &
11613 & 2.24e4/aM*10.0/9.8*2.0948E+05*1.0e-6*aM/28.97
11614 10 end do
11615 return
11616 end subroutine
11618 !-------------------------------------------------------------
11620 subroutine qopco2 ( nv,nv1,fkg, tg,pp,pt,ph,po )
11621 !# include "para.file"
11622 USE PARA_FILE
11623 implicit none
11624 integer :: nv, nv1
11625 real, dimension(nv1) :: pp, pt, ph, po
11626 real :: fkg(nv1), tg(nv)
11627 integer :: i
11628 real :: am=44
11629 do i = 1, nv
11630 tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
11631 & 2.24e4 / aM * 10.0 / 9.8 * 330.0 *1.0e-6* aM / 28.97
11632 10 end do
11633 ! 2.24e4 / M * 10.0 / 9.8 * 330.0 * M / 28.97, where
11634 ! M = 44 for CO2.
11635 return
11636 end subroutine
11638 !---------------------------------------------------------------
11640 subroutine qopco ( nv,nv1,fkg, tg,pp,pt,ph,po )
11641 !# include "para.file"
11642 USE PARA_FILE
11643 implicit none
11644 integer :: nv, nv1
11645 real, dimension(nv1) :: pp, pt, ph, po
11646 real :: fkg(nv1), tg(nv)
11647 integer :: i
11648 real :: am=28
11649 do i = 1, nv
11650 tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
11651 & 2.24e4 / aM * 10.0 / 9.8 * 0.16 *1.0e-6* aM / 28.97
11652 10 end do
11653 return
11654 end subroutine
11656 !----------------------------------------------------------------------
11658 subroutine qopno ( nv,nv1,fkg, tg,pp,pt,ph,po )
11659 !# include "para.file"
11660 USE PARA_FILE
11661 implicit none
11662 integer :: nv, nv1
11663 real, dimension(nv1) :: pp, pt, ph, po
11664 real :: fkg(nv1), tg(nv)
11665 integer :: i
11666 real :: am=30
11667 do i = 1, nv
11668 tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
11669 & 2.24e4 / aM * 10.0 / 9.8 * 0.0005 *1.0e-6* aM / 28.97
11670 10 end do
11671 return
11672 end subroutine
11674 !----------------------------------------------------------------------
11676 subroutine qopch3cl ( nv,nv1,fkg, tg,pp,pt,ph,po )
11677 !# include "para.file"
11678 USE PARA_FILE
11679 implicit none
11680 integer :: nv, nv1
11681 real, dimension(nv1) :: pp, pt, ph, po
11682 real :: fkg(nv1), tg(nv)
11683 integer :: i
11684 real :: am=50.5
11685 do i = 1, nv
11686 tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
11687 & 2.24e4 / aM * 10.0 / 9.8 * 0.5e-3 *1.0e-6* aM / 28.97
11688 10 end do
11689 return
11690 end subroutine
11692 !-----------------------------------------------------------------------
11694 subroutine qopso2 ( nv,nv1,fkg, tg,pp,pt,ph,po )
11695 !# include "para.file"
11696 USE PARA_FILE
11697 implicit none
11698 integer :: nv, nv1
11699 real, dimension(nv1) :: pp, pt, ph, po
11700 real :: fkg(nv1), tg(nv)
11701 integer :: i
11702 real :: am=64
11703 do i = 1, nv
11704 tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
11705 & 2.24e4 / aM * 10.0 / 9.8 * 0.001 *1.0e-6* aM / 28.97
11706 10 end do
11707 return
11708 end subroutine
11709 !ccc- change for new gases over
11711 !---------------------------------------------------------------
11713 !! add CFC begin: 2007.06 Yue
11714 subroutine qopCFC11 ( nv,nv1,coefCFC, tg,pp,pt,ph,po )
11715 use PARA_FILE
11716 implicit none
11717 integer :: nv, nv1
11718 real, dimension(nv1) :: pp, pt, ph, po
11719 real :: coefCFC, fkg(nv1), tg(nv)
11720 integer :: i
11721 real :: aM=137.3684
11722 do i = 1,nv1
11723 fkg(i) = coefCFC
11724 enddo
11725 do i = 1, nv
11726 tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
11727 & 2.24e4/aM*10.0/9.8*0.22e-3*1.0e-6*aM/28.97
11728 10 end do
11729 return
11730 end subroutine
11732 !----------------------------------------------------------------
11734 subroutine qopCFC12 ( nv,nv1,coefCFC, tg,pp,pt,ph,po )
11735 use PARA_FILE
11736 implicit none
11737 integer :: nv, nv1
11738 real, dimension(nv1) :: pp, pt, ph, po
11739 real :: coefCFC, fkg(nv1), tg(nv)
11740 integer :: i
11741 real :: aM=120.9138
11742 do i = 1,nv1
11743 fkg(i) = coefCFC
11744 enddo
11745 do i = 1, nv
11746 tg(i) = 0.5* ( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
11747 & 2.24e4/aM*10.0/9.8*0.375e-3*1.0e-6*aM/28.97
11748 10 end do
11749 return
11750 end subroutine
11751 !! CFC add end
11754 !! -- with aerosol & partly cloudy
11755 ! subroutine comscp_aero( ti,wi,wwi,tw,ww,www, &
11756 ! & trn,wrn,wwrn,tgr,wgr,wwgr, &
11757 ! & tr,wr,wwr,tgm,tg,tae,wae,wwae, &
11758 ! & wc1,wc2,wc3,wc4,wc,tt &
11759 ! & )
11760 !!c *********************************************************************
11761 !!c This subroutine is used to COMbine Single-Scattering Properties due
11762 !!c to ice crystals, water droplets, and Rayleigh molecules along with
11763 !!c H2O continuum absorption and nongray gaseous absorption. See Section
11764 !!c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
11765 !!c single - scattering albedo, and expansion coefficients of the
11766 !!c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
11767 !!c optical depth ( from the top of the atmosphere to a given level ) for
11768 !!c level 2 - level nv1( surface ). The single-scattering properties of
11769 !!c rain and graupel are also incorporated in ( Jan. 19, 1993 ).
11770 !!c *********************************************************************
11771 !!c The single-scattering properties of aerosols are incorporated in
11772 !!c (10/29/96) based on earlier version (5/17/95).
11773 !!c *********************************************************************
11774 !!# include "para.file"
11775 ! USE PARA_FILE
11776 ! USE control_para
11777 !
11778 ! common /ic/ ti(nv), wi(nv), wwi(nv,4)
11779 ! common /wat/ tw(nv), ww(nv), www(nv,4)
11780 ! common /rai/ trn(nv), wrn(nv), wwrn(nv,4)
11781 ! common /gra/ tgr(nv), wgr(nv), wwgr(nv,4)
11782 ! common /ray/ tr(nv), wr(nv), wwr(nv,4)
11783 ! common /con/ tgm(nv)
11784 ! common /gas/ tg(nv)
11785 !!C--- add by Yu for fractional cloud
11786 ! common /dfsin_2/ wc1_2(nv,2), wc2_2(nv,2), wc3_2(nv,2), &
11787 ! wc4_2(nv,2), &
11788 ! wc_2(nv,2), tt_2(nv,2)
11789 ! common /delta_tao/ tc_2(nv,2)
11790 !!c-- change over
11791 ! common /dfsin/ wc1(nv), wc2(nv), wc3(nv), wc4(nv), &
11792 ! wc(nv), tt(nv)
11793 !!C--- change by Yu, 02/13/02
11794 !!c common /cld_a/cldamnt(nv), area_h(2), area_m(2), area_l(2)
11795 !!c common /cld_c/n_h, n_m, n_l, cld_h, cld_m, cld_l
11796 ! common /cld_a/cldamnt(nv), area_group(3,2)
11797 ! common /cld_inho/cc_inho(nv)
11798 ! common /cld_c/n_group(3), cld_group(3)
11799 ! common /cld_loop/ nb(3)
11800 !!c-- change over
11801 !
11802 !!C-- added by Yu Gu 11/2006 to add control parameter
11803 ! common /nctrl/ naero, nfract, nice,ngas
11804 !
11805 !!C-- change by Yu Gu 01/2003 to add aerosol
11806 !!c---------- 10/29/96 (4)
11807 ! real tae,wae,wwae,taes(0:4)
11808 ! common /aer/ tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
11809 ! common /aero_ctrl/ ifg, ivd, itp, nac, iaform, n_atau
11810 !!c---------- 10/29/96 (4)
11811 !!C-- change over for aerosol
11812 !
11813 ! dimension tc(nv)
11814 !
11815 !!c--- change by Yu, 02/13/02
11816 !!c--- change by Yu, 02/13/02
11817 !
11818 !!c-- define inhomogeneity factor
11819 !!c c_inho = 0.7
11820 !!c--- test 0.8
11821 !!c c_inho = 0.8
11822 !
11823 !!c--- determine n_group(k), cld_group(k), and area_group(k,1), area_group(k,2)
11824 !!c--- hight,middle, and low three cloud groups
11825 ! do k=1,ngroup
11826 !!c do k=1,3
11827 !
11828 ! kl = (k-1)*nsubcld + nv1 - nclouds
11829 !!c kl = (k-1)*3 + 7
11830 ! cld_group(k) = cldamnt(kl)
11831 ! do i=kl+1,kl+nsubcld-1
11832 !!c do i=kl+1,kl+2
11833 ! if (cldamnt(i).gt.cld_group(k)) then
11834 ! cld_group(k) = cldamnt(i)
11835 ! endif
11836 ! enddo
11837 !!c-- partly cloudy
11838 ! if (cld_group(k).gt.0.0.and.cld_group(k).lt.1.) then
11839 ! n_group(k) = 2
11840 ! nb(k) = 1
11841 ! area_group(k,1) = 1. - cld_group(k)
11842 ! area_group(k,2) = cld_group(k)
11843 !!c-- clear
11844 ! elseif(cld_group(k).eq.0.0) then
11845 ! n_group(k) = 1
11846 ! nb(k) = 1
11847 ! area_group(k,1) = 1.
11848 ! area_group(k,2) = 0.
11849 !!c-- overcast
11850 ! elseif(cld_group(k).eq.1.) then
11851 ! n_group(k) = 2
11852 ! nb(k) = 2
11853 ! area_group(k,1) = 0.
11854 ! area_group(k,2) = 1.
11855 ! endif
11856 !
11857 ! enddo
11858 !!c--- change over
11859 !
11860 ! do 10 i = 1, nv
11861 !!c-- add by Yu for clear
11862 ! tc_2(i,1) = tr(i) + tgm(i) + tg(i) + &
11863 ! trn(i) + tgr(i)
11864 !
11865 !!C-- add by Yu Gu for aerosol under clear(01/2003)
11866 !!C
11867 ! if (naero.ge.1) then
11868 ! do iac = 1,nac
11869 ! tc_2(i,1) = tc_2(i,1) + tae(i,iac)
11870 ! enddo
11871 ! endif
11872 !!c---------- 10/29/96 (5)
11873 !!C --- change over
11874 !
11875 !!c-- change by Yu for overcast
11876 !!c--- adjust tau according to cloud amount
11877 ! if (cldamnt(i).gt. 0.) then
11878 !!c n_cld = (i-4)/3
11879 ! n_cld = (i-(nv1-nclouds))/nsubcld+1
11880 ! if (n_cld.gt.0) then
11881 !!C--- determine adjust parameter
11882 ! fcloud = cldamnt(i) / cld_group(n_cld)
11883 ! if (fcloud.le.0.1) then
11884 ! if (ti(i).le.15.) then
11885 ! adj_pari = fcloud - fcloud * 0.5 * ti(i) / 15.
11886 ! else
11887 ! adj_pari = 0.5 * fcloud
11888 ! endif
11889 ! if (tw(i).le.15.) then
11890 ! adj_parw = fcloud - fcloud * 0.5 * tw(i) / 15.
11891 ! else
11892 ! adj_parw = 0.5 * fcloud
11893 ! endif
11894 ! endif
11895 !
11896 ! if (fcloud.le.0.3.and.fcloud.gt.0.1) then
11897 ! if (ti(i).le.15.) then
11898 ! adj_pari = fcloud - fcloud * 0.33 * ti(i) / 15.
11899 ! else
11900 ! adj_pari = 0.67 * fcloud
11901 ! endif
11902 ! if (tw(i).le.15.) then
11903 ! adj_parw = fcloud - fcloud * 0.33 * tw(i) / 15.
11904 ! else
11905 ! adj_parw = 0.67 * fcloud
11906 ! endif
11907 ! endif
11908 !
11909 ! if (fcloud.le.0.5.and.fcloud.gt.0.3) then
11910 ! if (ti(i).le.15.) then
11911 ! adj_pari = fcloud - fcloud * 0.4 * ti(i) / 15.
11912 ! else
11913 ! adj_pari = 0.6 * fcloud
11914 ! endif
11915 ! if (tw(i).le.15.) then
11916 ! adj_parw = fcloud - fcloud * 0.4 * tw(i) / 15.
11917 ! else
11918 ! adj_parw = 0.6 * fcloud
11919 ! endif
11920 ! endif
11921 !
11922 ! if (fcloud.le.0.7.and.fcloud.gt.0.5) then
11923 ! if (ti(i).le.15.) then
11924 ! adj_pari = fcloud - fcloud * 0.286 * ti(i) / 15.
11925 ! else
11926 ! adj_pari = 0.714 * fcloud
11927 ! endif
11928 ! if (tw(i).le.15.) then
11929 ! adj_parw = fcloud - fcloud * 0.286 * tw(i) / 15.
11930 ! else
11931 ! adj_parw = 0.714 * fcloud
11932 ! endif
11933 ! endif
11934 !
11935 ! if (fcloud.le.0.9.and.fcloud.gt.0.7) then
11936 ! if (ti(i).le.15.) then
11937 ! adj_pari = fcloud - fcloud * 0.11 * ti(i) / 15.
11938 ! else
11939 ! adj_pari = 0.89 * fcloud
11940 ! endif
11941 ! if (tw(i).le.15.) then
11942 ! adj_parw = fcloud - fcloud * 0.11 * tw(i) / 15.
11943 ! else
11944 ! adj_parw = 0.89 * fcloud
11945 ! endif
11946 !
11947 ! endif
11948 !
11949 ! if (fcloud.le.1..and.fcloud.gt.0.9) then
11950 ! adj_pari = fcloud
11951 ! adj_parw = fcloud
11952 ! endif
11953 !
11954 ! if (ti(i).gt.0.) &
11955 ! ti(i) = ti(i) * adj_pari &
11956 ! * cc_inho(i)
11957 !!c & * c_inho
11958 !!C-- above: change by Yu: to include the inhomogeneity effect
11959 !
11960 !!c & ti(i) = ti(i) * cldamnt(i)
11961 !!c & / cld_group(n_cld)
11962 ! if (tw(i).gt.0.) &
11963 ! tw(i) = tw(i) * adj_parw &
11964 ! * cc_inho(i)
11965 !!c & * c_inho
11966 !!C-- above: change by Yu: to include the inhomogeneity effect
11967 !
11968 !!c & tw(i) = tw(i) * cldamnt(i)
11969 !!c & / cld_group(n_cld)
11970 ! endif
11971 ! endif
11972 !!c-- adjust over
11973 ! tc_2(i,2) = ti(i) + tw(i) + tr(i) + tgm(i) + tg(i) + &
11974 ! trn(i) + tgr(i)
11975 !
11976 !!C-- add by Yu Gu for aerosol (01/2003)
11977 !!C
11978 ! if (naero.ge.1) then
11979 ! do iac = 1,nac
11980 ! tc_2(i,2) = tc_2(i,2) + tae(i,iac)
11981 ! enddo
11982 ! endif
11983 !
11984 !!c---------- 10/29/96 (5)
11985 !!C --- change over
11986 !
11987 !!c print *, 'i=',i,' tc=', tc_2(i,2)
11988 ! tis = ti(i) * wi(i)
11989 ! tws = tw(i) * ww(i)
11990 ! trns = trn(i) * wrn(i)
11991 ! tgrs = tgr(i) * wgr(i)
11992 !!c fw1 = tr(i) + trns + tgrs
11993 !!c fw2 = tis + tws + tr(i) + trns + tgrs
11994 !
11995 !!C--- add by Yu Gu (01/2003) for aerosol
11996 !
11997 !!c---------- 10/29/96 (6)
11998 ! if(naero.ge.1) then
11999 ! taes(0:4) = 0.0
12000 ! do iac = 1,nac
12001 ! taes(0)=taes(0)+tae(i,iac)*wae(i,iac)
12002 ! do j=1,4
12003 ! taes(j)=taes(j)+tae(i,iac)*wae(i,iac)*wwae(i,j,iac)
12004 ! enddo
12005 ! enddo
12006 !
12007 ! fw1 = tr(i) + trns + tgrs + taes(0)
12008 ! fw2 = tis + tws + tr(i) + trns + tgrs + taes(0)
12009 !
12010 ! else
12011 ! fw1 = tr(i) + trns + tgrs
12012 ! fw2 = tis + tws + tr(i) + trns + tgrs
12013 ! end if
12014 !
12015 !!c---------- 10/29/96 (6)
12016 !
12017 ! wc_2(i,1) = fw1 / tc_2(i,1)
12018 ! wc_2(i,2) = fw2 / tc_2(i,2)
12019 !!C-- change by Yu for overcast (add one dimension in the array)
12020 ! if ( fw2 .lt. 1.0e-20 ) then
12021 ! wc1_2(i,2) = 0.0
12022 ! wc2_2(i,2) = 0.0
12023 ! wc3_2(i,2) = 0.0
12024 ! wc4_2(i,2) = 0.0
12025 ! else
12026 ! if (naero.eq.0) then
12027 ! wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
12028 ! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw2
12029 ! wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
12030 ! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw2
12031 ! wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
12032 ! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw2
12033 ! wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
12034 ! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw2
12035 !
12036 !!C-- add by yu (01/2003) for aerosol
12037 ! else
12038 ! wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
12039 ! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
12040 ! +taes(1) )/fw2
12041 ! wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
12042 ! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
12043 ! +taes(2) )/fw2
12044 ! wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
12045 ! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
12046 ! +taes(3) )/fw2
12047 ! wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
12048 ! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
12049 ! +taes(4) )/fw2
12050 ! endif
12051 ! endif
12052 !!C-- over for aerosol
12053 !
12054 !!C-- add by Yu for clear (add one dimension in the array)
12055 ! if ( fw1 .lt. 1.0e-20 ) then
12056 ! wc1_2(i,1) = 0.0
12057 ! wc2_2(i,1) = 0.0
12058 ! wc3_2(i,1) = 0.0
12059 ! wc4_2(i,1) = 0.0
12060 ! else
12061 ! if (naero.eq.0) then
12062 ! wc1_2(i,1) = ( &
12063 ! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw1
12064 ! wc2_2(i,1) = ( &
12065 ! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw1
12066 ! wc3_2(i,1) = ( &
12067 ! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw1
12068 ! wc4_2(i,1) = ( &
12069 ! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw1
12070 !!C-- add by yu (01/2003) for aerosol
12071 ! else
12072 ! wc1_2(i,1) = ( &
12073 ! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
12074 ! +taes(1) )/fw1
12075 ! wc2_2(i,1) = ( &
12076 ! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
12077 ! +taes(2) )/fw1
12078 ! wc3_2(i,1) = ( &
12079 ! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
12080 ! +taes(3) )/fw1
12081 ! wc4_2(i,1) = ( &
12082 ! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
12083 ! +taes(4) )/fw1
12084 ! endif
12085 ! endif
12086 !10 continue
12087 !!c tt_2(1,1) = tc_2(1,1)
12088 !!c tt_2(1,2) = tc_2(1,2)
12089 !!c do 20 i = 2, nv
12090 !!c tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
12091 !!c tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
12092 !!c20 continue
12093 ! return
12094 ! end subroutine
12097 !C--- with aerosol & partly cloudy
12098 subroutine comscp_aero_cld ( nv,nv1 &
12099 & ,cldamnt,area_group,cld_group &
12100 & ,n_group,nb &
12101 & ,ti,wi,wwi,tw,ww,www &
12102 & ,trn,wrn,wwrn,tgr,wgr,wwgr &
12103 & ,tr,wr,wwr,tgm,tg,tae,wae,wwae &
12104 & ,wc1,wc2,wc3,wc4,wc,tt,tc_2 &
12105 & ,wc1_2,wc2_2,wc3_2,wc4_2,wc_2,tt_2 &
12106 & ,cc_inho &
12107 & )
12108 !c *********************************************************************
12109 !c This subroutine is used to COMbine Single-Scattering Properties due
12110 !c to ice crystals, water droplets, and Rayleigh molecules along with
12111 !c H2O continuum absorption and nongray gaseous absorption. See Section
12112 !c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
12113 !c single - scattering albedo, and expansion coefficients of the
12114 !c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
12115 !c optical depth ( from the top of the atmosphere to a given level ) for
12116 !c level 2 - level nv1( surface ). The single-scattering properties of
12117 !c rain and graupel are also incorporated in ( Jan. 19, 1993 ).
12118 !c *********************************************************************
12119 !c The single-scattering properties of aerosols are incorporated in
12120 !c (10/29/96) based on earlier version (5/17/95).
12121 !c *********************************************************************
12122 !# include "para.file"
12123 USE PARA_FILE
12124 USE control_para
12125 implicit none
12126 integer :: nv, nv1
12127 real, dimension(nv) :: cldamnt
12128 real :: ti(nv), wi(nv), wwi(nv,4)
12129 real :: tw(nv), ww(nv), www(nv,4)
12130 real :: trn(nv), wrn(nv), wwrn(nv,4)
12131 real :: tgr(nv), wgr(nv), wwgr(nv,4)
12132 real :: tr(nv), wr(nv), wwr(nv,4)
12133 real :: tgm(nv)
12134 real :: tg(nv)
12135 real :: tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
12137 real, dimension(nv) :: wc1, wc2, wc3, wc4, wc, tt
12138 real :: tc(nv), tc_2(nv,2),tis, tws, trns, tgrs, &
12139 & taes(0:4), fw, fw1, fw2, &
12140 & fcloud, adj_pari, adj_parw
12141 integer :: i, iac, k, kl, n_cld, j
12142 !--------------------------------------------------
12143 ! -- add by Yu for fractional cloud
12144 real, dimension(nv,2) :: wc1_2, wc2_2, wc3_2, wc4_2, &
12145 & wc_2, tt_2
12146 real :: area_group(3,2), cld_group(3)
12147 integer :: nb(3), n_group(3)
12148 real, dimension(nv) :: cc_inho
12149 ! - change over
12151 !c--- change by Yu, 02/13/02
12153 !c-- define inhomogeneity factor
12154 !c c_inho = 0.7
12155 !c--- test 0.8
12156 !c c_inho = 0.8
12158 !c--- determine n_group(k), cld_group(k), and area_group(k,1), area_group(k,2)
12159 !c--- hight,middle, and low three cloud groups
12160 do k=1,ngroup
12161 ! kl = (k-1)*ngroup + nv1 - nclouds
12162 kl = (k-1)*nsubcld + nv1 - nsubcld*ngroup
12163 cld_group(k) = cldamnt(kl)
12164 do i=kl+1,kl+nsubcld-1
12165 if (cldamnt(i).gt.cld_group(k)) then
12166 cld_group(k) = cldamnt(i)
12167 endif
12168 enddo
12169 ! - partly cloudy
12170 if (cld_group(k).gt.0.0.and.cld_group(k).lt.1.) then
12171 n_group(k) = 2
12172 nb(k) = 1
12173 area_group(k,1) = 1. - cld_group(k)
12174 area_group(k,2) = cld_group(k)
12175 ! - clear
12176 elseif(cld_group(k).eq.0.0) then
12177 n_group(k) = 1
12178 nb(k) = 1
12179 area_group(k,1) = 1.
12180 area_group(k,2) = 0.
12181 ! - overcast
12182 elseif(cld_group(k).eq.1.) then
12183 n_group(k) = 2
12184 nb(k) = 2
12185 area_group(k,1) = 0.
12186 area_group(k,2) = 1.
12187 endif
12189 enddo
12190 !c--- change over
12192 do i = 1, nv
12193 ! - add by Yu for clear
12194 tc_2(i,1) = tr(i) + tgm(i) + tg(i) + &
12195 & trn(i) + tgr(i)
12196 !--- value test
12197 if(tc_2(i,1).lt.0.) then
12198 write(0,*)'tau clear less then 0 at level ', i
12199 write(0,*)'tau=', tc_2(i,1)
12200 write(0,*)'tr=',tr(i)
12201 write(0,*)'tgm=',tgm(i)
12202 write(0,*)'tg=',tg(i)
12203 write(0,*)'trn=',trn(i)
12204 write(0,*)'tgr=',tgr(i)
12205 endif
12206 !--- test over
12208 ! - add by Yu Gu for aerosol for clear condition (01/2003)
12209 !
12210 if (naero.ge.1) then
12211 do iac = 1,mxac
12212 if (itps(iac).eq.1) tc_2(i,1) = tc_2(i,1) + tae(i,iac)
12213 enddo
12214 end if
12215 !c---------- 10/29/96 (5)
12216 !C --- change over
12218 !c-- change by Yu for overcast
12219 !c--- adjust tau according to cloud amount
12220 adj_pari = 0.
12221 adj_parw = 0.
12222 if (cldamnt(i).gt. 0.) then
12223 n_cld = (i-(nv1-nsubcld*ngroup))/nsubcld+1
12224 if (n_cld.gt.0.and.cld_group(n_cld).ne.0) then !mchen
12225 ! -- determine adjust parameter
12226 fcloud = cldamnt(i) / cld_group(n_cld)
12227 if (fcloud.le.0.1) then
12228 if (ti(i).le.15.) then
12229 adj_pari = fcloud - fcloud * 0.5 * ti(i) / 15.
12230 else
12231 adj_pari = 0.5 * fcloud
12232 endif
12233 if (tw(i).le.15.) then
12234 adj_parw = fcloud - fcloud * 0.5 * tw(i) / 15.
12235 else
12236 adj_parw = 0.5 * fcloud
12237 endif
12238 endif
12240 if (fcloud.le.0.3.and.fcloud.gt.0.1) then
12241 if (ti(i).le.15.) then
12242 adj_pari = fcloud - fcloud * 0.33 * ti(i) / 15.
12243 else
12244 adj_pari = 0.67 * fcloud
12245 endif
12246 if (tw(i).le.15.) then
12247 adj_parw = fcloud - fcloud * 0.33 * tw(i) / 15.
12248 else
12249 adj_parw = 0.67 * fcloud
12250 endif
12251 endif
12253 if (fcloud.le.0.5.and.fcloud.gt.0.3) then
12254 if (ti(i).le.15.) then
12255 adj_pari = fcloud - fcloud * 0.4 * ti(i) / 15.
12256 else
12257 adj_pari = 0.6 * fcloud
12258 endif
12259 if (tw(i).le.15.) then
12260 adj_parw = fcloud - fcloud * 0.4 * tw(i) / 15.
12261 else
12262 adj_parw = 0.6 * fcloud
12263 endif
12264 endif
12266 if (fcloud.le.0.7.and.fcloud.gt.0.5) then
12267 if (ti(i).le.15.) then
12268 adj_pari = fcloud - fcloud * 0.286 * ti(i) / 15.
12269 else
12270 adj_pari = 0.714 * fcloud
12271 endif
12272 if (tw(i).le.15.) then
12273 adj_parw = fcloud - fcloud * 0.286 * tw(i) / 15.
12274 else
12275 adj_parw = 0.714 * fcloud
12276 endif
12277 endif
12279 if (fcloud.le.0.9.and.fcloud.gt.0.7) then
12280 if (ti(i).le.15.) then
12281 adj_pari = fcloud - fcloud * 0.11 * ti(i) / 15.
12282 else
12283 adj_pari = 0.89 * fcloud
12284 endif
12285 if (tw(i).le.15.) then
12286 adj_parw = fcloud - fcloud * 0.11 * tw(i) / 15.
12287 else
12288 adj_parw = 0.89 * fcloud
12289 endif
12290 endif
12292 if (fcloud.le.1..and.fcloud.gt.0.9) then
12293 adj_pari = fcloud
12294 adj_parw = fcloud
12295 endif
12297 if (ti(i).gt.0.) &
12298 & ti(i) = ti(i) * adj_pari &
12299 & * cc_inho(i)
12300 !c & * c_inho
12301 !C-- above: change by Yu: to include the inhomogeneity effect
12303 !c & ti(i) = ti(i) * cldamnt(i)
12304 !c & / cld_group(n_cld)
12305 if (tw(i).gt.0.) &
12306 & tw(i) = tw(i) * adj_parw &
12307 & * cc_inho(i)
12308 !c & * c_inho
12309 !C-- above: change by Yu: to include the inhomogeneity effect
12311 !c & tw(i) = tw(i) * cldamnt(i)
12312 !c & / cld_group(n_cld)
12313 endif
12314 endif
12315 !c-- adjust over
12316 tc_2(i,2) = ti(i) + tw(i) + tr(i) + tgm(i) + tg(i) + &
12317 & trn(i) + tgr(i)
12318 ! --- test value
12319 if(tc_2(i,2).lt.0.) then
12320 write(0,*)'tau cloudy less then 0 at level ', i
12321 write(0,*)'tau=', tc_2(i,2)
12322 write(0,*)'ti=',ti(i)
12323 write(0,*)'tw=',tw(i)
12324 write(0,*)'tr=',tr(i)
12325 write(0,*)'tgm=',tgm(i)
12326 write(0,*)'tg=',tg(i)
12327 write(0,*)'trn=',trn(i)
12328 write(0,*)'tgr=',tgr(i)
12329 endif
12330 !--- test over
12331 !C-- add by Yu Gu for aerosol (01/2003)
12332 !C
12333 if (naero.ge.1) then
12334 do iac = 1,mxac
12335 if (itps(iac).eq.1) tc_2(i,2) = tc_2(i,2) + tae(i,iac)
12336 enddo
12337 endif
12339 !c---------- 10/29/96 (5)
12340 !C --- change over
12342 !c print *, 'i=',i,' tc=', tc_2(i,2)
12343 tis = ti(i) * wi(i)
12344 tws = tw(i) * ww(i)
12345 trns = trn(i) * wrn(i)
12346 tgrs = tgr(i) * wgr(i)
12347 !c fw1 = tr(i) + trns + tgrs
12348 !c fw2 = tis + tws + tr(i) + trns + tgrs
12350 !C--- add by Yu Gu (01/2003) for aerosol
12352 !c---------- 10/29/96 (6)
12353 if (naero.ge.1) then
12354 taes(0:4) = 0.0
12355 do iac = 1,mxac
12356 if (itps(iac).eq.1) then
12357 taes(0)=taes(0)+tae(i,iac)*wae(i,iac)
12358 do j=1,4
12359 taes(j)=taes(j)+tae(i,iac)*wae(i,iac)*wwae(i,j,iac)
12360 enddo
12361 end if
12362 enddo
12364 fw1 = tr(i) + trns + tgrs + taes(0)
12365 fw2 = tis + tws + tr(i) + trns + tgrs + taes(0)
12366 else
12367 ! -- no aerosol
12368 fw1 = tr(i) + trns + tgrs
12369 fw2 = tis + tws + tr(i) + trns + tgrs
12370 end if
12372 !c---------- 10/29/96 (6)
12374 wc_2(i,1) = fw1 / tc_2(i,1)
12375 wc_2(i,2) = fw2 / tc_2(i,2)
12376 !C-- change by Yu for overcast (add one dimension in the array)
12377 if ( fw2 .lt. 1.0e-20 ) then
12378 wc1_2(i,2) = 0.0
12379 wc2_2(i,2) = 0.0
12380 wc3_2(i,2) = 0.0
12381 wc4_2(i,2) = 0.0
12382 else
12383 if (naero.eq.0) then
12384 wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
12385 & tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw2
12386 wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
12387 & tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw2
12388 wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
12389 & tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw2
12390 wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
12391 & tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw2
12393 else
12394 ! - add by yu (01/2003) for aerosol
12395 wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
12396 & tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
12397 & + taes(1) )/fw2
12398 wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
12399 & tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
12400 & + taes(2) )/fw2
12401 wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
12402 & tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
12403 & + taes(3) )/fw2
12404 wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
12405 & tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
12406 & + taes(4) )/fw2
12407 endif
12408 ! - over for aerosol
12409 endif
12411 !C-- add by Yu for clear (add one dimension in the array)
12412 if ( fw1 .lt. 1.0e-20 ) then
12413 wc1_2(i,1) = 0.0
12414 wc2_2(i,1) = 0.0
12415 wc3_2(i,1) = 0.0
12416 wc4_2(i,1) = 0.0
12417 else
12418 if (naero.eq.0) then
12419 wc1_2(i,1) = ( &
12420 & tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw1
12421 wc2_2(i,1) = ( &
12422 & tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw1
12423 wc3_2(i,1) = ( &
12424 & tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw1
12425 wc4_2(i,1) = ( &
12426 & tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw1
12427 !C-- add by yu (01/2003) for aerosol
12428 else
12429 wc1_2(i,1) = ( &
12430 & tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
12431 & + taes(1) )/fw1
12432 wc2_2(i,1) = ( &
12433 & tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
12434 & + taes(2) )/fw1
12435 wc3_2(i,1) = ( &
12436 & tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
12437 & + taes(3) )/fw1
12438 wc4_2(i,1) = ( &
12439 & tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
12440 & + taes(4) )/fw1
12441 endif
12442 endif
12443 10 end do
12444 !c tt_2(1,1) = tc_2(1,1)
12445 !c tt_2(1,2) = tc_2(1,2)
12446 !c do 20 i = 2, nv
12447 !c tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
12448 !c tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
12449 !c20 continue
12450 return
12451 end subroutine
12454 ! subroutine comscp_new(icur,jcur)
12455 !!c *********************************************************************
12456 !!c This subroutine is used to COMbine Single-Scattering Properties due
12457 !!c to ice crystals, water droplets, and Rayleigh molecules along with
12458 !!c H2O continuum absorption and nongray gaseous absorption. See Section
12459 !!c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
12460 !!c single - scattering albedo, and expansion coefficients of the
12461 !!c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
12462 !!c optical depth ( from the top of the atmosphere to a given level ) for
12463 !!c level 2 - level nv1( surface ). The single-scattering properties of
12464 !!c rain and graupel(or aerosol) are also incorporated in ( Jan. 19, 1993 ).
12465 !!c *********************************************************************
12466 !!# include "para.file"
12467 ! USE PARA_FILE
12468 ! common /ic/ ti(nv), wi(nv), wwi(nv,4)
12469 ! common /wat/ tw(nv), ww(nv), www(nv,4)
12470 ! common /rai/ trn(nv), wrn(nv), wwrn(nv,4)
12471 ! common /gra/ tgr(nv), wgr(nv), wwgr(nv,4)
12472 ! common /ray/ tr(nv), wr(nv), wwr(nv,4)
12473 ! common /con/ tgm(nv)
12474 ! common /gas/ tg(nv)
12475 !!C--- add by Yu for fractional cloud
12476 ! common /dfsin_2/ wc1_2(nv,2), wc2_2(nv,2), wc3_2(nv,2), &
12477 ! wc4_2(nv,2), &
12478 ! wc_2(nv,2), tt_2(nv,2)
12479 ! common /delta_tao/ tc_2(nv,2)
12480 !!c-- change over
12481 ! common /dfsin/ wc1(nv), wc2(nv), wc3(nv), wc4(nv), &
12482 ! wc(nv), tt(nv)
12483 !!C--- change by Yu, 02/13/02
12484 !!c common /cld_a/cldamnt(nv), area_h(2), area_m(2), area_l(2)
12485 !!c common /cld_c/n_h, n_m, n_l, cld_h, cld_m, cld_l
12486 ! common /cld_a/cldamnt(nv), area_group(3,2)
12487 ! common /cld_inho/cc_inho(nv)
12488 ! common /cld_c/n_group(3), cld_group(3)
12489 ! common /cld_loop/ nb(3)
12490 !!c-- change over
12491 ! dimension tc(nv)
12492 !
12493 !!c--- change by Yu, 02/13/02
12494 !
12495 !!c-- define inhomogeneity factor
12496 !!c c_inho = 0.7
12497 !!c--- test 0.8
12498 !!c c_inho = 0.8
12499 !!c--- determine n_group(k), cld_group(k), and area_group(k,1), area_group(k,2)
12500 !!c--- hight,middle, and low three cloud groups
12501 !!c do k=1,3
12502 ! do k=1,ngroup
12503 !!c kl = (k-1)*3 + 7
12504 ! kl = (k-1)*nsubcld + nv1-nclouds
12505 ! cld_group(k) = cldamnt(kl)
12506 !!c do i=kl+1,kl+2
12507 ! do i=kl+1,kl+nsubcld-1
12508 ! if (cldamnt(i).gt.cld_group(k)) then
12509 ! cld_group(k) = cldamnt(i)
12510 ! endif
12511 ! enddo
12512 !!c-- partly cloudy
12513 ! if (cld_group(k).gt.0.0.and.cld_group(k).lt.1.) then
12514 ! n_group(k) = 2
12515 ! nb(k) = 1
12516 ! area_group(k,1) = 1. - cld_group(k)
12517 ! area_group(k,2) = cld_group(k)
12518 !!c-- clear
12519 ! elseif(cld_group(k).eq.0.0) then
12520 ! n_group(k) = 1
12521 ! nb(k) = 1
12522 ! area_group(k,1) = 1.
12523 ! area_group(k,2) = 0.
12524 !!c-- overcast
12525 ! elseif(cld_group(k).eq.1.) then
12526 ! n_group(k) = 2
12527 ! nb(k) = 2
12528 ! area_group(k,1) = 0.
12529 ! area_group(k,2) = 1.
12530 ! endif
12531 !
12532 ! enddo
12533 !!c--- change over
12534 !
12535 ! do 10 i = 1, nv
12536 !!c-- add by Yu for clear
12537 ! tc_2(i,1) = tr(i) + tgm(i) + tg(i) + &
12538 ! trn(i) + tgr(i)
12539 !!c-- change by Yu for overcast
12540 !!c--- adjust tau according to cloud amount
12541 ! if (cldamnt(i).gt. 0.) then
12542 !!c n_cld = (i-4)/3
12543 ! n_cld = (i-(nv1-nclouds))/nsubcld+1
12544 ! if (n_cld.gt.0) then
12545 !!C--- determine adjust parameter
12546 ! fcloud = cldamnt(i) / cld_group(n_cld)
12547 ! if (fcloud.le.0.1) then
12548 ! if (ti(i).le.15.) then
12549 ! adj_pari = fcloud-fcloud*0.5*ti(i)/15.
12550 ! else
12551 ! adj_pari = 0.5 * fcloud
12552 ! endif
12553 ! if (tw(i).le.15.) then
12554 ! adj_parw = fcloud-fcloud*0.5*tw(i)/15.
12555 ! else
12556 ! adj_parw = 0.5 * fcloud
12557 ! endif
12558 ! endif
12559 !
12560 ! if (fcloud.le.0.3.and.fcloud.gt.0.1) then
12561 ! if (ti(i).le.15.) then
12562 ! adj_pari = fcloud-fcloud*0.33*ti(i)/15.
12563 ! else
12564 ! adj_pari = 0.67 * fcloud
12565 ! endif
12566 ! if (tw(i).le.15.) then
12567 ! adj_parw = fcloud-fcloud*0.33*tw(i)/15.
12568 ! else
12569 ! adj_parw = 0.67 * fcloud
12570 ! endif
12571 ! endif
12572 !
12573 ! if (fcloud.le.0.5.and.fcloud.gt.0.3) then
12574 ! if (ti(i).le.15.) then
12575 ! adj_pari = fcloud-fcloud*0.4*ti(i)/15.
12576 ! else
12577 ! adj_pari = 0.6 * fcloud
12578 ! endif
12579 ! if (tw(i).le.15.) then
12580 ! adj_parw = fcloud-fcloud*0.4*tw(i)/15.
12581 ! else
12582 ! adj_parw = 0.6 * fcloud
12583 ! endif
12584 ! endif
12585 !
12586 ! if (fcloud.le.0.7.and.fcloud.gt.0.5) then
12587 ! if (ti(i).le.15.) then
12588 ! adj_pari = fcloud-fcloud*0.286*ti(i)/15.
12589 ! else
12590 ! adj_pari = 0.714 * fcloud
12591 ! endif
12592 ! if (tw(i).le.15.) then
12593 ! adj_parw = fcloud-fcloud*0.286*tw(i)/15.
12594 ! else
12595 ! adj_parw = 0.714 * fcloud
12596 ! endif
12597 ! endif
12598 !
12599 ! if (fcloud.le.0.9.and.fcloud.gt.0.7) then
12600 ! if (ti(i).le.15.) then
12601 ! adj_pari = fcloud-fcloud*0.11*ti(i)/15.
12602 ! else
12603 ! adj_pari = 0.89 * fcloud
12604 ! endif
12605 ! if (tw(i).le.15.) then
12606 ! adj_parw = fcloud-fcloud*0.11*tw(i)/15.
12607 ! else
12608 ! adj_parw = 0.89 * fcloud
12609 ! endif
12610 ! endif
12611 !
12612 ! if (fcloud.le.1..and.fcloud.gt.0.9) then
12613 ! adj_pari = fcloud
12614 ! adj_parw = fcloud
12615 ! endif
12616 !
12617 ! if (ti(i).gt.0.) &
12618 ! ti(i) = ti(i) * adj_pari &
12619 ! * cc_inho(i)
12620 !!c & * c_inho
12621 !!C-- above: change by Yu: to include the inhomogeneity effect
12622 !!c & ti(i) = ti(i) * cldamnt(i)
12623 !!c & / cld_group(n_cld)
12624 ! if (tw(i).gt.0.) &
12625 ! tw(i) = tw(i) * adj_parw &
12626 ! * cc_inho(i)
12627 !!c & * c_inho
12628 !!C-- above: change by Yu: to include the inhomogeneity effect
12629 !!c & tw(i) = tw(i) * cldamnt(i)
12630 !!c & / cld_group(n_cld)
12631 ! endif
12632 ! endif
12633 !
12634 !!c-- adjust over
12635 !!C
12636 ! tc_2(i,2) = ti(i) + tw(i) + &
12637 ! tr(i) + tgm(i) + tg(i) + &
12638 ! trn(i) + tgr(i)
12639 ! tis = ti(i) * wi(i)
12640 ! tws = tw(i) * ww(i)
12641 ! trns = trn(i) * wrn(i)
12642 ! tgrs = tgr(i) * wgr(i)
12643 ! fw1 = tr(i) + trns + tgrs
12644 ! fw2 = tis + tws + tr(i) + trns + tgrs
12645 ! wc_2(i,1) = fw1 / tc_2(i,1)
12646 ! wc_2(i,2) = fw2 / tc_2(i,2)
12647 !!C-- change by Yu for overcast (add one dimension in the array)
12648 ! if ( fw2 .lt. 1.0e-20 ) then
12649 ! wc1_2(i,2) = 0.0
12650 ! wc2_2(i,2) = 0.0
12651 ! wc3_2(i,2) = 0.0
12652 ! wc4_2(i,2) = 0.0
12653 ! else
12654 ! wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
12655 ! tr(i) * wwr(i,1) + trns * wwrn(i,1) + &
12656 ! tgrs * wwgr(i,1) )/fw2
12657 ! wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
12658 ! tr(i) * wwr(i,2) + trns * wwrn(i,2) + &
12659 ! tgrs * wwgr(i,2) )/fw2
12660 ! wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
12661 ! tr(i) * wwr(i,3) + trns * wwrn(i,3) + &
12662 ! tgrs * wwgr(i,3) )/fw2
12663 ! wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
12664 ! tr(i) * wwr(i,4) + trns * wwrn(i,4) + &
12665 ! tgrs * wwgr(i,4) )/fw2
12666 ! endif
12667 !!C-- add by Yu for clear (add one dimension in the array)
12668 ! if ( fw1 .lt. 1.0e-20 ) then
12669 ! wc1_2(i,1) = 0.0
12670 ! wc2_2(i,1) = 0.0
12671 ! wc3_2(i,1) = 0.0
12672 ! wc4_2(i,1) = 0.0
12673 ! else
12674 ! wc1_2(i,1) = ( &
12675 ! tr(i) * wwr(i,1) + trns * wwrn(i,1) + &
12676 ! tgrs * wwgr(i,1) )/fw1
12677 ! wc2_2(i,1) = ( &
12678 ! tr(i) * wwr(i,2) + trns * wwrn(i,2) + &
12679 ! tgrs * wwgr(i,2) )/fw1
12680 ! wc3_2(i,1) = (&
12681 ! tr(i) * wwr(i,3) + trns * wwrn(i,3) + &
12682 ! tgrs * wwgr(i,3) )/fw1
12683 ! wc4_2(i,1) = (&
12684 ! tr(i) * wwr(i,4) + trns * wwrn(i,4) + &
12685 ! tgrs * wwgr(i,4) )/fw1
12686 ! endif
12687 !10 continue
12688 !!c tt_2(1,1) = tc_2(1,1)
12689 !!c tt_2(1,2) = tc_2(1,2)
12690 !!c do 20 i = 2, nv
12691 !!c tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
12692 !!c tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
12693 !!c20 continue
12694 ! return
12695 ! end subroutine
12698 ! subroutine comscp
12699 !!c *********************************************************************
12700 !!c This subroutine is used to COMbine Single-Scattering Properties due
12701 !!c to ice crystals, water droplets, and Rayleigh molecules along with
12702 !!c H2O continuum absorption and nongray gaseous absorption. See Section
12703 !!c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
12704 !!c single - scattering albedo, and expansion coefficients of the
12705 !!c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
12706 !!c optical depth ( from the top of the atmosphere to a given level ) for
12707 !!c level 2 - level nv1( surface ). The single-scattering properties of
12708 !!c rain and graupel are also incorporated in ( Jan. 19, 1993 ).
12709 !!c *********************************************************************
12710 !!# include "para.file"
12711 ! USE PARA_FILE
12712 ! common /ic/ ti(nv), wi(nv), wwi(nv,4)
12713 ! common /wat/ tw(nv), ww(nv), www(nv,4)
12714 ! common /rai/ trn(nv), wrn(nv), wwrn(nv,4)
12715 ! common /gra/ tgr(nv), wgr(nv), wwgr(nv,4)
12716 ! common /ray/ tr(nv), wr(nv), wwr(nv,4)
12717 ! common /con/ tgm(nv)
12718 ! common /gas/ tg(nv)
12719 ! common /dfsin/ wc1(nv), wc2(nv), wc3(nv), wc4(nv), &
12720 ! wc(nv), tt(nv)
12721 ! dimension tc(nv)
12722 ! do 10 i = 1, nv
12723 ! tc(i) = ti(i) + tw(i) + tr(i) + tgm(i) + tg(i) + &
12724 ! trn(i) + tgr(i)
12725 ! tis = ti(i) * wi(i)
12726 ! tws = tw(i) * ww(i)
12727 ! trns = trn(i) * wrn(i)
12728 ! tgrs = tgr(i) * wgr(i)
12729 ! fw = tis + tws + tr(i) + trns + tgrs
12730 ! wc(i) = fw / tc(i)
12731 ! if ( fw .lt. 1.0e-20 ) then
12732 ! wc1(i) = 0.0
12733 ! wc2(i) = 0.0
12734 ! wc3(i) = 0.0
12735 ! wc4(i) = 0.0
12736 ! else
12737 ! wc1(i) = ( tis * wwi(i,1) + tws * www(i,1) + &
12738 ! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw
12739 ! wc2(i) = ( tis * wwi(i,2) + tws * www(i,2) + &
12740 ! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw
12741 ! wc3(i) = ( tis * wwi(i,3) + tws * www(i,3) + &
12742 ! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw
12743 ! wc4(i) = ( tis * wwi(i,4) + tws * www(i,4) + &
12744 ! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw
12745 ! endif
12746 !10 continue
12747 ! tt(1) = tc(1)
12748 ! do 20 i = 2, nv
12749 ! tt(i) = tt(i-1) + tc(i)
12750 !20 continue
12751 ! return
12752 ! end subroutine
12756 !c function planck1 ( t, w )
12757 !c **********************************************************************
12758 !c t is the temperature (K), w is the wavenumber (cm-1), and planck1 is
12759 !c the blackbody intensity function (W/m**2/Sr/cm-1). See Eq. (2.8) of
12760 !c Fu (1991).
12761 !c **********************************************************************
12762 !c a = 1.19107e-8
12763 !c b = 1.43884
12764 !c planck1 = a * w * w * w / ( exp ( b * w / t ) - 1.0 )
12765 !c return
12766 !c end
12768 !c function bt ( t, ve, nd )
12769 !c **********************************************************************
12770 !c bt (W/m**2/Sr) is the blackbody intensity function integrated over a
12771 !c given band, which has a band width of nd*10 (cm-1) from the ve (cm-1).
12772 !c **********************************************************************
12773 !c v1 = ve
12774 !c bt = 0.0
12775 !c do 10 j = 1, nd
12776 !c v2 = v1 - 10.0
12777 !c w = ( v1 + v2 ) * 0.5
12778 !c x = planck1 ( t, w )
12779 !c bt = bt + x
12780 !c v1 = v2
12781 !c10 continue
12782 !c bt = bt * 10.0
12783 !c return
12784 !c end
12786 subroutine planck ( nv,nv1,ib,pts,pp,pt,ph,po,bf,bs )
12787 !c **********************************************************************
12788 !c bf and bs are the blackbody intensity function integrated over the
12789 !c band ib at the nv1 levels and at the surface, respectively. The
12790 !c units of bf and bs are W/m**2/Sr. nd*10 is the band width from ve.
12791 !c **********************************************************************
12792 !# include "para.file"
12793 USE PARA_FILE
12794 implicit none
12795 integer :: nv, nv1
12796 real, dimension(nv1) :: pp, pt, ph, po
12797 real :: bf(nv1), bs, pts
12798 real :: ve(mbir), bt(nv1)
12799 integer :: nd(mbir)
12800 integer :: ib, i, j, nv11, ibr
12801 real :: v1, v2, w, fq1, fq2, bts, x
12803 data ve / 2200.0, 1900.0, 1700.0, 1400.0, 1250.0, 1100.0, &
12804 & 980.0, 800.0, 670.0, 540.0, 400.0, 280.001 /
12805 data nd / 30, 20, 30, 15, 15, 12, &
12806 & 18, 13, 13, 14, 12, 28 /
12807 nv11 = nv1 + 1
12808 ibr = ib - mbs
12809 bts = 0.0
12810 do i = 1, nv1
12811 bt(i) = 0.0
12812 end do
12813 v1 = ve(ibr)
12814 do j = 1, nd(ibr)
12815 v2 = v1 - 10.0
12816 w = ( v1 + v2 ) * 0.5
12817 fq1 = 1.19107e-8 * w * w * w
12818 fq2 = 1.43884 * w
12819 do i = 1, nv11
12820 if ( i .eq. nv11 ) then
12821 x = fq1 / ( exp ( fq2 / pts ) - 1.0 )
12822 bts = bts + x
12823 else
12824 x = fq1 / ( exp ( fq2 / pt(i) ) - 1.0 )
12825 bt(i) = bt(i) + x
12826 endif
12827 end do
12828 v1 = v2
12829 end do
12830 do i = 1, nv1
12831 bf(i) = bt(i) * 10.0
12832 end do
12833 bs = bts * 10.0
12834 return
12835 end subroutine
12837 !c **********************************************************************
12838 !c coefficient calculations for four first-order differential equations.
12839 !c **********************************************************************
12840 subroutine coeff1 ( ib,w,w1,w2,w3,t0,t1,u0,f0,b )
12841 !# include "para.file"
12842 USE PARA_FILE
12843 USE numericals
12844 ! common /dis/ a(4)
12845 ! common /point/ u(4)
12846 ! common /legen/ p0d(4), p1d(4), p2d(4), p3d(4)
12847 ! common /legen1/ p11d(4,4), p22d(4,4), p33d(4,4)
12848 ! common /coedfi/ ib, w, w1, w2, w3, t0, t1, u0, f0
12849 ! common /coedf1/ b(4,3)
12850 implicit none
12851 integer, intent(in) :: ib
12852 real, intent(in) :: w, w1, w2, w3, t0, t1, u0, f0
12853 real, intent(out) :: b(4,3)
12854 integer :: i, j
12855 real :: x, w0w, w1w, w2w, w3w, fw, q1, q2, q3, fq, c(4,5)
12857 x = 0.5 * w
12858 w0w = x
12859 w1w = x * w1
12860 w2w = x * w2
12861 w3w = x * w3
12862 if ( ib .le. mbs ) then
12863 fw = u0 * u0
12864 q1 = - w1w * u0
12865 q2 = w2w * ( 1.5 * fw - 0.5 )
12866 q3 = - w3w * ( 2.5 * fw - 1.5 ) * u0
12867 endif
12868 fq = 0.5 * w0w
12869 do i = 3, 4
12870 do j = 1, 4
12871 c(i,j) = fq + w1w * p11d(i,j) + &
12872 & w2w * p22d(i,j) + w3w * p33d(i,j)
12873 if ( i .eq. j ) then
12874 c(i,j) = ( c(i,j) - 1.0 ) / u(i)
12875 else
12876 c(i,j) = c(i,j) / u(i)
12877 endif
12878 20 end do
12879 10 end do
12880 do i = 1, 4
12881 if ( ib .le. mbs ) then
12882 c(i,5) = w0w + q1 * p1d(i) + &
12883 & q2 * p2d(i) + q3 * p3d(i)
12884 else
12885 c(i,5) = 1.0
12886 endif
12887 c(i,5) = c(i,5) / u(i)
12888 30 end do
12889 b(1,1) = c(4,4) - c(4,1)
12890 b(1,2) = c(4,4) + c(4,1)
12891 b(2,1) = c(4,3) - c(4,2)
12892 b(2,2) = c(4,3) + c(4,2)
12893 b(3,1) = c(3,4) - c(3,1)
12894 b(3,2) = c(3,4) + c(3,1)
12895 b(4,1) = c(3,3) - c(3,2)
12896 b(4,2) = c(3,3) + c(3,2)
12897 b(1,3) = c(4,5) - c(1,5)
12898 b(2,3) = c(3,5) - c(2,5)
12899 b(3,3) = c(3,5) + c(2,5)
12900 b(4,3) = c(4,5) + c(1,5)
12901 return
12902 end subroutine
12904 !c **********************************************************************
12905 !c coefficient calculations for second order differential equations.
12906 !c **********************************************************************
12907 subroutine coeff2 ( u0,b,a,d )
12908 implicit none
12910 real, intent(in) :: u0
12911 real, intent(in) :: b(4,3)
12912 real, intent(out) :: a(2,2,2), d(4)
12913 real :: fw1, fw2, fw3, fw4
12915 fw1 = b(1,1) * b(1,2)
12916 fw2 = b(2,1) * b(3,2)
12917 fw3 = b(3,1) * b(2,2)
12918 fw4 = b(4,1) * b(4,2)
12919 a(2,2,1) = fw1 + fw2
12920 a(2,1,1) = b(1,1) * b(2,2) + b(2,1) * b(4,2)
12921 a(1,2,1) = b(3,1) * b(1,2) + b(4,1) * b(3,2)
12922 a(1,1,1) = fw3 + fw4
12923 a(2,2,2) = fw1 + fw3
12924 a(2,1,2) = b(1,2) * b(2,1) + b(2,2) * b(4,1)
12925 a(1,2,2) = b(3,2) * b(1,1) + b(4,2) * b(3,1)
12926 a(1,1,2) = fw2 + fw4
12927 d(1) = b(3,2) * b(4,3) + b(4,2) * b(3,3) + b(2,3) / u0
12928 d(2) = b(1,2) * b(4,3) + b(2,2) * b(3,3) + b(1,3) / u0
12929 d(3) = b(3,1) * b(1,3) + b(4,1) * b(2,3) + b(3,3) / u0
12930 d(4) = b(1,1) * b(1,3) + b(2,1) * b(2,3) + b(4,3) / u0
12931 return
12932 end subroutine
12934 !c **********************************************************************
12935 !c coefficient calculations for fourth-order differential equations.
12936 !c **********************************************************************
12937 subroutine coeff4 ( u0,a,d,z,b1,c1 )
12938 ! common /coedfi/ ib, w, w1, w2, w3, t0, t1, u0, f0
12939 ! common /coedf2/ a(2,2,2), d(4)
12940 ! common /coedf4/ b1, c1, z(4)
12941 implicit none
12942 real, intent(in) :: u0
12943 real, intent(in) :: a(2,2,2), d(4)
12944 real, intent(out) :: z(4), b1, c1
12945 real :: x
12947 x = u0 * u0
12948 b1 = a(2,2,1) + a(1,1,1)
12949 c1 = a(2,1,1) * a(1,2,1) - a(1,1,1) * a(2,2,1)
12950 z(1) = a(2,1,1) * d(3) + d(4) / x - a(1,1,1) * d(4)
12951 z(2) = a(1,2,1) * d(4) - a(2,2,1) *d(3) + d(3) / x
12952 z(3) = a(2,1,2) * d(1) + d(2) / x - a(1,1,2) * d(2)
12953 z(4) = a(1,2,2) * d(2) - a(2,2,2) * d(1) + d(1) / x
12954 return
12955 end subroutine
12957 !c **********************************************************************
12958 !c fk1 and fk2 are the eigenvalues.
12959 !c **********************************************************************
12960 subroutine coeffl ( ib,t0,t1,u0,f0,b,a,d,z,b1,c1, &
12961 & aa,zz,a1,z1,fk1,fk2 )
12962 !# include "para.file"
12963 USE PARA_FILE
12964 ! common /coedfi/ ib, w, w1, w2, w3, t0, t1, u0, f0
12965 ! common /coedf1/ b(4,3)
12966 ! common /coedf2/ a(2,2,2), d(4)
12967 ! common /coedf4/ b1, c1, z(4)
12968 ! common /coedfl/ aa(4,4,2), zz(4,2), a1(4,4), z1(4), fk1, fk2
12970 implicit none
12971 integer, intent(in) :: ib
12972 real, intent(in) :: t0, t1, u0, f0
12973 real, intent(in) :: b(4,3)
12974 real, intent(in) :: a(2,2,2), d(4)
12975 real, intent(inout) :: z(4), b1, c1
12976 real, intent(out) :: aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
12977 & fk1, fk2
12978 integer :: i
12979 real :: dt, x, y, fw, fw1, fw2, a2, b2, zx, fq0, fq1
12981 dt = t1 - t0
12982 x = sqrt ( b1 * b1 + 4.0 * c1 )
12983 fk1 = sqrt ( ( b1 + x ) * 0.5 )
12984 fk2 = sqrt ( ( b1 - x ) * 0.5 )
12985 fw = u0 * u0
12986 x = 1.0 / ( fw * fw ) - b1 / fw - c1
12988 ! --------- 4/2/97 (4)
12989 if (abs (x) .lt. 1.0E-16) THEN
12990 if ( x .lt. 0.0) THEN
12991 x = -1.0E-6
12992 else
12993 x = 1.0E-6
12994 end if
12995 end if
12996 ! --------- 4/2/97 (4)
12998 fw = 0.5 * f0 / x
12999 z(1) = fw * z(1)
13000 z(2) = fw * z(2)
13001 z(3) = fw * z(3)
13002 z(4) = fw * z(4)
13003 z1(1) = 0.5 * ( z(1) + z(3) )
13004 z1(2) = 0.5 * ( z(2) + z(4) )
13005 z1(3) = 0.5 * ( z(2) - z(4) )
13006 z1(4) = 0.5 * ( z(1) - z(3) )
13007 a2 = ( fk1 * fk1 - a(2,2,1) ) / a(2,1,1)
13008 b2 = ( fk2 * fk2 - a(2,2,1) ) / a(2,1,1)
13009 x = b(1,1) * b(4,1) - b(3,1) * b(2,1)
13010 fw1 = fk1 / x
13011 fw2 = fk2 / x
13012 y = fw2 * ( b2 * b(2,1) - b(4,1) )
13013 zx = fw1 * ( a2 * b(2,1) - b(4,1) )
13014 a1(1,1) = 0.5 * ( 1 - y )
13015 a1(1,2) = 0.5 * ( 1 - zx )
13016 a1(1,3) = 0.5 * ( 1 + zx )
13017 a1(1,4) = 0.5 * ( 1 + y )
13018 y = fw2 * ( b(3,1) - b2 * b(1,1) )
13019 zx = fw1 * ( b(3,1) - a2 * b(1,1) )
13020 a1(2,1) = 0.5 * ( b2 - y )
13021 a1(2,2) = 0.5 * ( a2 - zx )
13022 a1(2,3) = 0.5 * ( a2 + zx )
13023 a1(2,4) = 0.5 * ( b2 + y )
13024 a1(3,1) = a1(2,4)
13025 a1(3,2) = a1(2,3)
13026 a1(3,3) = a1(2,2)
13027 a1(3,4) = a1(2,1)
13028 a1(4,1) = a1(1,4)
13029 a1(4,2) = a1(1,3)
13030 a1(4,3) = a1(1,2)
13031 a1(4,4) = a1(1,1)
13032 if ( ib .le. mbs ) then
13033 fq0 = exp ( - t0 / u0 )
13034 fq1 = exp ( - t1 / u0 )
13035 else
13036 fq0 = 1.0
13037 fq1 = exp ( - dt / u0 )
13038 endif
13039 x = exp ( - fk1 * dt )
13040 y = exp ( - fk2 * dt )
13041 do i = 1, 4
13042 zz(i,1) = z1(i) * fq0
13043 zz(i,2) = z1(i) * fq1
13044 aa(i,1,1) = a1(i,1)
13045 aa(i,2,1) = a1(i,2)
13046 aa(i,3,1) = a1(i,3) * x
13047 aa(i,4,1) = a1(i,4) * y
13048 aa(i,3,2) = a1(i,3)
13049 aa(i,4,2) = a1(i,4)
13050 aa(i,1,2) = a1(i,1) * y
13051 aa(i,2,2) = a1(i,2) * x
13052 40 end do
13053 return
13054 end subroutine
13056 !c **********************************************************************
13057 !c See the paper by Liou, Fu and Ackerman (1988) for the formulation of
13058 !c the delta-four-stream approximation in a homogeneous layer.
13059 !c **********************************************************************
13060 subroutine coefft ( ib,w,w1,w2,w3,t0,t1,u0,f0, &
13061 & b,a,d,z,b1,c1,aa,zz,a1,z1,fk1,fk2 )
13062 implicit none
13063 integer, intent(in) :: ib
13064 real, intent(in) :: w, w1, w2, w3, t0, t1, u0, f0
13065 real :: b(4,3), a(2,2,2), d(4), &
13066 & z(4), b1, c1, &
13067 & aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
13068 & fk1, fk2
13070 call coeff1 ( ib,w,w1,w2,w3,t0,t1,u0,f0,b )
13071 call coeff2 ( u0,b,a,d )
13072 call coeff4 ( u0,a,d,z,b1,c1 )
13073 call coeffl ( ib,t0,t1,u0,f0,b,a,d,z,b1,c1, &
13074 & aa,zz,a1,z1,fk1,fk2 )
13075 return
13076 end subroutine
13078 !c **********************************************************************
13079 !c In the limits of no scattering ( Fu, 1991 ), fk1 = 1.0 / u(3) and
13080 !c fk2 = 1.0 / u(4).
13081 !c **********************************************************************
13082 subroutine coefft0 ( ib,w,w1,w2,w3,t0,t1,u0,f0, &
13083 & aa,zz,a1,z1,fk1,fk2 )
13084 !# include "para.file"
13085 USE PARA_FILE
13086 use numericals
13087 implicit none
13089 integer, intent(in) :: ib
13090 real, intent(in) :: w, w1, w2, w3, t0, t1, u0, f0
13091 real, intent(out) :: aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
13092 & fk1, fk2
13093 integer :: i, jj, j, k
13094 real :: x, y, fw, temp, dt
13096 fk1 = 4.7320545
13097 fk2 = 1.2679491
13098 y = exp ( - ( t1 - t0 ) / u0 )
13099 fw = 0.5 * f0
13100 do i = 1, 4
13101 if ( ib .le. mbs ) then
13102 z1(i) = 0.0
13103 zz(i,1) = 0.0
13104 zz(i,2) = 0.0
13105 else
13106 jj = 5 - i
13107 ! - change by Yu Gu, 11/19/01
13108 temp = u(jj)/u0
13109 ! if (temp.eq.-1.) temp = -1.001
13110 if (temp.eq.-1.) temp = -0.9999
13111 z1(i) = fw / ( 1.0 + temp )
13112 ! z1(i) = fw / ( 1.0 + u(jj) / u0 )
13113 ! -- change over
13115 zz(i,1) = z1(i)
13116 zz(i,2) = z1(i) * y
13117 endif
13118 do j = 1, 4
13119 a1(i,j) = 0.0
13120 do k = 1, 2
13121 aa(i,j,k) = 0.0
13122 12 end do
13123 11 end do
13124 10 end do
13125 do i = 1, 4
13126 j = 5 - i
13127 a1(i,j) = 1.0
13128 20 end do
13129 dt = t1 - t0
13130 x = exp ( - fk1 * dt )
13131 y = exp ( - fk2 * dt )
13132 aa(1,4,1) = y
13133 aa(2,3,1) = x
13134 aa(3,2,1) = 1.0
13135 aa(4,1,1) = 1.0
13136 aa(1,4,2) = 1.0
13137 aa(2,3,2) = 1.0
13138 aa(3,2,2) = x
13139 aa(4,1,2) = y
13140 return
13141 end subroutine
13143 !c **********************************************************************
13144 !c In the solar band asbs is the surface albedo, while in the infrared
13145 !c band asbs is blackbody intensity emitted at the surface temperature
13146 !c times surface emissivity. In this subroutine, the delta-four-stream
13147 !c is applied to nonhomogeneous atmospheres. See comments in subroutine
13148 !c 'qcfel' for array AB(13,4*n).
13149 !c **********************************************************************
13150 subroutine qcfe ( nv,nv1,ib,asbs,ee,w1,w2,w3,w,t,u0,f0, &
13151 & fk1,fk2,a4,z4,g4 )
13152 !# include "para.file"
13153 USE PARA_FILE
13154 implicit none
13155 integer :: nv, nv1
13156 integer, intent(in) :: ib
13157 real, intent(in) :: asbs, ee
13158 real, intent(in), dimension(nv) :: w1, w2, w3, w, t, u0, f0
13159 real, intent(out) :: fk1(nv), fk2(nv), a4(4,4,nv), &
13160 & z4(4,nv), g4(4,nv)
13161 real :: b(4,3), a(2,2,2), d(4), z(4), b1, c1, &
13162 & aa(4,4,2), zz(4,2), a1(4,4), z1(4), fk1t, fk2t
13163 real :: ab(13,nv * 4), bx(nv * 4), xx(nv * 4)
13164 integer :: n, n4, i, j, k, ibn, i8, kf, i1, i2, i3, j1, j2, j3, &
13165 & m1, m2, m18, m28
13166 real :: wn, w1n, w2n, w3n, t0n, t1n, u0n, f0n
13167 real :: fu(4,4), wu(4)
13168 real :: v1, v2, v3, fw1, fw2
13170 ! common /dis/ a(4)
13171 ! common /point/ u(4)
13172 ! common /qccfei/ w1(nv), w2(nv), w3(nv), w(nv), &
13173 ! t(nv), u0(nv), f0(nv)
13174 ! common /coedfi/ ibn, wn, w1n, w2n, w3n, t0n, t1n, u0n, f0n
13175 ! common /coedfl/ aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
13176 ! fk1t, fk2t
13177 ! common /qccfeo/ fk1(nv), fk2(nv), a4(4,4,nv), &
13178 ! z4(4,nv), g4(4,nv)
13179 ! common /qcfelc/ ab(13,nv * 4), bx(nv * 4), xx(nv * 4)
13180 ! dimension fu(4,4), wu(4)
13181 n = nv
13182 n4 = nv * 4
13183 do i = 1, n4
13184 do j = 1, 13
13185 ab(j,i) = 0.0
13186 end do
13187 end do
13188 ibn = ib
13189 wn = w(1)
13190 w1n = w1(1)
13191 w2n = w2(1)
13192 w3n = w3(1)
13193 t0n = 0.0
13194 t1n = t(1)
13195 u0n = u0(1)
13196 f0n = f0(1)
13197 if ( wn .ge. 0.999999 ) then
13198 wn = 0.999999
13199 endif
13200 if ( wn .le. 1.0e-4 ) then
13201 call coefft0 ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
13202 & aa,zz,a1,z1,fk1t,fk2t )
13203 fk1(1) = fk1t
13204 fk2(1) = fk2t
13205 else
13206 call coefft ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
13207 & b,a,d,z,b1,c1,aa,zz,a1,z1,fk1t,fk2t )
13208 fk1(1) = fk1t
13209 fk2(1) = fk2t
13210 endif
13211 do i = 1, 4
13212 z4(i,1) = z1(i)
13213 do j = 1, 4
13214 a4(i,j,1) = a1(i,j)
13215 end do
13216 end do
13217 do i = 1, 2
13218 bx(i) = - zz(i+2,1)
13219 i8 = i + 8
13220 do j = 1, 4
13221 ab(i8-j,j) = aa(i+2,j,1)
13222 end do
13223 end do
13224 do i = 1, 4
13225 wu(i) = zz(i,2)
13226 do j = 1, 4
13227 fu(i,j) = aa(i,j,2)
13228 end do
13229 end do
13230 do k = 2, n
13231 wn = w(k)
13232 w1n = w1(k)
13233 w2n = w2(k)
13234 w3n = w3(k)
13235 t0n = t(k-1)
13236 t1n = t(k)
13237 u0n = u0(k)
13238 f0n = f0(k)
13239 if ( wn .ge. 0.999999 ) then
13240 wn = 0.999999
13241 endif
13242 if ( wn .le. 1.0e-4 ) then
13243 call coefft0 ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
13244 & aa,zz,a1,z1,fk1t,fk2t )
13245 fk1(k) = fk1t
13246 fk2(k) = fk2t
13247 else
13248 call coefft ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
13249 & b,a,d,z,b1,c1,aa,zz,a1,z1,fk1t,fk2t )
13250 fk1(k) = fk1t
13251 fk2(k) = fk2t
13252 endif
13253 do i = 1, 4
13254 z4(i,k) = z1(i)
13255 do j = 1, 4
13256 a4(i,j,k) = a1(i,j)
13257 end do
13258 end do
13259 kf = k + k + k + k
13260 i1 = kf - 5
13261 i2 = i1 + 3
13262 j1 = kf - 7
13263 j2 = j1 + 3
13264 i3 = 0
13265 do i = i1, i2
13266 i3 = i3 + 1
13267 bx(i) = - wu(i3) + zz(i3,1)
13268 j3 = 0
13269 i8 = i + 8
13270 do j = j1, j2
13271 j3 = j3 + 1
13272 ab(i8-j,j) = fu(i3,j3)
13273 end do
13274 j3 = 0
13275 do j = j2 + 1, j2 + 4
13276 j3 = j3 + 1
13277 ab(i8-j,j) = - aa(i3,j3,1)
13278 end do
13279 end do
13280 do i = 1, 4
13281 wu(i) = zz(i,2)
13282 do j = 1, 4
13283 fu(i,j) = aa(i,j,2)
13284 end do
13285 end do
13286 end do
13287 if ( ib .le. mbs ) then
13288 v1 = 0.2113247 * asbs
13289 v2 = 0.7886753 * asbs
13290 v3 = asbs * u0(1) * f0(1) * exp ( - t(n) / u0(1) )
13291 m1 = n4 - 1
13292 m2 = n4
13293 m18 = m1 + 8
13294 m28 = m2 + 8
13295 fw1 = v1 * wu(3)
13296 fw2 = v2 * wu(4)
13297 bx(m1) = - ( wu(1) - fw1 - fw2 - v3 )
13298 bx(m2) = - ( wu(2) - fw1 - fw2 - v3 )
13299 do j = 1, 4
13300 j1 = n4 - 4 + j
13301 fw1 = v1 * fu(3,j)
13302 fw2 = v2 * fu(4,j)
13303 ab(m18-j1,j1) = fu(1,j) - fw1 - fw2
13304 ab(m28-j1,j1) = fu(2,j) - fw1 - fw2
13305 end do
13306 else
13307 v1 = 0.2113247 * ( 1.0 - ee )
13308 v2 = 0.7886753 * ( 1.0 - ee )
13309 v3 = asbs
13310 m1 = n4 - 1
13311 m2 = n4
13312 m18 = m1 + 8
13313 m28 = m2 + 8
13314 fw1 = v1 * wu(3)
13315 fw2 = v2 * wu(4)
13316 bx(m1) = - ( wu(1) - fw1 - fw2 - v3 )
13317 bx(m2) = - ( wu(2) - fw1 - fw2 - v3 )
13318 do j = 1, 4
13319 j1 = n4 - 4 + j
13320 fw1 = v1 * fu(3,j)
13321 fw2 = v2 * fu(4,j)
13322 ab(m18-j1,j1) = fu(1,j) - fw1 - fw2
13323 ab(m28-j1,j1) = fu(2,j) - fw1 - fw2
13324 end do
13325 endif
13326 call qcfel (nv,nv1,ab,bx,xx)
13327 do k = 1, n
13328 j = k + k + k + k - 4
13329 do i = 1, 4
13330 j = j + 1
13331 g4(i,k) = xx(j)
13332 end do
13333 end do
13334 return
13335 end subroutine
13338 !c **********************************************************************
13339 subroutine qcfel (nv, nv1, ab, b, x)
13340 !c **********************************************************************
13341 !c 1. `qcfel' is the abbreviation of ` qiu constants for each layer'.
13342 !c 2. The inhomogeneous atmosphere is divided into n adjacent homogeneous
13343 !c layers where the single scattering properties are constant in each
13344 !c layer and allowed to vary from one to another. Delta-four-stream is
13345 !c employed for each homogeneous layer. The boundary conditions at the
13346 !c top and bottom of the atmosphere, together with continuity condi-
13347 !c tions at layer interfaces lead to a system of algebraic equations
13348 !c from which 4*n unknown constants in the problom can be solved.
13349 !c 3. This subroutine is used for solving the 4*n unknowns of A *X = B by
13350 !c considering the fact that the coefficient matrix is a sparse matrix
13351 !c with the precise pattern in this special problom.
13352 !c 4. The method is not different in principle from the general scheme of
13353 !c Gaussian elimination with backsubstitution, but carefully optimized
13354 !c so as to minimize arithmetic operations. Partial pivoting is used
13355 !c to quarantee method's numerical stability, which will not change
13356 !c the basic pattern of sparsity of the matrix.
13357 !c 5. Scaling special problems so as to make its nonzero matrix elements
13358 !c have comparable magnitudes, which will ameliorate the stability.
13359 !c 6. a, b and x present A, B and X in A*X=B, respectively. and n4=4*n.
13360 !c 7. AB(13,4*n) is the matrix A in band storage, in rows 3 to 13; rows 1
13361 !c and 2 and other unset elements should be set to zero on entry.
13362 !c 8. The jth column of A is stored in the jth column of the array AB as
13363 !c follows:
13364 !c AB(8+i-j,j) = A(i,j) for max(1,j-5) <= i <= min(4*n,j+5).
13365 !c Reversedly, we have
13366 !c A(ii+jj-8,jj) = AB(ii,jj).
13367 !c **********************************************************************
13368 !# include "para.file"
13369 USE PARA_FILE
13370 implicit none
13372 integer :: nv, nv1
13373 real :: ab(13,nv * 4), b(nv * 4), x(nv * 4)
13374 integer :: i, j, k, l, m, n, &
13375 & i0, i0f, i0m1, im1, ifq, k44, &
13376 & m1f, m1, m2, m3, m4, m18, m28, m38, m48, &
13377 & n1, n2, n3, n4, n44
13378 real :: p, t, xx, yy
13380 n = nv
13381 n4 = nv * 4
13382 do k = 1, n - 1
13383 k44 = 4 * k - 4
13384 do l= 1, 4
13385 m1 = k44 + l
13386 p = 0.0
13387 do i = 8, 14 - l
13388 if ( abs ( ab(i,m1) ) .gt. abs ( p ) ) then
13389 p = ab(i,m1)
13390 i0 = i
13391 endif
13392 10 end do
13393 i0m1 = i0 + m1
13394 m18 = m1 + 8
13395 if ( i0 .ne. 8 ) then
13396 do j = m1, m1 + 8 - l
13397 i0f = i0m1 - j
13398 m1f = m18 - j
13399 t = ab(i0f,j)
13400 ab(i0f,j) = ab(m1f,j)
13401 ab(m1f,j) = t
13402 15 end do
13403 i0f = i0m1 - 8
13404 t = b(i0f)
13405 b(i0f) = b(m1)
13406 b(m1) = t
13407 20 end if
13408 yy = ab(8,m1)
13409 ab(8,m1) = 1.0
13410 do j = m1 + 1, m1 + 8 - l
13411 m1f = m18 - j
13412 ab(m1f,j) = ab(m1f,j) / yy
13413 25 end do
13414 b(m1) = b(m1) / yy
13415 do i = 9, 14 - l
13416 xx = ab(i,m1)
13417 ab(i,m1) = 0.0
13418 im1 = i + m1
13419 do j = m1 + 1, m1 + 8 - l
13420 ifq = im1 - j
13421 m1f = m18 - j
13422 ab(ifq,j) = ab(ifq,j) - ab(m1f,j) * xx
13423 35 end do
13424 ifq = im1 - 8
13425 b(ifq) = b(ifq) - b(m1) * xx
13426 30 end do
13427 3 end do
13428 5 end do
13429 n44 = n4 - 4
13430 do l = 1, 3
13431 m1 = n44 + l
13432 p = 0.0
13433 do i = 8, 12 - l
13434 if ( abs ( ab(i,m1) ) .gt. abs ( p ) ) then
13435 p = ab(i,m1)
13436 i0 = i
13437 endif
13438 45 end do
13439 i0m1 = i0 + m1
13440 m18 = m1 + 8
13441 if( i0 .ne. 8 ) then
13442 do j = m1, m1 + 4 - l
13443 i0f = i0m1 - j
13444 m1f = m18 - j
13445 t = ab(i0f,j)
13446 ab(i0f,j) = ab(m1f,j)
13447 ab(m1f,j) = t
13448 50 end do
13449 i0f = i0m1 - 8
13450 t = b(i0f)
13451 b(i0f) = b(m1)
13452 b(m1) = t
13453 55 end if
13454 yy = ab(8,m1)
13455 ab(8,m1) = 1.0
13456 do j = m1 + 1, m1 + 4 - l
13457 m1f = m18 - j
13458 ab(m1f,j) = ab(m1f,j) / yy
13459 60 end do
13460 b(m1) = b(m1) / yy
13461 do i = 9, 12 - l
13462 xx = ab(i,m1)
13463 ab(i,m1) = 0.0
13464 im1 = i + m1
13465 do j = m1 + 1, m1 + 4 - l
13466 ifq = im1 - j
13467 m1f = m18 - j
13468 ab(ifq,j) = ab(ifq,j) - ab(m1f,j) * xx
13469 70 end do
13470 ifq = im1 - 8
13471 b(ifq) = b(ifq) - b(m1) * xx
13472 65 end do
13473 40 end do
13474 yy = ab(8,n4)
13475 ab(8,n4) = 1.0
13476 b(n4) = b(n4) / yy
13477 n3 = n4 - 1
13478 n2 = n3 - 1
13479 n1 = n2 - 1
13480 x(n4) = b(n4)
13481 x(n3) = b(n3) - ab(7,n4) * x(n4)
13482 x(n2) = b(n2) - ab(7,n3) * x(n3) - ab(6,n4) * x(n4)
13483 x(n1) = b(n1) - ab(7,n2) * x(n2) - ab(6,n3) * x(n3) - &
13484 & ab(5,n4) * x(n4)
13485 do k = 1, n - 1
13486 m4 = 4 * ( n - k )
13487 m3 = m4 - 1
13488 m2 = m3 - 1
13489 m1 = m2 - 1
13490 m48 = m4 + 8
13491 m38 = m3 + 8
13492 m28 = m2 + 8
13493 m18 = m1 + 8
13494 x(m4) = b(m4)
13495 do m = m4 + 1, m4 + 4
13496 x(m4) = x(m4) - ab(m48-m,m) * x(m)
13497 85 end do
13498 x(m3) = b(m3)
13499 do m = m3 + 1, m3 + 5
13500 x(m3) = x(m3) - ab(m38-m,m) * x(m)
13501 90 end do
13502 x(m2) = b(m2)
13503 do m = m2 + 1, m2 + 6
13504 x(m2) = x(m2) - ab(m28-m,m) * x(m)
13505 95 end do
13506 x(m1) = b(m1)
13507 do m = m1 + 1, m1 + 7
13508 x(m1) = x(m1) - ab(m18-m,m) * x(m)
13509 100 end do
13510 80 end do
13511 return
13512 end subroutine
13514 !c **********************************************************************
13515 !c In this subroutine, we incorporate a delta-function adjustment to
13516 !c account for the forward diffraction peak in the context of the
13517 !c four-stream or two stream approximations ( Liou, Fu and Ackerman, &
13518 !c 1988 ). The w1(n), w2(n), w3(n), w(n), and t(n) are the adjusted
13519 !c parameters.
13520 !c **********************************************************************
13521 subroutine adjust ( nv, nv1, ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
13522 !# include "para.file"
13523 USE PARA_FILE
13524 USE control_para, dfsasl=>d4s, dtsasl=>d2s, dfsair=>d4ir, dtsair=>d2ir
13525 implicit none
13527 integer :: nv, nv1
13528 real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
13529 real, intent(out), dimension(nv) :: w1, w2, w3, w, t
13530 real, dimension(nv) :: dtt, dt
13531 integer :: n, i
13532 real :: tt0, f, fw
13534 n = nv
13535 tt0 = 0.0
13536 do i = 1, n
13537 ! 11/4/95 (begin)
13538 if ( dfsasl .or. dfsair ) then
13539 f = ww4(i) / 9.0
13540 else
13541 f = ww2(i) / 5.0
13542 endif
13543 ! 11/4/95 (end)
13544 ! - clear
13545 fw = 1.0 - f * ww(i)
13546 w1(i) = ( ww1(i) - 3.0 * f ) / ( 1.0 - f )
13547 w2(i) = ( ww2(i) - 5.0 * f ) / ( 1.0 - f )
13548 w3(i) = ( ww3(i) - 7.0 * f ) / ( 1.0 - f )
13549 w(i) = ( 1.0 - f ) * ww(i) / fw
13550 dtt(i) = tt(i) - tt0
13551 tt0 = tt(i)
13552 dt(i) = dtt(i) * fw
13553 10 end do
13554 t(1) = dt(1)
13555 do i = 2, n
13556 t(i) = dt(i) + t(i-1)
13557 20 end do
13558 return
13559 end subroutine
13561 !c **********************************************************************
13562 !c The delta-four-stream approximation for nonhomogeneous atmospheres
13563 !c in the solar wavelengths (Fu, 1991). The input parameters are nv, &
13564 !c nv1, and nv * 4 through 'para.file', ib, as, u0, f0 for solar and
13565 !c ib, bf, bs, ee for IR through arguments of 'qfts' and 'qfti', and
13566 !c ww1(nv), ww2(nv), ww3(nv), ww4(nv), ww(nv), and tt(nv)
13567 !c through common statement 'dfsin'.
13568 !c **********************************************************************
13570 !c amontornes-bcodina (2014-04-29): this line modified to introduce the direct and diffuse fluxes
13571 subroutine qfts ( nv, nv1, ib,as,u0,f0,ww1,ww2,ww3,ww4,ww,tt,ffu,ffd,ffddir,ffdif )
13572 !# include "para.file"
13573 USE PARA_FILE
13574 ! common /dis/ a(4)
13575 ! common /point/ u(4)
13576 implicit none
13577 integer :: nv, nv1
13578 integer, intent(in) :: ib
13579 real, intent(in) :: as, u0, f0
13580 real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
13581 real, intent(out), dimension(nv1) :: ffu, ffd
13582 !c amontornes-bcodina (2014-04-29): this line was added to introduce the direct and diffuse fluxes
13583 real, intent(out), dimension(nv1) :: ffddir,ffdif
13584 real, dimension(nv) :: w1, w2, w3, w4, w, t, u0a, f0a
13585 real :: fk1(nv), fk2(nv), a4(4,4,nv), &
13586 & z4(4,nv), g4(4,nv)
13587 integer :: i, n, m, k, ii,jj
13588 real :: asbs, ee, fw1, fw2, fw3, fw4, y, y1, x(4), fi(4)
13590 n = nv
13591 m = nv1
13592 ee = 0.0
13593 asbs = as
13594 call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
13595 do i = 1, n
13596 u0a(i) = u0
13597 f0a(i) = f0
13598 5 end do
13599 call qcfe ( nv,nv1,ib,asbs,ee,w1,w2,w3,w,t,u0a,f0a, &
13600 & fk1,fk2,a4,z4,g4 )
13601 fw1 = 0.6638961
13602 fw2 = 2.4776962
13603 fw3 = u0 * 3.14159 * f0
13604 do i = 1, m
13605 if ( i .eq. 1 ) then
13606 x(1) = 1.0
13607 x(2) = 1.0
13608 x(3) = exp ( - fk1(1) * t(1) )
13609 x(4) = exp ( - fk2(1) * t(1) )
13610 k = 1
13611 y = 1.0
13612 elseif ( i .eq. 2 ) then
13613 x(1) = exp ( - fk2(1) * t(1) )
13614 x(2) = exp ( - fk1(1) * t(1) )
13615 x(3) = 1.0
13616 x(4) = 1.0
13617 k = 1
13618 y = exp ( - t(1) / u0 )
13619 else
13620 k = i - 1
13621 y1 = t(k) - t(k-1)
13622 x(1) = exp ( - fk2(k) * y1 )
13623 x(2) = exp ( - fk1(k) * y1 )
13624 x(3) = 1.0
13625 x(4) = 1.0
13626 y = exp ( - t(k) / u0 )
13627 endif
13628 do jj = 1, 4
13629 fi(jj) = z4(jj,k) * y
13630 37 end do
13631 do ii = 1, 4
13632 fw4 = g4(ii,k) * x(ii)
13633 do jj = 1, 4
13634 fi(jj) = fi(jj) + a4(jj,ii,k) * fw4
13635 45 end do
13636 40 end do
13637 ffu(i)= fw1 * fi(2) + fw2 * fi(1)
13638 ffd(i)= fw1 * fi(3) + fw2 * fi(4) + fw3 * y
13639 !c amontornes-bcodina (2014-04-29): save direct and diffuse terms
13640 ffddir(i) = fw3 * y ! amontornes-bcodina Direct downward flux
13641 ffdif(i) = ffd(i)-ffddir(i) ! amontornes-bcodina Diffuse downward flux
13642 10 end do
13643 return
13644 end subroutine
13646 !c **********************************************************************
13647 !c The exponential approximation for the Planck function in optical depth
13648 !c is used for the infrared ( Fu, 1991). Since the direct solar radiation
13649 !c source has an exponential function form in terms of optical depth, the
13650 !c formulation of the delta-four-stream approximation for infrared wave-
13651 !c lengths is the same as that for solar wavelengths.
13652 !c **********************************************************************
13653 subroutine qfti ( nv, nv1, ib,ee,bf,bs,ww1,ww2,ww3,ww4,ww,tt,ffu,ffd )
13654 !# include "para.file"
13655 USE PARA_FILE
13656 implicit none
13657 integer :: nv, nv1
13658 integer, intent(in) :: ib
13659 real, intent(in) :: ee, bf(nv1), bs
13660 real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
13661 real, intent(out), dimension(nv1) :: ffu, ffd
13662 real, dimension(nv) :: w1, w2, w3, w, t, u0, f0
13663 integer :: n, m, i, ii, jj, k
13664 real :: asbs, t0, deltau, q1, q2, fw1, fw2, fw3, xy, y1
13665 real :: x(4), fi(4)
13666 real :: fk1(nv), fk2(nv), a4(4,4,nv), &
13667 & z4(4,nv), g4(4,nv)
13669 n = nv
13670 m = nv1
13671 asbs = bs * ee
13672 call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
13673 t0 = 0.0
13674 do i = 1, n
13675 q1 = alog ( bf(i+1) / bf(i) )
13676 ! -- change by Yu Gu, 11/13/01
13677 deltau = t(i) -t0
13678 if (deltau .lt. 1.e-12) deltau = 1.e-12
13679 q2 = 1.0 / deltau
13680 ! q2 = 1.0 / ( t(i) - t0 )
13681 ! --change over
13683 f0(i) = 2.0 * ( 1.0 - w(i) ) * bf(i)
13684 if ( abs(q1) .le. 1.0e-10 ) then
13685 u0(i) = - 1.0e+10 / q2
13686 else
13687 u0(i) = - 1.0 / ( q1 * q2 )
13688 endif
13689 ! --------- 4/2/97 (5)
13690 if (abs(u0(i)) .gt. 4.25E+09) then
13691 if (u0(i) .lt. 0.0) then
13692 u0(i) = -4.25E+09
13693 else
13694 u0(i) = 4.25E+09
13695 end if
13696 end if
13697 ! --------- 4/2/97 (5)
13699 t0 = t(i)
13700 3 end do
13701 call qcfe ( nv,nv1,ib,asbs,ee,w1,w2,w3,w,t,u0,f0,fk1,fk2,a4,z4,g4 )
13702 fw1 = 0.6638958
13703 fw2 = 2.4776962
13704 do i = 1, m
13705 if ( i .eq. 1 ) then
13706 x(1) = 1.0
13707 x(2) = 1.0
13708 x(3) = exp ( - fk1(1) * t(1) )
13709 x(4) = exp ( - fk2(1) * t(1) )
13710 k = 1
13711 xy = 1.0
13712 elseif ( i .eq. 2 ) then
13713 x(1) = exp ( - fk2(1) * t(1) )
13714 x(2) = exp ( - fk1(1) * t(1) )
13715 x(3) = 1.0
13716 x(4) = 1.0
13717 k = 1
13718 xy = exp ( - t(1) / u0(1) )
13719 else
13720 k = i - 1
13721 y1 = t(k) - t(k-1)
13722 x(1) = exp ( - fk2(k) * y1 )
13723 x(2) = exp ( - fk1(k) * y1 )
13724 x(3) = 1.0
13725 x(4) = 1.0
13726 xy = exp ( - y1 / u0(k) )
13727 endif
13728 do jj = 1, 4
13729 fi(jj) = z4(jj,k) * xy
13730 37 end do
13731 do ii = 1, 4
13732 fw3 = g4(ii,k) * x(ii)
13733 do jj = 1, 4
13734 fi(jj) = fi(jj) + a4(jj,ii,k) * fw3
13735 45 end do
13736 40 end do
13737 ffu(i)= fw1 * fi(2) + fw2 * fi(1)
13738 ffd(i)= fw1 * fi(3) + fw2 * fi(4)
13739 10 end do
13740 return
13741 end subroutine
13744 !c 11/4/95 (begin)
13745 subroutine cfgts0 ( ib, w, w1, t0, t1, u0, f0, &
13746 & gamma1, gamma2, gamma3, gamma4, ugts1 )
13747 !c **********************************************************************
13748 !c This subroutine is used to calculate the Coefficients For Generalized
13749 !c Two-Stream scheme. We can make choices between Eddington, quadrature
13750 !c and hemispheric mean schemes through logical variables 'edding', &
13751 !c 'quadra', and 'hemisp'. The Eddington and quadrature schemes are
13752 !c discussed in detail by Liou (1992). The hemispheric mean scheme is
13753 !c derived by assuming that the phase function is equal to 1 + g in the
13754 !c forward scattering hemisphere and 1 - g in the backward scattering
13755 !c hemisphere where g is the asymmetry factor. The hemispheric mean is
13756 !c only used for infrared wavelengths (Toon et al. 1989).
13757 !c **********************************************************************
13758 !# include "para.file"
13759 USE PARA_FILE
13760 USE control_para
13761 implicit none
13763 integer, intent(in) :: ib
13764 real, intent(in) :: w, w1, t0, t1, u0, f0
13765 real, intent(out) :: gamma1, gamma2, gamma3, gamma4, ugts1
13766 real x, y, z
13768 if ( edding ) then
13769 x = 0.25 * w1
13770 y = w * x
13771 gamma1 = 1.75 - w - y
13772 gamma2 = - 0.25 + w - y
13773 gamma3 = 0.0
13774 gamma4 = 0.0
13775 if ( ib .le. mbs ) then
13776 gamma3 = 0.5 - x * u0
13777 gamma4 = 1.0 - gamma3
13778 endif
13779 ugts1 = 0.5
13780 endif
13781 if ( quadra ) then
13782 x = 0.866 * w
13783 y = 0.2887 * w1
13784 z = y * w
13785 gamma1 = 1.732 - x - z
13786 gamma2 = x - z
13787 gamma3 = 0.0
13788 gamma4 = 0.0
13789 if ( ib .le. mbs ) then
13790 gamma3 = 0.5 - y * u0
13791 gamma4 = 1.0 - gamma3
13792 endif
13793 ugts1 = 0.57735
13794 endif
13795 if ( hemisp ) then
13796 x = w * w1 / 3.0
13797 gamma1 = 2.0 - w - x
13798 gamma2 = w - x
13799 gamma3 = 0.0
13800 gamma4 = 0.0
13801 ugts1 = 0.5
13802 endif
13803 return
13804 end subroutine
13807 subroutine cfgts ( ib, w, w1, t0, t1, u0, f0, &
13808 & lamda,gamma,cadd0,cadd1,cmin0,cmin1,g1g2 )
13809 !c **********************************************************************
13810 !c This subroutine is used to calculate the Coefficients For Generalized
13811 !c Two-Stream scheme.
13812 !c **********************************************************************
13813 !# include "para.file"
13814 USE PARA_FILE
13815 implicit none
13817 integer, intent(in) :: ib
13818 real, intent(in) :: w, w1, t0, t1, u0, f0
13819 real :: lamda, gamma, cadd0, cadd1, cmin0, cmin1, g1g2
13820 real :: gamma1, gamma2, gamma3, gamma4, ugts1
13821 real :: fq, alfa, beta, fw, x, z
13823 call cfgts0 ( ib, w, w1, t0, t1, u0, f0, &
13824 & gamma1, gamma2, gamma3, gamma4, ugts1 )
13825 lamda = sqrt ( ( gamma1 + gamma2 ) * ( gamma1 - gamma2 ) )
13826 gamma = gamma2 / ( gamma1 + lamda )
13827 g1g2 = gamma1 + gamma2
13828 fq = 1.0 / u0
13829 if ( ib .le. mbs ) then
13830 alfa = gamma3
13831 beta = gamma4
13832 fw = 3.1415927 * f0 * w * exp ( - fq * t0 )
13833 else
13834 alfa = 1.0
13835 beta = 1.0
13836 fw = 3.1415927 * f0
13837 endif
13838 x = exp ( - fq * ( t1 - t0 ) )
13839 z = lamda * lamda - fq * fq
13840 ! -- change by Yu Gu, 11/15/01; changed back in 3.5
13841 if (abs(z).lt.1.e-4) then
13842 if (z.ge.0.) z = 1.e-4
13843 if (z.lt.0.) z = -1.e-4
13844 endif
13845 ! -- the following line is commented out in 3.5
13846 ! if(abs(z).le.1.e-4) z = 1.e-4
13847 ! -- cgange over
13848 cadd0 = fw * ( ( gamma1 - fq ) * alfa + &
13849 & beta * gamma2 ) / z
13850 cmin0 = fw * ( ( gamma1 + fq ) * beta + &
13851 & alfa * gamma2 ) / z
13852 cadd1 = cadd0 * x
13853 cmin1 = cmin0 * x
13854 return
13855 end subroutine
13858 subroutine qccgts ( nv, nv1, ib, asbs, ee, &
13859 & w1,w2,w3,w,t,u0,f0, &
13860 & lamdan,gamman,caddn,cminn, &
13861 & caddn0,cminn0,aa,bb,expn,g1g2n )
13862 !c **********************************************************************
13863 !c In the solar band asbs is the surface albedo, while in the infrared
13864 !c band asbs is blackbody intensity emitted at the surface temperature
13865 !c times surface emissivity. In this subroutine, the generalized two-
13866 !c stream is applied to nonhomogeneous atmospheres. ee is the IR surface
13867 !c emissivity.
13868 !c **********************************************************************
13869 !# include "para.file"
13870 USE PARA_FILE
13871 implicit none
13872 integer :: nv, nv1
13873 integer, intent(in) :: ib
13874 real, intent(in) :: asbs, ee
13875 real, intent(in), dimension(nv) :: w1, w2, w3, w, t, u0, f0
13876 real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
13877 & caddn0, cminn0, aa, bb, expn, g1g2n
13878 integer :: ibn, k ,k1, k2
13879 real :: wn, w1n, t0n, t1n, u0n, f0n, rsfc, ssfc, wm1, wm2
13880 real, dimension(nv) :: xn, yn, zn
13881 real, dimension(nv * 2) :: a, b, c, r, u, gam
13883 ibn = ib
13884 do k = 1, nv
13885 wn = w(k)
13886 w1n = w1(k)
13887 if ( k .eq. 1 ) then
13888 t0n = 0.0
13889 else
13890 t0n = t(k-1)
13891 endif
13892 t1n = t(k)
13893 u0n = u0(k)
13894 f0n = f0(k)
13895 if ( wn .ge. 0.999999 ) then
13896 wn = 0.999999
13897 endif
13898 call cfgts ( ib, wn, w1n, t0n, t1n, u0n, f0n, &
13899 & lamdan(k), gamman(k), caddn0(k), caddn(k), &
13900 & cminn0(k), cminn(k), g1g2n(k) )
13901 expn(k) = exp ( - lamdan(k) * ( t1n - t0n ) )
13902 xn(k) = gamman(k) * expn(k)
13903 yn(k) = ( expn(k) - gamman(k) ) / ( xn(k) - 1.0 )
13904 zn(k) = ( expn(k) + gamman(k) ) / ( xn(k) + 1.0 )
13905 40 end do
13906 a(1) = 0.0
13907 b(1) = xn(1) + 1.0
13908 c(1) = xn(1) - 1.0
13909 r(1) = - cminn0(1)
13910 do k = 1, nv - 1
13911 k1 = k + k
13912 k2 = k + k + 1
13913 a(k1) = 1.0 + xn(k) - yn(k+1) * ( gamman(k) + expn(k) )
13914 b(k1) = 1.0 - xn(k) - yn(k+1) * ( gamman(k) - expn(k) )
13915 c(k1) = yn(k+1) * ( 1.0 + xn(k+1) ) - expn(k+1) - gamman(k+1)
13916 r(k1) = caddn0(k+1) - caddn(k) - yn(k+1) * &
13917 & ( cminn0(k+1) - cminn(k) )
13918 a(k2) = gamman(k) - expn(k) - zn(k) * ( 1.0 - xn(k) )
13919 b(k2) = -1.0 - xn(k+1) + zn(k) * ( expn(k+1) + gamman(k+1) )
13920 c(k2) = zn(k) * ( expn(k+1) - gamman(k+1) ) - xn(k+1) + 1.0
13921 r(k2) = cminn0(k+1) - cminn(k) - zn(k) * &
13922 & ( caddn0(k+1) - caddn(k) )
13923 50 end do
13924 if ( ib .le. mbs ) then
13925 rsfc = asbs
13926 ssfc = 3.1415927 * u0(1) * exp(-t(nv)/u0(1)) * rsfc * &
13927 & f0(1)
13928 else
13929 rsfc = 1.0 - ee
13930 ssfc = 3.1415927 * asbs
13931 endif
13932 wm1 = 1.0 - rsfc * gamman(nv)
13933 wm2 = xn(nv) - rsfc * expn(nv)
13934 a(nv * 2) = wm1 + wm2
13935 b(nv * 2) = wm1 - wm2
13936 c(nv * 2) = 0.0
13937 r(nv * 2) = rsfc * cminn(nv) - caddn(nv) + ssfc
13938 ! test
13939 ! write(0,*) 'a,b,gam=',a, b, gam
13940 ! write(0,*) 'rsfc,gamman, xn, expn=',rsfc,gamman,xn,expn
13941 call tridag ( a, b, c, r, u, gam, nv * 2 )
13942 do k = 1, nv
13943 k1 = k + k - 1
13944 k2 = k + k
13945 aa(k) = u(k1) + u(k2)
13946 bb(k) = u(k1) - u(k2)
13947 60 end do
13948 return
13949 end subroutine
13952 subroutine tridag ( a, b, c, r, u, gam, n )
13953 !c **********************************************************************
13954 !c
13955 !c | b1 c1 0 ... | | u1 | | r1 |
13956 !c | a2 b2 c2 ... | | u2 | | r2 |
13957 !c | ... | . | . | = | . |
13958 !c | ... an-1 bn-1 cn-1 | | un-1 | | rn-1 |
13959 !c | 0 an bn | | un | | rn |
13960 !c
13961 !c This subroutine solves for a vector U of length N the tridiagonal
13962 !c linear set given by above equation. A, B, C and R are input vectors
13963 !c and are not modified (Numerical Recipes by Press et al. 1989).
13964 !c **********************************************************************
13965 implicit none
13966 integer :: n
13967 real, dimension(n) :: a, b, c, r, u, gam
13968 integer :: i, j
13969 real :: bet
13970 ! if ( b(1) .eq. 0. ) pause
13971 if ( b(1) .eq. 0. ) then
13972 CALL wrf_error_fatal('subroutine tridag failed. Stop program') !mchen
13973 endif
13974 ! If this happens then you should rewrite your equations as a set of
13975 ! order n-1, with u2 trivially eliminated.
13976 bet = b(1)
13977 u(1) = r(1) / bet
13979 ! Decomposition and forward substitution
13980 do j = 2, n
13981 gam(j) = c(j-1) / bet
13982 bet = b(j) - a(j) * gam(j)
13983 ! if ( bet .eq. 0. ) pause
13984 if ( bet .eq. 0. ) then
13985 CALL wrf_error_fatal('subroutine tridag failed. Stop program') !mchen
13986 endif
13988 ! Algorithm fails; see Numerical Recipes.
13989 u(j) = ( r(j) - a(j) * u(j-1) ) / bet
13990 11 end do
13991 ! Backsubstitution
13992 do j = n - 1, 1, -1
13993 u(j) = u(j) - gam(j+1) * u(j+1)
13994 12 end do
13995 return
13996 end subroutine
13999 subroutine qftsts ( nv, nv1, ib, as_in, u0, f0, &
14000 & ww1,ww2,ww3,ww4,ww,tt, &
14001 & ffu,ffd )
14002 !c **********************************************************************
14003 !c The generalized two stream approximation for nonhomgeneous atmospheres
14004 !c in the solar wavelengths. The input parameters are those through
14005 !c 'para.file', through argument of 'qftsts' and through common statement
14006 !c 'dfsin' and 'gtslog'.
14007 !c **********************************************************************
14008 !# include "para.file"
14009 USE PARA_FILE
14010 implicit none
14011 integer :: nv, nv1
14012 integer, intent(in) :: ib
14013 real, intent(in) :: as_in, u0, f0
14014 real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
14015 real, dimension(nv) :: w1, w2, w3, w, t, u0a, f0a
14016 real, intent(out), dimension(nv1) :: ffu, ffd
14017 real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
14018 & caddn0, cminn0, aa, bb, expn, g1g2n
14019 integer :: n, m, k, i
14020 real :: ee, asbs, fw3, xx, yy(nv)
14022 n = nv
14023 m = nv1
14024 ee = 0.0
14025 asbs = as_in
14026 call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
14027 do i = 1, n
14028 u0a(i) = u0
14029 f0a(i) = f0
14030 5 end do
14031 call qccgts ( nv,nv1,ib, asbs, ee, &
14032 & w1,w2,w3,w,t,u0a,f0a, &
14033 & lamdan,gamman,caddn,cminn, &
14034 & caddn0,cminn0,aa,bb,expn,g1g2n )
14035 fw3 = u0 * 3.1415927 * f0
14036 do k = 1, nv
14037 yy(k) = exp(-t(k)/u0)
14038 enddo
14039 xx = aa(1) * expn(1)
14040 ffu(1) = xx + gamman(1) * bb(1) + caddn0(1)
14041 ffd(1) = gamman(1) * xx + bb(1) + cminn0(1) + fw3
14042 do i = 2, m
14043 k = i - 1
14044 xx = bb(k) * expn(k)
14045 ffu(i) = aa(k) + gamman(k) * xx + caddn(k)
14046 ffd(i) = gamman(k) * aa(k) + xx + cminn(k) + fw3 * yy(k)
14047 10 end do
14048 return
14049 end subroutine
14052 subroutine qftits ( nv, nv1, ib, as_in, f0, u0, &
14053 & ww1,ww2,ww3,ww4,ww,tt, &
14054 & ffu,ffd )
14055 !c **********************************************************************
14056 !c The exponential approximation for the Planck function in optical depth
14057 !c is used for the infrared ( Fu, 1991). Since the direct solar radiation
14058 !c source has an exponential function form in terms of optical depth, the
14059 !c formulation of generalized two stream approximation for infrared wave
14060 !c lengths is the same as that for solar wavelengths.
14061 !c The generalized two stream approximation for nonhomgeneous atmospheres
14062 !c in the infrared wavelengths. The input parameters are those through
14063 !c 'para.file', through argument of 'qftits' and through common statement
14064 !c 'dfsin', 'gtslog', and 'planci'.
14065 !c **********************************************************************
14066 !# include "para.file"
14067 USE PARA_FILE
14068 implicit none
14069 integer :: nv, nv1
14070 integer, intent(in) :: ib
14071 real, intent(in) :: as_in
14072 real, dimension(nv) :: f0, u0
14073 real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
14074 real, dimension(nv) :: w1, w2, w3, w, t, u0a, f0a
14075 real, intent(out), dimension(nv1) :: ffu, ffd
14076 real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
14077 & caddn0, cminn0, aa, bb, expn, g1g2n
14078 integer :: n, m, k, i
14079 real :: asbs, fw3, xx, yy(nv), t0, q1, q2, deltau
14080 real :: ee, bf(nv1), bs
14082 n = nv
14083 m = nv1
14084 asbs = bs * ee
14085 call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
14086 t0 = 0.0
14087 do i = 1, n
14088 q1 = alog ( bf(i+1) / bf(i) )
14089 ! -- change by Yu Gu, 11/13/01
14090 deltau = t(i) -t0
14091 if (deltau .lt. 1.e-12) deltau = 1.e-12
14092 q2 = 1.0 / deltau
14093 ! q2 = 1.0 / ( t(i) - t0 )
14094 ! --change over
14096 f0(i) = 2.0 * ( 1.0 - w(i) ) * bf(i)
14097 if ( abs(q1) .le. 1.0e-10 ) then
14098 u0(i) = - 1.0e+10 / q2
14099 else
14100 u0(i) = - 1.0 / ( q1 * q2 )
14101 endif
14102 t0 = t(i)
14103 3 end do
14104 call qccgts ( nv,nv1,ib, asbs, ee, &
14105 & w1,w2,w3,w,t,u0a,f0a, &
14106 & lamdan,gamman,caddn,cminn, &
14107 & caddn0,cminn0,aa,bb,expn,g1g2n )
14108 xx = aa(1) * expn(1)
14109 ffu(1) = xx + gamman(1) * bb(1) + caddn0(1)
14110 ffd(1) = gamman(1) * xx + bb(1) + cminn0(1)
14111 do i = 2, m
14112 k = i - 1
14113 xx = bb(k) * expn(k)
14114 ffu(i) = aa(k) + gamman(k) * xx + caddn(k)
14115 ffd(i) = gamman(k) * aa(k) + xx + cminn(k)
14116 10 end do
14117 return
14118 end subroutine
14121 subroutine qftisf ( nv, nv1, ib, ee, bf, bs, &
14122 & ww1, ww2, ww3, ww4, ww, tt, &
14123 & ffu, ffd )
14124 !c **********************************************************************
14125 !c In this subroutine, the two- and four- stream combination scheme or
14126 !c the source function technique (Toon et al. 1989) is used to calculate
14127 !c the IR radiative fluxes. The exponential approximation for the Planck
14128 !c function in optical depth is used ( Fu, 1991).
14129 !c At IR wavelengths, the two-stream results are not exact in the limit
14130 !c of no scattering. It also introduces large error in the case of sca-
14131 !c ttering. Since the no-scattering limit is of considerable significance
14132 !c at IR wavelengths, we have used the source function technique that
14133 !c would be exact in the limit of the pure absorption and would also en-
14134 !c hance the accuracy of the two-stream approach when scattering occurs
14135 !c in the IR wavelengths.
14136 !c Here, we use nq Gauss points to obtain the fluxes: when nq=2, we use
14137 !c double Gaussian quadrature as in Fu and Liou (1993) for four-stream
14138 !c approximation; when nq = 3, we use the regular Gauss quadrature but
14139 !c u1*w1+u2*w2+u3*w3=1.0.
14140 !c **********************************************************************
14141 !# include "para.file"
14142 USE PARA_FILE
14143 USE control_para, only: quadra
14144 implicit none
14145 integer :: nv, nv1
14146 integer, parameter :: nq = 2
14147 integer :: ib
14148 real :: ee, bf(nv1), bs
14149 real, dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
14150 real, dimension(nv) :: w1, w2, w3, w, t, u0, f0
14151 real, dimension(nv1) :: ffu, ffd
14153 real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
14154 caddn0, cminn0, aa, bb, expn, g1g2n
14155 real, dimension(nv) :: fuq1, fuq2, fg, fh, fj, fk
14156 real, dimension(nv1,nq) :: fiu, fid
14157 integer :: n, m, i, j, i1
14158 real :: ugts1, asbs, t0, q1, q2, deltau, xgy, x, y1, y, z, &
14159 & xx, yy, tempugbeta, tempxxp1, tempxxm1, ugbeta
14160 real :: alfa(nv+1), beta(nv)
14161 real :: fx(nv,nq), fy(nv), fz1(nv,nq), fz2(nv,nq)
14162 real :: ug(nq), wg(nq), ugwg(nq)
14163 !c data ug / 0.238619, 0.661209, 0.932469 /
14164 !c data wg / 0.467914, 0.360762, 0.171324 /
14165 !c data ugwg / 0.109475, 0.233886, 0.156639 /
14166 data ug / 0.2113248, 0.7886752 /
14167 data wg / 0.5, 0.5 /
14168 data ugwg / 0.105662, 0.394338 /
14170 if ( quadra ) then
14171 ugts1 = 0.57735
14172 else
14173 ugts1 = 0.5
14174 endif
14175 n = nv
14176 m = nv1
14177 asbs = bs * ee
14178 call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
14179 t0 = 0.0
14180 do i = 1, n
14181 q1 = alog ( bf(i+1) / bf(i) )
14182 ! -- change by Yu Gu, 11/13/01
14183 deltau = t(i) -t0
14184 if (deltau .lt. 1.e-12) deltau = 1.e-12
14185 q2 = 1.0 / deltau
14186 ! q2 = 1.0 / ( t(i) - t0 )
14187 ! --change over
14189 f0(i) = 2.0 * ( 1.0 - w(i) ) * bf(i)
14190 if ( abs(q1) .le. 1.0e-10 ) then
14191 u0(i) = - 1.0e+10 / q2
14192 else
14193 u0(i) = - 1.0 / ( q1 * q2 )
14194 endif
14195 t0 = t(i)
14196 beta(i) = - 1.0 / u0(i)
14197 enddo
14198 call qccgts ( nv,nv1,ib, asbs, ee, &
14199 & w1,w2,w3,w,t,u0,f0, &
14200 & lamdan,gamman,caddn,cminn, &
14201 & caddn0,cminn0,aa,bb,expn,g1g2n )
14202 do i = 1, n
14203 ! --- change by Yu Gu, 11/15/01; changed back in 3.5
14204 xgy = lamdan(i)*lamdan(i) - beta(i) * beta(i)
14205 if (abs(xgy).lt.1.e-4) then
14206 if (xgy.ge.0.) xgy = 1.e-4
14207 if (xgy.lt.0.) xgy = -1.e-4
14208 endif
14209 ! if(abs(xgy).le.1.e-4) xgy = 1.e-4 !mchen
14210 x = 2.0 * ( 1.0 - w(i) ) * w(i) / xgy
14211 ! x = 2.0 * ( 1.0 - w(i) ) * w(i) / ( lamdan(i) *
14212 ! & lamdan(i) - beta(i) * beta(i) )
14213 ! -- change over
14215 y1 = w1(i) / 3.0
14216 y = 2.0 * ( 1.0 - w(i) * y1 )
14217 z = -y1 * beta(i)
14218 fuq1(i) = x * ( y - z ) + 1.0 - w(i)
14219 fuq2(i) = x * ( y + z ) + 1.0 - w(i)
14220 enddo
14221 do i = 1, n + 1
14222 alfa(i) = 6.2832 * bf(i)
14223 enddo
14224 x = 1.0 / ugts1
14225 do i = 1, n
14226 y = gamman(i) * ( x + lamdan(i) )
14227 z = x - lamdan(i)
14228 fg(i) = aa(i) * z
14229 fh(i) = bb(i) * y
14230 fj(i) = aa(i) * y
14231 fk(i) = bb(i) * z
14232 enddo
14233 do j = 1, nq
14234 fid(1,j) = 0.0
14235 enddo
14236 do j = 1, nq
14237 t0 = 0.0
14238 do i = 2, nv1
14239 i1 = i - 1
14240 fx(i1,j) = exp ( - ( t(i1) - t0 ) / ug(j) )
14241 fy(i1) = expn(i1)
14242 xx = lamdan(i1) * ug(j)
14243 ! --change by Yu Gu, 12/04/01
14244 tempugbeta = ug(j) * beta(i1) + 1.0
14245 tempxxp1 = xx + 1.0
14246 tempxxm1 = xx - 1.0
14247 if (tempugbeta.eq.0.) tempugbeta = 1.e-4
14248 if (tempxxp1.eq.0.) tempxxp1 = 1.e-4
14249 if (tempxxm1.eq.0.) tempxxm1 = 1.e-4
14251 ! if (tempugbeta.eq.0.) tempugbeta = 0.0001
14252 ! if (tempugbeta.eq.0.) tempugbeta = 1.e-4
14253 ! - change over
14254 ! fz1(i1,j) = ( 1.0 - fx(i1,j) * fy(i1) ) / ( xx + 1.0 )
14255 ! fz2(i1,j) = ( fx(i1,j) - fy(i1) ) / ( xx - 1.0 )
14256 fz1(i1,j) = ( 1.0 - fx(i1,j) * fy(i1) ) / ( tempxxp1 )
14257 fz2(i1,j) = ( fx(i1,j) - fy(i1) ) / ( tempxxm1 )
14259 fid(i,j) = fid(i1,j) * fx(i1,j) + fj(i1) * fz1(i1,j) + &
14260 & fk(i1) * fz2(i1,j) + &
14261 & 1.0 / ( tempugbeta ) * &
14262 ! & 1.0 / ( ug(j) * beta(i1) + 1.0 ) *
14263 & ( alfa(i) - alfa(i1) * fx(i1,j) ) * fuq2(i1)
14264 !-- test
14265 ! if (abs(fid(i,j)).gt.1000.) then
14266 ! write(0,*) 'i,j,fid=',i,j,fid(i,j)
14267 ! write(0,*) 'tau b4 adjust=',tt
14268 ! write(0,*) 'tau=',t
14269 ! write(0,*) 'fx=', fx
14270 ! write(0,*) 'fj=', fj
14271 ! write(0,*) 'fz1=', fz1
14272 ! write(0,*) 'fk=', fk
14273 ! write(0,*) 'fz2=', fz2
14274 ! write(0,*) 'tempugbeta=', tempugbeta
14275 ! write(0,*) 'ug=', ug
14276 ! write(0,*) 'beta=', beta
14277 ! write(0,*) 'alfa=', alfa
14278 ! write(0,*) 'fuq2=', fuq2
14279 ! endif
14281 t0 = t(i1)
14282 enddo
14283 enddo
14284 yy = 0.0
14285 do j = 1, nq
14286 yy = yy + ugwg(j) * fid(nv1,j)
14287 enddo
14288 xx = yy * ( 1.0 - ee ) * 2.0 + 6.2831854 * ee * bs
14289 do j = 1, nq
14290 fiu(nv1,j) = xx
14291 enddo
14292 do j = 1, nq
14293 do i = nv1 - 1, 1, -1
14294 ! -- change by Yu Gu, 11/15/01
14295 ugbeta = ug(j)*beta(i)
14296 if (ugbeta.eq.1.) ugbeta = 1.0001
14297 ! -- change over
14299 fiu(i,j) = fiu(i+1,j) * fx(i,j) + fg(i) * fz2(i,j) + &
14300 & fh(i) * fz1(i,j) + &
14301 ! -- change by Yu Gu, 11/15/01
14302 ! & 1.0 / ( ug(j) * beta(i) - 1.0 ) *
14303 & 1.0 / ( ugbeta - 1.0 ) * &
14304 ! -- change over
14305 & ( alfa(i+1) * fx(i,j) - alfa(i) ) * fuq1(i)
14306 !-- test
14307 ! if (abs(fiu(i,j)).gt.1000.) then
14308 ! write(0,*) 'i,j,fiu=',i,j,fiu(i,j)
14309 ! write(0,*) 'fx=', fx
14310 ! write(0,*) 'fg=', fg
14311 ! write(0,*) 'fz1=', fz1
14312 ! write(0,*) 'fh=', fh
14313 ! write(0,*) 'fz2=', fz2
14314 ! write(0,*) 'ugbeta=', ugbeta
14315 ! write(0,*) 'alfa=', alfa
14316 ! write(0,*) 'fuq1=', fuq1
14317 ! endif
14318 enddo
14319 enddo
14320 do i = 1, nv1
14321 ffu(i) = 0.0
14322 ffd(i) = 0.0
14323 enddo
14324 do i = 1, nv1
14325 do j = 1, nq
14326 ffu(i) = ffu(i) + ugwg(j) * fiu(i,j)
14327 ffd(i) = ffd(i) + ugwg(j) * fid(i,j)
14328 enddo
14329 enddo
14330 return
14331 end subroutine
14332 !c 11/4/95 (end)
14335 !=========================================================================
14336 subroutine atau_spline_iaform3(wli,aoti,aotf,wlf,irh,itp)
14337 USE PARA_FILE
14338 USE aot_spect_5, wlo2=>wlo
14339 ! USE aot_spect_25, wlo2=>wlo
14340 ! parameter(nsub=5 ,nfuo=15,nwo=nsub*nfuo)
14341 ! common /aot_spect_5/ wlo2(5,15) , hkas(5,15) ,sflx (5,15)
14342 ! parameter(nsub=25,nfuo=15 ,nwo=nsub*nfuo)
14343 ! common /aot_spect_25/ wlo2(25,15) , hkas(25,15) ,sflx (25,15) !!! Higer resolution Convolution
14344 implicit none
14346 integer :: irh,itp
14347 real, dimension(mxat) :: aoti, wli
14348 real, dimension(nwo) :: aoto, wlo
14349 real, dimension(nsub,nfuo) :: aoto2
14350 real, dimension(15) :: aotf, wlf
14352 integer :: ii, jj, kk, i, j
14353 real :: zord
14355 ! wlo = reshape(wlo2,(/nwo/))
14356 kk=0
14357 do jj=1,nfuo
14358 do ii=1,nsub
14359 kk=kk+1
14360 wlo(kk) = wlo2(ii,jj)
14361 enddo
14362 enddo
14364 call aot_ext &
14365 & (aoti,wli,wlo,aoto,irh,itp)
14367 ! aoto2 = reshape(aoto,(/5,15/))
14368 kk=0
14369 do jj=1,nfuo
14370 do ii=1,nsub
14371 kk=kk+1
14372 aoto2(ii,jj)=aoto(kk)
14373 enddo
14374 enddo
14376 wlf=0.0 ; aotf =0.0
14377 zord = 0.0
14378 do j=1,nfuo
14379 do i = 1,nsub
14380 wlf(j) = wlf(j)+ wlo2(i,j) * hkas(i,j)
14381 aotf(j)= aotf(j)+ aoto2(i,j) * hkas(i,j)
14382 zord = zord + sflx (i,j)*exp(-aoto2(i,j))
14383 enddo
14384 enddo
14386 !- WRITE OUT interpolated AOTs
14388 ! do i=1,nwo
14389 ! write(11) d1,d2,wlo(i),aoto(i),float(irec),log(wlo(i)),log(aoto(i)),float(ityp)
14390 ! enddo
14391 ! print'(A6,f10.3, 3i4)','FLUX= ',zord ,nsub,ityp,irh
14392 return
14393 end subroutine
14395 !----------------------------------------------------------------
14397 subroutine aot_ext (aotin,wlin,wlo,aoto,irh,ityp)
14398 USE PARA_FILE
14399 USE control_para, nwin=>n_atau
14400 USE opac_ext, wlopac=>wl, datopac=>edat
14401 USE mineral_ext, wlt=>wl, datt=>dat
14402 USE dalm_ext, wld=>wl, datd=>dat
14404 implicit none
14406 integer :: irh,ityp
14407 real ,dimension(mxat) :: aotin,wlin
14408 ! real ,allocatable,dimension(-100:100) :: aoti,wlix
14409 real ,dimension(-100:100) :: aoti,wlix
14410 real ,dimension(nwo) :: aoto,wlo
14411 real ,dimension(24) :: wlp,extp
14412 integer :: idtl, nes, nel, nb, nwi, iend, i, nq
14413 integer :: ne = 24
14414 real :: ext_norm1, ext_norm0
14416 ! common /dalm_ext/ wld(24) ,datd(24,8,3)
14417 ! common /mineral_ext/ wlt(24) ,datt(24,4:8)
14418 ! common /opac_ext/ wlopac(24) ,datopac(24,8,9:18)
14419 ! Wavelength MICRONS
14420 ! wlix,aoti = Monotonicly increasing
14422 idtl=-1
14423 if ( ityp >= 1 .and. ityp <=3 )then ! d'Almedia
14424 wlp = wld
14425 extp = datd(1:24,irh,ityp)
14426 idtl=1
14427 elseif ( ityp >=4 .and. ityp <= 8) then ! Tegen&Lacis
14428 wlp = wlt
14429 extp = datt(1:24,ityp)
14430 idtl=2
14431 elseif ( ityp >=9 .and. ityp <= 18) then ! OPAC
14432 wlp = wlopac
14433 if (ityp==10 .or. ityp==12 .or.ityp==13 .or.ityp==18 ) then
14434 extp = datopac(1:24,irh,ityp)
14435 else
14436 extp = datopac(1:24, 1,ityp)
14437 endif
14438 idtl=3
14439 else
14440 CALL wrf_error_fatal('Bad Aerosol type. Stop program') !mchen
14441 endif
14444 ! wavelength-dependent parameters
14445 if(nwin==1)then
14446 ! nes=-3; nel=19 ! 1 chan @ 500nm
14447 if(wlin(1)<=.325.or.wlin(1)>=.675) &
14448 & CALL wrf_error_fatal('OUT OF ALLOWABLE ARANGE. STOP program') !mchen
14449 nes=-(wlin(1)-0.325)/0.05;
14450 if(idtl==3) nes=nes-1 ! OPAC starts at 0.25um instead of 0.30
14451 nel=22+nes
14452 ! print*,'NES NEL',nes,nel,wlin(1)
14453 else
14454 nes=0
14455 if(idtl==1)then ! >= 2um long d'Almedia
14456 nel=8
14457 elseif(idtl==2)then ! >= 2um long Tegin&Lacis
14458 nel=11
14459 elseif(idtl==3)then ! >= 2um long OPAC
14460 nel=7
14461 endif
14462 endif
14464 nb = ne+1-nel
14465 nwi = nwin+nel-nes+1
14466 iend = nwin+nel
14467 ! print*, icall,'in AOTEXT',nes,iend
14469 ! if ( allocated (aoti) ) deallocate ( aoti )
14470 ! allocate( aoti(nes:iend) )
14473 ! if ( allocated (wlix) ) deallocate ( wlix)
14474 ! allocate( wlix(nes:iend) )
14475 ! if(icall == 2) stop
14477 wlix(1:nwin) =wlin(1:nwin)
14478 aoti(1:nwin)=aotin(1:nwin)
14481 LONGSIDE: do i=1,ne
14482 if(wlix(nwin)>=wlp(i).and.wlix(nwin)<=wlp(i+1))then
14483 ext_norm1=rlnintrp(wlp(i),wlp(i+1),extp(i),extp(i+1), &
14484 & wlix(nwin))
14486 ! print*,dy,dx,dx1,yy,ext_norm1
14487 exit LONGSIDE
14488 endif
14489 enddo LONGSIDE
14490 !C--- change by Yu Gu
14491 !wlix(nwin+1:nwi) = wlp(nb:ne)
14492 !aoti(nwin+1:nwi) = aoti(nwin)*(extp(nb:ne)/ext_norm1)
14493 wlix(nwin+1:iend)=wlp(nb:ne)
14494 aoti(nwin+1:iend)=aoti(nwin)*(extp(nb:ne)/ext_norm1)
14495 !C-- change over
14497 !------
14498 if(nwin==1)then
14499 ! print*,1,wlix(1),aoti(1)
14500 SHORTSIDE: do i=1,ne
14501 if(wlix(1)>=wlp(i).and.wlix(1)<=wlp(i+1))then
14502 ext_norm0= rlnintrp( wlp(i),wlp(i+1), &
14503 & extp(i),extp(i+1),wlix(1))
14504 ! print*,dy,dx,dx1,yy,ext_norm0
14505 exit SHORTSIDE
14506 endif
14507 enddo SHORTSIDE
14508 nq=-nes+1
14509 wlix(nes:0)=wlp(1:nq)
14510 aoti(nes:0)=aoti(1)*(extp(1:nq)/ext_norm0)
14511 else
14512 wlix(0)=0.001
14513 aoti(0)=1
14514 endif
14515 !------------------------------------------------------------------
14516 ! print'(a18,40f7.3)','Wavelength input= ',wlix(nes:iend)
14517 ! print'(a18,40f7.3)',' AOT input= ',aoti(nes:iend)
14519 ! do i=nes,iend
14520 ! write(10) d1,d2,wlix(i),aoti(i),float(irec),log(wlix(i)),log(aoti(i)),float(ityp)
14521 ! enddo
14523 call aotspline(nwi,aoti(nes:iend),wlix(nes:iend),nwo,wlo,aoto)
14525 ! print'(a18,500f7.3)','Wavelength Out= ',wlo
14526 ! print'(a18,500f7.3)',' AOT Out= ',aoto
14529 return
14530 end subroutine
14531 !===================================================================
14532 !===================================================================
14533 real function rlnintrp(x1,x2,y1,y2, x)
14534 implicit none
14535 real :: x, x1, x2, y1, y2, dx, dy, dx1, yy
14536 dx= log(x2) - log(x1)
14537 dy= log(y2) - log(y1)
14538 dx1=log(x) - log(x1)
14539 yy= (dy/dx) * dx1
14540 rlnintrp = exp(log(y1)+yy)
14541 return
14542 end function
14543 !====================================================================
14544 subroutine aotspline(nwi,aoti,wli,nwo,wlo,aoto)
14545 implicit none
14547 integer :: nwi, nwo
14548 real ,dimension(nwi) :: aoti,wli
14549 real ,dimension(nwi+1):: xa,ya,y2a
14550 real ,dimension(nwo) :: aoto,wlo,aa
14551 integer :: nwi2, iwo
14552 real :: x, y
14553 real :: yp1 = 1.0E+32, ypn = 1.0E+32
14555 nwi2=nwi+1
14557 xa(2:nwi+1)=log(wli(1:nwi))
14558 ya(2:nwi+1)=log(aoti(1:nwi))
14559 xa(1)=log(1.0E-6) !; xa(nwi2)=log(1.0E+6) !TENSION
14560 ya(1)=0 !; ya(nwi2)= ya(nwi+1)!TENSION
14562 call spline(xa,ya,nwi2,yp1,ypn,y2a)
14564 do iwo = 1,nwo
14565 x=log(wlo(iwo))
14566 call splint(xa,ya,y2a,nwi2,x,y)
14567 aoto(iwo)=exp(y)
14568 enddo
14570 return
14571 end subroutine
14572 !------------------------------------------------------
14573 real function alphav(aot1,aot2,wl1,wl2)
14574 implicit none
14575 real :: aot1, aot2, wl1, wl2, ar, wr
14576 ar= aot1/aot2
14577 wr= wl1/wl2
14578 alphav = - log(ar)/ log(wr)
14579 return
14580 end function
14581 !---------------------------------------------------------------
14582 SUBROUTINE spline(x,y,n,yp1,ypn,y2)
14583 implicit none
14584 INTEGER :: n
14585 REAL :: yp1,ypn,x(n),y(n),y2(n)
14586 INTEGER :: i,k
14587 REAL :: p,qn,sig,un,u(500)
14589 if (yp1.gt..99e30) then
14590 y2(1)=0.
14591 u(1)=0.
14592 else
14593 y2(1)=-0.5
14594 u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
14595 endif
14596 do i=2,n-1
14597 sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
14598 p=sig*y2(i-1)+2.
14599 y2(i)=(sig-1.)/p
14600 u(i)=(6.*((y(i+1)-y(i))/(x(i+1)- &
14601 & x(i))-(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1))- &
14602 & sig*u(i-1))/p
14603 11 end do
14604 if (ypn.gt..99e30) then
14605 qn=0.
14606 un=0.
14607 else
14608 qn=0.5
14609 un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
14610 endif
14611 y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
14612 do k=n-1,1,-1
14613 y2(k)=y2(k)*y2(k+1)+u(k)
14614 12 end do
14615 return
14616 END SUBROUTINE
14617 !C (C) Copr. 1986-92 Numerical Recipes Software .
14618 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
14619 SUBROUTINE splint(xa,ya,y2a,n,x,y)
14620 implicit none
14621 INTEGER :: n
14622 REAL :: x,y,xa(n),y2a(n),ya(n)
14623 INTEGER :: k,khi,klo
14624 REAL :: a,b,h
14625 klo=1
14626 khi=n
14627 do while (khi-klo.gt.1)
14628 k=(khi+klo)/2
14629 if(xa(k).gt.x)then
14630 khi=k
14631 else
14632 klo=k
14633 endif
14634 end do
14635 h=xa(khi)-xa(klo)
14636 if (h.eq.0.) CALL wrf_error_fatal('bad xa input in splint. STOP program') !mchen
14637 a=(xa(khi)-x)/h
14638 b=(x-xa(klo))/h
14639 y=a*ya(klo)+b*ya(khi)+((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h** &
14640 & 2)/6.
14641 return
14642 END subroutine
14644 !C (C) Copr. 1986-92 Numerical Recipes Software .
14645 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
14646 SUBROUTINE polint(xa,ya,n,x,y,dy)
14647 implicit none
14648 INTEGER :: n
14649 REAL :: dy,x,y,xa(n),ya(n)
14650 INTEGER :: i,m,ns
14651 REAL :: den,dif,dift,ho,hp,w,c(10),d(10)
14652 ns=1
14653 dif=abs(x-xa(1))
14654 do i=1,n
14655 dift=abs(x-xa(i))
14656 if (dift.lt.dif) then
14657 ns=i
14658 dif=dift
14659 endif
14660 c(i)=ya(i)
14661 d(i)=ya(i)
14662 11 end do
14663 y=ya(ns)
14664 ns=ns-1
14665 do m=1,n-1
14666 do i=1,n-m
14667 ho=xa(i)-x
14668 hp=xa(i+m)-x
14669 w=c(i+1)-d(i)
14670 den=ho-hp
14671 if(den.eq.0.) CALL wrf_error_fatal('failure in polint. STOP program') !mchen
14672 den=w/den
14673 d(i)=hp*den
14674 c(i)=ho*den
14675 12 end do
14676 if (2*ns.lt.n-m)then
14677 dy=c(ns+1)
14678 else
14679 dy=d(ns)
14680 ns=ns-1
14681 endif
14682 y=y+dy
14683 13 end do
14684 return
14685 END SUBROUTINE
14686 !C (C) Copr. 1986-92 Numerical Recipes Software .
14687 !=============================================================
14689 !ccc
14690 subroutine ql_rh(rh,tl,pl,ql)
14691 implicit none
14692 real :: rh, tl, pl, ql
14693 real :: es, ws
14694 ! rh (0-100)
14695 ! tl (K)
14696 ! pl (mb)
14697 ! q (g/g)
14699 es=satvap(tl)
14700 ws=0.622*es/(pl-es)
14701 rh= ql/ws *100.
14702 return
14703 end subroutine
14705 !--------------------------------------------------------------------
14707 real function satvap(temp2)
14708 implicit none
14709 real :: temp2, temp, toot, toto, eilog, tsot, &
14710 & ewlog, ewlog2, ewlog3, ewlog4
14711 temp = temp2-273.155
14712 if (temp.lt.-20.) then !!!! ice saturation
14713 toot = 273.16 / temp2
14714 toto = 1 / toot
14715 eilog = -9.09718 * (toot - 1) - 3.56654 * (log(toot) / &
14716 & log(10.)) + .876793 * (1 - toto) + (log(6.1071) / log(10.))
14717 satvap = 10 ** eilog
14718 else
14719 tsot = 373.16 / temp2
14720 ewlog = -7.90298 * (tsot - 1) + 5.02808 * &
14721 & (log(tsot) / log(10.))
14722 ewlog2 = ewlog - 1.3816e-07 * &
14723 & (10 ** (11.344 * (1 - (1 / tsot))) - 1)
14724 ewlog3 = ewlog2 + .0081328 * &
14725 & (10 ** (-3.49149 * (tsot - 1)) - 1)
14726 ewlog4 = ewlog3 + (log(1013.246) / log(10.))
14727 satvap = 10 ** ewlog4
14728 end if
14729 return
14730 end function
14732 !-----------------------------------------------------------------------
14734 subroutine aerosol_init(nv,nv1,pp,pt,ph,po,dz, &
14735 a_tau1,a_ssa1,a_asy1, &
14736 a_tau2,a_ssa2,a_asy2, &
14737 a_wlis,a_taus,aprofs &
14738 )
14739 !c
14740 !c 8/14/95, 4/1/97 , 2/10/2000
14741 !c
14742 !c **********************************************************************
14743 !c Subroutine to create aerosol optical properties. There are several
14744 !c inputs and 6 outputs.
14745 !c
14746 !c INPUTS FROM COMMON BLOCKS OR HEADER FILE:
14747 !c
14748 !c a_tau(nwi) : The input column aerosol optical depth
14749 !c (real) (common block "aer_tau" - see header file).
14750 !c
14751 !c a_wli(nwi) : Wavelength in microns corresponding to aerosol tau in "a_tau"
14752 !c
14753 !c aprof(# layers): The input aerosol optical depth profile - LAYERS
14754 !c (real) (common block "aer_prof").
14755 !c
14756 !c itp: Aerosol type, given in header file rad_0598.h.
14757 !c
14758 !c ifg: The table will compute vertical distributions based on
14759 !c (integer) relative humidity (see explanation below). If ifg is
14760 !c set to 0, each layer will have properties calculated
14761 !c based on the relative humidity of that layer. If ifg
14762 !c is set equal to another integer (1 through the number of
14763 !c relative humidities given in the block data "aerosol")
14764 !c the routine will calculate a vertical profile of optical
14765 !c properties based on the relative humidity corresponding
14766 !c to the index given. The indices are: 1: 0%; 2: 50%;
14767 !c 3: 70%; 4: 80%; 5:90%; 6: 95%; 7: 98%; and 8: 99%.
14768 !c If the number of relative humidities changes, these
14769 !c numbers will have to be modified.
14770 !c
14771 !c ivd: Vertical tau distribution flag. If set to zero, the
14772 !c distribution is based on Jim Spinhirne's marine
14773 !c distribution formulation, and no user input is required.
14774 !c If set to one, the user's own vertical distribution is
14775 !c used, and must be present in the array aprof(nlayers).
14776 !c NOTE: This vertical distribution is used as a weighting
14777 !c factor ONLY, to distribute input column optical depths!
14778 !c
14779 !c----------------------------------------------------------------------------
14780 !c a_ssa, a_ext, a_asy: Input single-scattering albedos, extinction
14781 !c coefficients, and asymmetry parameters. These variables
14782 !c are dimensioned (# of bands, # of relative humidities, &
14783 !c # of aerosol types). An x or y is appended on these
14784 !c variable names: if x, the numbers correspond to the 18
14785 !c original bands. If y, the numbers are for the 10
14786 !c sub-intervals in the first shortwave band (.2-.7 microns).
14787 !c All of these variables come from the block data statements
14788 !c aerosol# (# corresponds to an integer, eg. aerosol1) and
14789 !c are in common blocks aer_optx and aer_opty.
14790 !c
14791 !c nv,mb,pp,pt,ph,dz: number of layers, number of bands, and the
14792 !c pressure, temperature, humidity and thickness profiles.
14793 !c These are shared by several subroutines.
14794 !c
14795 !c OUTPUTS:
14796 !c
14797 !c a_tau1,a_ssa1,a_asy1: The optical depth, single-scattering albedo, &
14798 !c and asymmetry parameter vertical profiles for 18 bands. These
14799 !c are dimensioned (nvx, 18) These are in the common block
14800 !c aer_initx, which is shared by the subroutine "aerosolx".
14801 !c
14802 !c a_tau2,a_ssa2,a_asy2: Properties for SW band 1's 10 subintervals.
14803 !c These are dimensioned (nvx, 10) These are in the common block
14804 !c aer_inity, which is shared by the subroutine "aerosoly".
14805 !c
14806 !c **********************************************************************
14807 !c USE RadParams
14808 !# include "para.file"
14809 USE PARA_FILE
14810 USE control_para
14811 USE aerosol1
14812 USE aerosol2
14813 !c include 'para.file'
14814 !c## include 'rad_0698.h'
14815 !c implicit none
14816 implicit none
14817 integer :: nv, nv1
14818 real, dimension(nv1) :: pp, pt, ph, po
14819 real :: dz(nv)
14821 integer :: iq,mtop,n,m,ict,ix,iy,irh,krh,iac,itp
14822 ! real, dimension(mbx,nrh,naer) :: a_ssax,a_extx,a_asyx
14823 ! real, dimension(mby,nrh,naer) :: a_ssay,a_exty,a_asyy
14825 real, dimension(nvx) :: tauxxx
14826 real, dimension(nvx,mbx,mxac) :: a_tau1,a_ext1,a_ssa1,a_asy1
14827 real, dimension(nvx,mby,mxac) :: a_tau2,a_ext2,a_ssa2,a_asy2
14829 real ,dimension(nvx) :: taux1,taux2,rh,ht,rhp
14830 real :: sumxxx
14832 real,dimension(mxat) :: a_wli,a_tau
14833 real,dimension(nvx) :: aprof
14834 real,dimension(nvx,mbx) :: wvd_x
14835 real,dimension(nvx,mby) :: wvd_y
14837 real :: p1,h1,z,sig,tp
14838 real :: rhx(nrh) = (/0.,50.,70.,80.,90.,95.,98.,99./)
14839 real :: wts(4) = (/.23015,.28274,.25172,.23539/)
14840 real :: tau3(2),tau3y(4)
14841 real :: aotf(15),wlf(15),sump,rirh
14842 ! real, external :: spinhirne_sig, spinhirne_tau
14843 ! real :: spinhirne_sig, spinhirne_tau
14846 real,dimension(mxat,mxac) :: a_wlis,a_taus
14847 real,dimension(nvx,mxac) :: aprofs
14849 !c Initialize.
14851 rh = -9999.
14852 a_ssa1 = 0. ; a_ext1 = 0. ; a_asy1 = 0. ; a_tau1 = 0.
14853 a_ssa2 = 0. ; a_ext2 = 0. ; a_asy2 = 0. ; a_tau2 = 0.
14855 if (n_atau<0 .or.n_atau>mxat) CALL wrf_error_fatal('errro in Aerosol Tau / Wavelengths. STOP program') !mchen
14856 if (ifg < 0 .or. ifg > 8) CALL wrf_error_fatal('Error in ifg: Aerosol RH% Flag. STOP program') !mchen
14858 AEROSOL_CONSTITUENTS : do iac = 1,mxac
14859 if (itps(iac).eq.1) then
14861 a_wli(1:n_atau) = a_wlis(1:n_atau,iac)
14862 a_tau(1:n_atau) = a_taus(1:n_atau,iac)
14863 aprof(1:nv) = aprofs(1:nv,iac)
14864 itp = iac
14865 if ( itp < 1 .or. itp > naer ) CALL wrf_error_fatal('Error in itp: bad Aerosol type. STOP program') !mchen
14866 ! print*,'CONSTITUENTS',iac,itp
14868 ! FOR Aerosol Optical Properties types that are constant with RH
14869 if (itp==1 .or. itp==2 .or. itp==3 .or. &
14870 & itp==10 .or. itp==12 .or.itp==13 .or. itp==18 ) then
14871 !! Has already been filled in Block data
14872 else
14873 do krh=2,8
14874 a_extx(1:mbx,krh,itp)= a_extx(1:mbx,1,itp)
14875 a_ssax(1:mbx,krh,itp)= a_ssax(1:mbx,1,itp)
14876 a_asyx(1:mbx,krh,itp)= a_asyx(1:mbx,1,itp)
14878 a_exty(1:mby,krh,itp)= a_exty(1:mby,1,itp)
14879 a_ssay(1:mby,krh,itp)= a_ssay(1:mby,1,itp)
14880 a_asyy(1:mby,krh,itp)= a_asyy(1:mby,1,itp)
14882 enddo
14884 endif
14885 ! if ( ifg .ne.0) print*,'CHECK',ifg,itp,a_ssax(1:mbx,ifg,itp)
14887 !c ******************************************************************
14888 !c Calculate heights at center of layer - find highest layer to place
14889 !c aerosols (15 km) - calculate relative humidities of each layer as
14890 !c needed. Values of RH > 99% will be set equal to 99% to make table
14891 !c lookup easier. "mtop" is the highest aerosol layer.
14892 !c ******************************************************************
14893 z=0.
14894 m=nv
14895 iq=0
14896 do while (iq.eq.0 .and. m.ge.1)
14897 ht(m)=(z*2.+dz(m))/2.
14898 z=z+dz(m)
14899 if (z.gt.15.) then
14900 iq=1
14901 mtop=m
14902 endif
14903 p1=(pp(m)+pp(m+1))/2.
14904 tp=(pt(m)+pt(m+1))/2.
14905 h1=(ph(m)+ph(m+1))/2.
14906 call ql_rh(rh(m),tp,p1,h1)
14907 if (rh(m).gt.98.9) rh(m)=98.9
14908 if ((rh(m).lt..01).and.(rh(m).gt.-999.)) rh(m)=0.
14909 m=m-1
14910 end do
14912 !c *************************************************************
14913 !c Calculate vertical distribution of asymmetry, ss albedo and
14914 !c extinction, based on aerosol type and relative humidity.
14915 !c If ifg is not equal to 0, parameters will corresponds to a
14916 !c single RH, as described in header file. Loop 31 deals with
14917 !c the 18 original bands, loop 32 with the 10 band 1 subintervals.
14918 !c *************************************************************
14919 do m=mtop,nv
14920 do n=1,mbx
14921 if (rh(m).eq.-9999.) then
14922 a_ext1(m,n,iac)=-9999.
14923 a_ssa1(m,n,iac)=-9999.
14924 a_asy1(m,n,iac)=-9999.
14925 else
14926 if (ifg.eq.0) then ! Dependence on layer RH.
14927 ict=2
14928 do while (rh(m).ge.rhx(ict))
14929 ict=ict+1
14930 end do
14931 a_ext1(m,n,iac)=a_extx(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
14932 & (rhx(ict)-rhx(ict-1))*(a_extx(n,ict,itp)-a_extx(n,ict-1,itp))
14933 a_ssa1(m,n,iac)=a_ssax(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
14934 & (rhx(ict)-rhx(ict-1))*(a_ssax(n,ict,itp)-a_ssax(n,ict-1,itp))
14935 a_asy1(m,n,iac)=a_asyx(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
14936 & (rhx(ict)-rhx(ict-1))*(a_asyx(n,ict,itp)-a_asyx(n,ict-1,itp))
14937 rhp(m) = rh(m)
14938 else ! Dependence on prescribed RH.
14939 a_ext1(m,n,iac)=a_extx(n,ifg,itp)
14940 a_ssa1(m,n,iac)=a_ssax(n,ifg,itp)
14941 a_asy1(m,n,iac)=a_asyx(n,ifg,itp)
14942 endif
14943 endif
14944 end do
14945 !-------------------------------------------
14946 do n=1,mby
14947 if (rh(m).eq.-9999.) then
14948 a_ext2(m,n,iac)=-9999.
14949 a_ssa2(m,n,iac)=-9999.
14950 a_asy2(m,n,iac)=-9999.
14951 else
14952 if (ifg.eq.0) then ! Dependence on layer RH.
14953 ict=2
14954 do while (rh(m).ge.rhx(ict))
14955 ict=ict+1
14956 end do
14957 a_ext2(m,n,iac)=a_exty(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
14958 & (rhx(ict)-rhx(ict-1))*(a_exty(n,ict,itp)-a_exty(n,ict-1,itp))
14959 a_ssa2(m,n,iac)=a_ssay(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
14960 & (rhx(ict)-rhx(ict-1))*(a_ssay(n,ict,itp)-a_ssay(n,ict-1,itp))
14961 a_asy2(m,n,iac)=a_asyy(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
14962 & (rhx(ict)-rhx(ict-1))*(a_asyy(n,ict,itp)-a_asyy(n,ict-1,itp))
14963 else ! Dependence on prescribed RH.
14964 a_ext2(m,n,iac)=a_exty(n,ifg,itp)
14965 a_ssa2(m,n,iac)=a_ssay(n,ifg,itp)
14966 a_asy2(m,n,iac)=a_asyy(n,ifg,itp)
14967 endif
14968 endif
14969 end do
14971 end do
14973 !c ******************************************************************
14974 !c Vertical distribution of aerosol optical depths - CAGEX and CERES.
14975 !c --------------------------------------------------------------
14976 !c Use Spinhirne's vertical distribution of scattering properties
14977 !c to calculate vertical distribution of optical depths. The
14978 !c distribution gives a scattering coefficient ("sig"). Use this,
14979 !c along with the single-scattering albedo, to produce an
14980 !c RH-dependent extinction coefficient (extx, exty, etc.), from
14981 !c which optical depth is calculated (taux, tauy, etc.). This
14982 !c optical depth is summed (sum1, sumy2, sum, etc.) to give
14983 !c column tau for weighting purposes.
14984 !c --------------------------------------------------------------
14986 select case (ivd)
14987 case default
14988 CALL wrf_error_fatal('ivd : Aerosol Profile flag. STOP program') !mchen
14989 case (0) !! DEFAULT VERTICAL DISTRIBUTION Spinhirne
14991 sumxxx=0.0
14993 do m=mtop,nv
14995 sig = spinhirne_sig( ht(m))
14996 tauxxx(m) = spinhirne_tau(sig,a_ssa2(m,9,iac),dz(m))
14997 sumxxx = sumxxx + tauxxx(m)
14998 ! print*,m,sig,a_ssa2(m,9,iac)
14999 enddo
15001 do m=mtop,nv
15002 tauxxx(m) = tauxxx(m) / sumxxx
15003 !!! aprofs(m,iac) = tauxxx(m) !! See what the Sphinhirne profiles look like
15004 enddo
15006 ! ----------------------------------------------------------------
15007 case (1:2) ! USER'S OWN VERTICAL DISTRIBUTION IVD=1 & 2
15009 sump = sum( aprof(mtop:nv) )
15010 tauxxx(mtop:nv)= aprof(mtop:nv) / sump
15012 if(sump.eq.0.) CALL wrf_error_fatal('No VERTICAL Profile OF AEROSOL TAU. STOP program') !mchen
15014 end select
15017 !c ********************************************************************
15018 !c IAFORM=2
15019 !c
15020 !c Distribute optical depth spectrally into the first 2 Fu-Liou bands.
15021 !c Band 1 will consist of the first 4 MFRSR bands, weighted with
15022 !c respect to energy. Band two will be the fifth MFRSR band.
15023 !c
15024 !c Also, distribute optical depths into 4 of the 10 band 1 subintervals.
15025 !c Subinterval 7 is directly inserted, since there is one MFRSR
15026 !c measurement within the range of this band. Subintervals 7 and 8
15027 !c straddle the .497 micron MFRSR measurement, so interpolated values
15028 !c are inserted into these, using .409 and .497 measurements for 7, and
15029 !c .497 and .606 for 8. Subinterval 10 contains two MFRSR measurements,
15030 !c so it is filled using an energy-weighted average. This is all
15031 !c hardwired, so we need all of the MFRSR bands (.409, .497, .606, and
15032 !c .661) for it to work. (The .855 micron band is also needed, but not
15033 !c for this interval distribution.
15034 !c ********************************************************************
15036 select case ( iaform )
15037 case default
15038 CALL wrf_error_fatal('iaform : Bad value of iaform . STOP program') !mchen
15039 case(1) ! CERES
15040 !! No operations necessary
15042 case(2) ! For CAGEX
15044 tau3(1)=a_tau(1)*wts(1)+a_tau(2)*wts(2)+ &
15045 & a_tau(3)*wts(3)+a_tau(4)*wts(4)
15046 tau3(2)=a_tau(5)
15047 tau3y(1)=a_tau(1) ! For subinterval 7 of 1st band (.409)
15048 tau3y(2)=a_tau(1)+.6705*(a_tau(2)-a_tau(1)) ! Subi 8 of band 1
15049 tau3y(3)=a_tau(2)+.4541*(a_tau(3)-a_tau(2)) ! Subi 9 of band 1
15050 tau3y(4)=a_tau(3)*.5175+a_tau(4)*.4825 ! Subi 10 of band 1
15052 case(3) ! For AOT_SPLINEFIT
15054 if ( ifg == 0 ) then ! Find Aerosol weighted collumn mean RH index
15055 rirh=0
15056 do m =mtop,nv
15057 rirh = rirh + rhp(m)* tauxxx(m) !! Aerosol Profile weighted mean RH
15058 ! print*,m,rhp(m),tauxxx(m)
15059 enddo
15061 irh =1
15062 do ix= 1,7
15063 if( rirh >= rhx(ix) .and. rirh < rhx(ix+1) ) irh=ix
15064 enddo
15065 if( rirh >= rhx(8) ) irh =8
15067 else ! Use assigned RH index
15068 irh = ifg
15069 endif
15071 ! Can't handle ZERO in Log interpolation
15072 where ( a_tau .lt. 1.0E-20) a_tau = 1.0E-20
15074 call atau_spline_iaform3(a_wli,a_tau,aotf,wlf,irh,itp)
15076 ! write(22,'(a20,15f8.3)') 'AOT in Fu Bands',aotf(1:15)
15078 !!! A!OUNT FOR VERTICAL EXTINCTION VARIABILITY WITH HUMIDITY ABOUT THE MEAN RH "irh"
15079 !!! ( IAFORM==3) only
15080 do iy = 1,mby
15081 wvd_y(mtop:nv,iy)=tauxxx(mtop:nv) &
15082 & *a_ext2(mtop:nv,iy,iac)/a_exty(iy,irh,itp)
15083 sump = sum( wvd_y(mtop:nv,iy) )
15084 wvd_y(mtop:nv,iy) = wvd_y(mtop:nv,iy) /sump
15085 enddo
15087 do ix = 1,mbx
15088 wvd_x(mtop:nv,ix)=tauxxx(mtop:nv) &
15089 & *a_ext1(mtop:nv,ix,iac)/a_extx(ix,irh,itp)
15090 sump = sum( wvd_x(mtop:nv,ix) )
15091 wvd_x(mtop:nv,ix) = wvd_x(mtop:nv,ix) /sump
15092 enddo
15094 end select
15097 ! ----------------------------------------------------------------
15098 !c Use weighted optical depths to distribute our input
15099 !c column optical depths vertically and spectrally where needed.
15100 !c For bands with "measured" input, we simply do the weighting.
15101 !c For the remaining bands, we weight according to our vertically
15102 !c distributed extinction coefficients (calculated in loop 30),
15103 !c which carry all the spectral resolution we need. a_tau1 is for
15104 !c the 18 original bands, a_tau2 is for the 10 band 1 subintervals.
15105 ! ----------------------------------------------------------------
15106 VERTICAL : do m=mtop,nv
15108 select case ( iaform )
15110 case(1) ! For CERES
15112 a_tau1(m,1,iac) = a_tau(1) * tauxxx(m)
15113 a_tau1(m,2:18,iac)= a_tau1(m,1,iac)* &
15114 & a_ext1(m,2:18,iac)/a_ext1(m,1,iac)
15116 a_tau2(m,9,iac) = a_tau(1) * tauxxx(m)
15118 a_tau2(m,1:10,iac)=a_tau2(m,9,iac)* &
15119 & a_ext2(m,1:10,iac)/a_ext2(m,9,iac)
15121 case(2) ! For CAGEX
15123 a_tau1(m,1:2,iac) = tau3(1:2) * tauxxx(m)
15124 a_tau1(m,3:18,iac)=a_tau1(m,2,iac)* &
15125 & a_ext1(m,3:18,iac)/a_ext1(m,2,iac)
15127 a_tau2(m,7:10,iac) = tau3y(1:4) * tauxxx(m)
15128 a_tau2(m,1:6,iac) = a_tau2(m,7,iac)* &
15129 & a_ext2(m,1:6,iac)/a_ext2(m,7,iac)
15131 case(3) ! For AOT_SPLINEFIT
15135 ! a_tau2(m,1:10,iac) = aotf(1:10) * tauxxx(m)
15136 a_tau2(m,1:10,iac) = aotf(1:10) * wvd_y(m,1:10)
15137 ! a_tau1(m,1,iac) = aotf(9) * tauxxx(m)
15138 a_tau1(m,1,iac) = aotf(9) * wvd_x(m,1)
15139 ! a_tau1(m,2:6,iac) = aotf(11:15) * tauxxx(m)
15140 a_tau1(m,2:6,iac) = aotf(11:15) * wvd_x(m,2:6)
15141 a_tau1(m,7:18,iac) =a_tau1(m,2,iac)* &
15142 & a_ext1(m,7:18,iac)/a_ext1(m,2,iac)
15144 end select
15146 ! print'(3I4,2f8.2,16f7.3)', m,iac,itp,dz(m),rh(m),
15147 ! & (wvd_y(m,iy),iy=1,10),(wvd_x(m,ix),ix=1,6)
15149 enddo VERTICAL
15152 !------------------------------------------------------------------------------
15153 !!!--- Diagnostic Output of Atau
15154 ! do ii=1,10
15155 ! xxx=0
15156 ! do jj=1,nv
15157 ! xxx =xxx+ a_tau2(jj,ii,iac)
15158 ! enddo
15159 ! aotf(ii)=xxx
15160 ! enddo
15162 ! do ii=2,6
15163 ! xxx=0
15164 ! do jj=1,nv
15165 ! xxx =xxx+ a_tau1(jj,ii,iac)
15166 ! enddo
15167 ! aotf(9+ii)=xxx
15168 ! enddo
15170 ! write(22,'(a20,15f8.3)') 'AOT in Fu Bands',aotf(1:15)
15172 end if
15173 enddo AEROSOL_CONSTITUENTS
15175 return
15176 end subroutine
15178 !===========================================================================
15179 subroutine aerosolxy ( nv, nv1, ib,cmode,a_tau1,a_ssa1,a_asy1, &
15180 a_tau2,a_ssa2,a_asy2,tae,wae,wwae &
15181 )
15182 !c *********************************************************************
15183 !c Modified 2/14/00
15184 !c
15185 !c tae, wae, and wwae are the optical depth, single scattering albedo, &
15186 !c and expansion coefficients of the phase function ( 1, 2, 3, and 4 )
15187 !c due to the Mie scattering of aerosols for a given layer.
15188 !c
15189 !c This subroutine is called for bands 2 - 18 (ib)
15190 !c or vis subbands 1-10 (ig)
15191 !c *********************************************************************
15192 !c USE RadParams
15193 !# include "para.file"
15194 USE PARA_FILE
15195 USE control_para
15196 !c include 'para.file'
15197 implicit none
15198 integer :: nv, nv1
15199 character*1 :: cmode
15200 integer :: i,ib,iac
15201 real :: x1,x2,x3,x4,y1,y2,y3,y4
15202 real ,dimension(nvx,18,mxac) :: a_tau1,a_ssa1,a_asy1
15203 real ,dimension(nvx,10,mxac) :: a_tau2,a_ssa2,a_asy2
15204 real :: tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
15206 AEROSOL_CONSTITUENTS : do iac=1,mxac
15207 if (itps(iac).eq.1) then
15209 LEVELS : do i = 1, nv
15210 select case (cmode)
15211 case ('x')
15212 tae(i,iac) = a_tau1(i,ib,iac)
15213 wae(i,iac) = a_ssa1(i,ib,iac)
15214 x1 = a_asy1(i,ib,iac)
15215 case ('y')
15216 tae(i,iac) = a_tau2(i,ib,iac)
15217 wae(i,iac) = a_ssa2(i,ib,iac)
15218 x1 = a_asy2(i,ib,iac)
15219 end select
15221 x2 = x1 * x1
15222 x3 = x2 * x1
15223 x4 = x3 * x1
15224 y1 = 3.0 * x1
15225 y2 = 5.0 * x2
15226 y3 = 7.0 * x3
15227 y4 = 9.0 * x4
15229 wwae(i,1,iac) = y1
15230 wwae(i,2,iac) = y2
15231 wwae(i,3,iac) = y3
15232 wwae(i,4,iac) = y4
15234 enddo LEVELS
15235 end if
15236 enddo AEROSOL_CONSTITUENTS
15238 return
15239 end subroutine
15241 !----------------------------------------------------------------
15243 real function spinhirne_sig(ht)
15244 implicit none
15245 real :: ht
15246 real :: sig0 = 0.025 , &
15247 & a = 0.4 , &
15248 & ap = 2981.0, &
15249 & b = 1.6 , &
15250 & bp = 2.5 , &
15251 & f = 1.5e-7
15252 real t1, t2, t3, t4, t5, t6
15253 t1= sig0*(1+a)**2
15254 t4 = f*(1+ap)**2
15256 t2 = exp(ht/b)
15257 t3 = (a+exp(ht/b))**2
15258 t5 = exp(ht/bp)
15259 t6 = (a+exp(ht/bp))**2
15260 spinhirne_sig=t1*t2/t3+t4*t5/t6 ! scattering coefficient
15261 return
15262 end function spinhirne_sig
15263 !---------------------------------------------
15264 real function spinhirne_tau(sig,ssa,dz)
15265 implicit none
15266 real sig, ssa, dz, ext
15267 ext = sig / ssa
15268 spinhirne_tau = ext / dz
15269 return
15270 end function spinhirne_tau
15271 ! ************ end of subroutines **************!
15273 !*****************************************************************
15275 subroutine o3prof (iprof, kts, kte, p, o3)
15277 USE module_ozone
15278 implicit none
15280 integer iprof, kts, kte
15281 integer k, kk, ks, ke
15282 real p(kts:kte), o3(kts:kte), lp(kts:kte), lpres(np)
15284 ! Statement function
15286 real Linear, x1, y1, x2, y2, x
15287 Linear(x1, y1, x2, y2, x) = &
15288 (y1 * (x2 - x) + y2 * (x - x1)) / (x2 - x1)
15289 !
15290 do k = 1,np
15291 lpres(k) = alog(pres(k,iprof))
15292 enddo
15293 do k = kts,kte
15294 lp(k) = alog(p(k))
15295 end do
15297 ks = kts
15298 ke = kte
15299 do while (lp(ke).le.lpres(1))
15300 o3(ke) = Linear (lpres(1), ozone(1,iprof), &
15301 lpres(2), ozone(2,iprof), &
15302 lp(ke))
15303 if (o3(ke).lt.0.0) o3(ke) = 0.0
15304 ke = ke - 1
15305 end do
15306 do while (lp(ks).ge.lpres(np))
15307 o3(ks) = Linear (lpres(np), ozone(np,iprof), &
15308 lpres(np-1), ozone(np-1,iprof), &
15309 lp(ks))
15310 if (o3(ks).lt.0.0) o3(ks) = 0.0
15311 ks = ks + 1
15312 end do
15314 kk = np
15315 do k = ks, ke
15316 do while (lp(k).lt.lpres(kk).and.kk.gt.1)
15317 kk = kk - 1
15318 end do
15319 o3(k) = Linear (lpres(kk), ozone(kk,iprof), &
15320 lpres(kk+1), ozone(kk+1,iprof), &
15321 lp(k))
15322 end do
15324 end subroutine o3prof
15326 END MODULE module_ra_FLG