/[MITgcm]/MITgcm_contrib/jscott/igsm/src/r95mit.F
ViewVC logotype

Contents of /MITgcm_contrib/jscott/igsm/src/r95mit.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.1 - (show annotations) (download)
Fri Aug 11 19:35:31 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN 
atm2d package
1
2 #include "ctrparam.h"
3
4 ! ==========================================================
5 !
6 ! R95MIT.F: Model II radiation: 1958 Atmosphere and mean
7 ! strat aeros (.012) Zenith angle dependence
8 ! for aerosols not used.
9 !
10 ! ----------------------------------------------------------
11 !
12 ! Author of Chemistry Modules: Chien Wang
13 !
14 ! ----------------------------------------------------------
15 !
16 ! Important Note: Because the original components of chemistry
17 ! module in this file are used by some runs not using
18 ! interactive chemistry-climate model, therefore, the
19 ! cpp header CPL_CHEM is barely applied. Instead,
20 ! PREDICTED_GASES is appearing at related places.
21 !
22 ! Chien Wang
23 ! 080100
24 !
25 ! Revision History:
26 !
27 ! When Who What
28 ! ---- ---------- -------
29 ! 073100 Chien Wang repack based on CliChem3 & M24x11,
30 ! add cpp, and float -> dble
31 ! 093001 Chien Wang add bc & oc and rewrote aerosol/radiation
32 ! interface including S(VI)
33 ! 062604 Chien Wang merge with current igsm module
34 !
35 ! ==========================================================
36
37
38 C**** R83XX B83XX R83ZA 02/4/93 0.1
39 C**** OPT(3) 0.2
40 C**** 0.3
41 C**** Model II radiation: 1958 Atmosphere and mean strat aeros (.012) 0.4
42 C**** Zenith angle dependence for aerosols not used. 0.5
43 ***** R83ZA B83XX R83ZA 12/23/91 0.1
44 ***** OPT(3) 0.2
45 ***** 0.3
46 ***** Model II radiation with 1958 Atmosphere, mean strat aeros (.012). 0.4
47 ***** Aerosols: Zenith angle dependence and other changes implemented 0.5
48 C SUBROUTINE RCOMP1(NFTTTR,NFTTSR,NFTFOR) 1.
49 c 6/20/2005
50 SUBROUTINE RCOMP1(NFTTTR,NFTTSR,NFTFOR,KTREND)
51
52 #include "chem_para"
53 #include "chem_com"
54 #include "B83XX.COM" 1012.
55
56 c DOUBLE PRECISION PFOFTK,TKOFPF,WAVNA,WAVNB,TK,PFWI 64.
57 DATA WAVNA/850.0/,WAVNB/900.0/ 64.5
58 C 65.
59 NKSR=6 66.
60 C ----------------------------------------------------- 67.
61 C READ IN GAS TAU TABLE AND DISTRIBUTED PLANCK FUNCTION 68.
62 C ALSO THERMAL RAD AEROSOL, CLOUD & SURFACE ALBEDO DATA 69.
63 C 70.
64 C IF(NFTTTR.GE.1) TAU TABLE DATA ARE READ (UNIT=NFTTTR) 71.
65 C WINDOW FLUX B TEMP CONVERSION FACTORS 72.
66 C ARE ALSO COMPUTED AT THIS TIME 73.
67 C 74.
68 C IF(NFTTTR.LT.1) TAU TABLE DATA ARE NOT READ FROM DISK 75.
69 C WINDOW FLUX B TEMP CONVERSION FACTORS 76.
70 C ARE NOT COMPUTED 77.
71 C COMMON/RADCOM/PARAMETERS CAN BE RESET 78.
72 C MORE CONVENIENTLY 79.
73 C ----------------------------------------------------- 80.
74 C 81.
75 IF(NFTTTR.LT.1) GO TO 110 82.
76 C 83.
77 C$ REWIND NFTTTR 84.
78 C$ READ (NFTTTR) ITRHDR,TAUTBL,PLANCK,TRAQEX,TRAQSC,TRACOS 85.
79 C$ + ,TRCQEX,TRCQSC,TRCCOS,AOCEAN,AGSIDV,CLDALB 86.
80 C$ + ,TRACEG 87.
81 REWIND NFTTTR 88.
82 READ (NFTTTR) TAUTBL 89.
83 REWIND NFTTTR 89.5
84 C 90.
85 NFTTTP=NFTTTR+1 91.
86 REWIND NFTTTP 92.
87 READ (NFTTTP) PLANCK 93.
88 REWIND NFTTTP 93.5
89 C 94.
90 C 95.
91 C$ IF(NFTTSR.GT.1) REWIND NFTTSR 96.
92 C$ IF(NFTTSR.GT.1) READ (NFTTSR) ISRHDR,SRTBL 97.
93 C 98.
94 ID5(1)=8304 99.
95 ID5(2)=8106 100.
96 ID5(3)=8106 101.
97 C 102.
98 NKTR =25 103.
99 IT0 =123 104.
100 ITNEXT=250 105.
101 C 106.
102 C --------------------------------------------------------------- 107.
103 C DEFINE WINDOW FLUX TO BRIGHTNESS TEMPERATURE CONVERSION FACTORS 108.
104 C --------------------------------------------------------------- 109.
105 C 110.
106 DO 100 I=1,630 111.
107 PFWI=0.001*I 112.
108 IF(I.GT.100) PFWI=(0.1+0.01*(I-100)) 113.
109 IF(I.GT.190) PFWI=(1.0+0.10*(I-190)) 114.
110 100 TKPFW(I)=TKOFPF(WAVNA,WAVNB,PFWI) 115.
111 110 CONTINUE 116.
112 C --------------------------------------------------- 117.
113 C SET ALBEDO,GAS,AEROSOL DISTRIBUTIONS & COEFFICIENTS 118.
114 C ALSO CALLED ARE ALBDAY,O3DDAY,O3DLAT FOR JDAY,JLAT 119.
115 C-------------------------------------------------------------------- 120.
116 C 121.
117 IF(KFORCE.GT.0) CALL SETFOR(NFTFOR) 122.
118 IF(LASTVC.GE.0) CALL SETATM 123.
119 C **************** Print *******
120 c print *,' from RCOMP1'
121 c print *,'JMLAT=',JMLAT
122 c print *,'DLAT'
123 c print *,DLAT
124 C **************** Print *******
125 CALL SETALB 124.
126 c CALL SETGAS 125.
127 c 6/202005
128 ! print *,' Before CALL SETGAS'
129 CALL SETGAS(KTREND)
130 ! print *,' After CALL SETGAS'
131 CALL SETAER 126.
132
133 C----------------- 127.
134 RETURN 128.
135 C 129.
136 C----------------------------------------------------------------------- 130.
137 C RESET SEASON (JDAY) DEPENDENT QUANTITIES AS NEEDED 131.
138 ENTRY RCOMPT 132.
139 c print *,' from RCOMPT JDAY=',JDAY
140 c print *,'PPMV58 from RCOMPT'
141 c print *,PPMV58
142 C----------------------------------------------------------------------- 133.
143 C 134.
144 IF(KFORCE.GT.0) CALL GETFOR 135.
145 IF(LAPGAS.EQ.2) CALL SETLAP 136.
146 CALL ALBDAY 137.
147 CALL O3DDAY 138.
148
149 #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
150 C--Addition by CEForest (18Mar98)
151 call getforcedozone(jyear,jday)
152 C--End of Addition
153 #endif
154
155 RETURN 139.
156 C 140.
157 C----------------------------------------------------------------------- 141.
158 C RESET LATITUDE (JLAT) DEPENDENT QUANTITIES AS NEEDED 142.
159 ENTRY RCOMPJ 143.
160 C----------------------------------------------------------------------- 144.
161 CALL O3DLAT 145.
162 RETURN 146.
163 C 147.
164 C----------------------------------------------------------------------- 148.
165 C GET ALBEDO,GAS AEROSOL DATA THEN COMPUTE THERML/SOLAR 149.
166 ENTRY RCOMPX 150.
167 C----------------------------------------------------------------------- 151.
168 CALL GETALB 152.
169 CALL GETGAS 153.
170 CALL GETAER 154.
171 C -------------------------------------------- 155.
172 C SPECIFY SURFACE LAYER GAS ABSORPTION AMOUNTS 156.
173 C -------------------------------------------- 157.
174 DO 350 K=1,11 158.
175 TAUSL(K)=RATQSL*FRACSL*TAUN(1+K*NL-NL) 159.
176 350 TAUN(1+K*NL-NL)=TAUN(1+K*NL-NL)-TAUSL(K) 160.
177 DO 360 K=12,NKTR 161.
178 TAUSL(K)= FRACSL*TAUN(1+K*NL-NL) 162.
179 360 TAUN(1+K*NL-NL)=TAUN(1+K*NL-NL)-TAUSL(K) 163.
180 C----------------- 164.
181 CALL THERML 165.
182 C----------------- 166.
183 IF(KGASSR.GT.0) CALL SOLGAS 167.
184 C 168.
185 C$ ****************************COMMENTED OUT CARDS INTERPOLATE SOLAR TAU 169.
186 C$ DO 300 I=1,600 170.
187 C$300 SRTAU(I)=0. 171.
188 C$ CALL SRGAS (NL,PL,DPL,TLM,ULGAS,SRTAU,SRTBL,1,3) 172.
189 C---------------- 173.
190 CALL SOLAR 174.
191 C---------------- 175.
192 C 176.
193
194 RETURN 177.
195 END 178.
196 SUBROUTINE SETALB 179.
197 COMMON/ADDALB/BVSURFA,XVSURFA,BNSURFA,XNSURFA
198
199 #include "B83XX.COM" 180.
200 #include "chem_para"
201 #include "chem_com"
202 #if ( defined CLM )
203 #include "CLM.COM"
204 #endif
205
206 DIMENSION ALVISK(11,4),ALNIRK(11,4),FIELDC(11,3),VTMASK(11) 241.
207 C$$ DIMENSION ALMEAN(11,4),RATIRV(11,4) 242.
208 C 243.
209 EQUIVALENCE 244.
210 + (VADATA(1,1,1),ALVISK(1,1)),(VADATA(1,1,2),ALNIRK(1,1)) 245.
211 +, (VADATA(1,1,3),FIELDC(1,1)),(VADATA(1,4,3),VTMASK(1)) 246.
212 C$$ + (VADATA(1,1,1),ALMEAN(1,1)),(VADATA(1,1,2),RATIRV(1,1)) 247.
213 C$$ +, (VADATA(1,1,3),VTMASK(1)),(VADATA(1,2,3),FIELDC(1,1)) 248.
214 C 249.
215 EQUIVALENCE 250.
216 + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 251.
217 +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 252.
218 +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 253.
219 +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 254.
220 +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 255.
221 +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 256.
222 C 257.
223 EQUIVALENCE 258.
224 + (BXA(1),BOCVIS),(BXA(5),BEAVIS),(BXA( 9),BOIVIS),(BXA(13),BLIVIS) 259.
225 +,(BXA(2),BOCNIR),(BXA(6),BEANIR),(BXA(10),BOINIR),(BXA(14),BLINIR) 260.
226 +,(BXA(3),XOCVIS),(BXA(7),XEAVIS),(BXA(11),XOIVIS),(BXA(15),XLIVIS) 261.
227 +,(BXA(4),XOCNIR),(BXA(8),XEANIR),(BXA(12),XOINIR),(BXA(16),XLINIR) 262.
228 C 263.
229 +, (BXA(17),EXPSNE),(BXA(18),EXPSNO),(BXA(19),EXPSNL) 264.
230 C 265.
231 +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 266.
232 +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 267.
233 C 268.
234 EQUIVALENCE (ASNALB(1),ASNVIS),(ASNALB(2),ASNNIR) 269.
235 EQUIVALENCE (AOIALB(1),AOIVIS),(AOIALB(2),AOINIR) 270.
236 EQUIVALENCE (ALIALB(1),ALIVIS),(ALIALB(2),ALINIR) 271.
237 DIMENSION SRBALB(6),SRXALB(6) 272.
238 C 273.
239 EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 274.
240 C 275.
241 C 1 2 3 4 276.
242 C WINTER SPRING SUMMER AUTUMN 277.
243 REAL SEASON(4)/ 15.00, 105.0, 196.0, 288.0/ 278.
244 C 279.
245 C----------------------------------------------------------------------- 280.
246 C SOLAR: OCEAN ALBEDO DEPENDENCE ON ZENITH ANGLE & WIND SPEED 281.
247 C 282.
248 BVH2O(WMAG)=.0488+.0974/(5.679+WMAG)+.0004/(.3333+WMAG) 283.
249 XVH2O(WMAG,X)=.021+X*X*(.0421+X*(.1283+X*(-.04+X*(3.117/ 284.
250 + (5.679+WMAG)+X*.025/(.3333+WMAG))))) 285.
251 C----------------------------------------------------------------------- 286.
252 C 287.
253 data IFFF0 /1/
254 data ICLM /1/
255 C **************** Print *******
256 cprint *,' from SETALB'
257 cprint *,'DLAT'
258 cprint *,DLAT
259 cprint *,'VTMASK'
260 cprint *,VTMASK
261 cprint *,'FIELDC'
262 cprint *,FIELDC
263 C **************** Print *******
264 JNORTH=JMLAT/2+1 288.
265 VISNIR=MEANAL 289.
266 C 290.
267 C**** FOR OLD ALBEDO FILES COMPUTE VISUAL AND NEAR-IR ALBEDOS 290.8
268 c print *,' SETALB NV=',NV
269 c print *,' ALVISK=',ALVISK
270 c print *,' ALNIRK=',ALNIRK
271 IF (VADATA(4,2,3).GT.100.) GO TO 101 290.9
272 DO 100 L=1,4 291.
273 DO 100 K=1,8 292.
274 ALMEAN=ALVISK(K,L) 292.1
275 RATIRV=ALNIRK(K,L) 292.2
276 ALVISK(K,L)=ALMEAN/(0.6+0.4*RATIRV) 293.
277 100 ALNIRK(K,L)=ALMEAN/(0.4+0.6/RATIRV) 294.
278 101 CONTINUE 294.1
279 C 295.
280 C----------------------------------------------------------------------- 296.
281 C DEFINE SEASONAL ALBEDO (ALVISD,ALNIRD) FOR VEG TYPES 297.
282 ENTRY ALBDAY 298.
283 C----------------------------------------------------------------------- 299.
284 C 300.
285 XJDAY=JDAY 301.
286 c print *,'from ALBDAY XJDAY=',XJDAY
287 SEASN1=-77.0 302.
288 DO 110 K=1,4 303.
289 SEASN2=SEASON(K) 304.
290 IF(XJDAY.LE.SEASN2) GO TO 120 305.
291 110 SEASN1=SEASN2 306.
292 K=1 307.
293 SEASN2=380.0 308.
294 120 WT2=(XJDAY-SEASN1)/(SEASN2-SEASN1) 309.
295 WT1=1.-WT2 310.
296 KS1=1+MOD(K,4) 311.
297 KS2=1+MOD(K+1,4) 312.
298 KN1=1+MOD(K+2,4) 313.
299 KN2=K 314.
300 DO 130 K=1,NV 315.
301 C------------------------ 316.
302 C SOUTHERN HEMISPHERE 317.
303 C------------------------ 318.
304 ALVISD(K )=WT1*ALVISK(K,KS1)+WT2*ALVISK(K,KS2) 319.
305 ALNIRD(K )=WT1*ALNIRK(K,KS1)+WT2*ALNIRK(K,KS2) 320.
306 C------------------------ 321.
307 C NORTHERN HEMISPHERE 322.
308 C------------------------ 323.
309 ALVISD(K+NV)=WT1*ALVISK(K,KN1)+WT2*ALVISK(K,KN2) 324.
310 130 ALNIRD(K+NV)=WT1*ALNIRK(K,KN1)+WT2*ALNIRK(K,KN2) 325.
311 c print *,' ALVISK=',ALVISK
312 c print *,' ALNIRK=',ALNIRK
313 c print *,' ALVISD=',ALVISD
314 c print *,' ALNIRD=',ALNIRD
315 RETURN 326.
316 C 327.
317 C----------------------------------------------------------------------- 328.
318 C ALBEDO,THERMAL FLUX,FLUX DERIVATIVE FOR EACH SURF TYPE 329.
319 ENTRY GETALB 330.
320 C----------------------------------------------------------------------- 331.
321 C 332.
322 LATHEM=NV 333.
323 IF(JLAT.LT.JNORTH) LATHEM=0 334.
324 c print *,'From GETALB JLAT=',JLAT
325 c print *,POCEAN,PEARTH,POICE,PLICE
326 C 335.
327 C ------------------------- 336.
328 C SNOW ALBEDO SPECIFICATION 337.
329 C ------------------------- 338.
330 Ccc ASNAGE=0.35*EXP(-0.2*AGESN) 339.
331 if(IFFF0.eq.1)then
332 print *,' FRSNALB=',FRSNALB
333 print *,' ASNALB(1)=',ASNALB(1),' ASNALB(2)=',ASNALB(2)
334 print *,' AOIALB(1)=',AOIALB(1),' AOIALB(2)=',AOIALB(2)
335 print *,' ALIALB(1)=',ALIALB(1),' ALIALB(2)=',ALIALB(2)
336 IFFF0=0
337 endif
338 ASNAGE=FRSNALB*EXP(-0.2*AGESN)
339 BSNVIS=ASNVIS+ASNAGE 340.
340 BSNNIR=ASNNIR+ASNAGE 341.
341 XSNVIS=BSNVIS 342.
342 XSNNIR=BSNNIR 343.
343 C 344.
344 EXPSNE=1. 345.
345 EXPSNO=1. 346.
346 EXPSNL=1. 347.
347 C 348.
348 DO 200 I=1,16 349.
349 200 BXA(I)=0. 350.
350 C 351.
351 DO 210 K=1,NKTR 352.
352 TRGALB(K)=0. 353.
353 BGFEMD(K)=0. 354.
354 210 BGFEMT(K)=0. 355.
355 C 356.
356 BOCSUM=0. 357.
357 BEASUM=0. 358.
358 BOISUM=0. 359.
359 BLISUM=0. 360.
360 C 361.
361 DO 220 K=1,4 362.
362 220 DTRUFG(K)=0. 363.
363 C 364.
364 C -------------------------- 365.
365 C OCEAN ALBEDO SPECIFICATION 366.
366 C -------------------------- 367.
367 IF(POCEAN.LT.1.E-04) GO TO 400 368.
368 X=0.5+(0.5-COSZ)*ZOCSRA 369.
369 BOCVIS=BVH2O(WMAG) 370.
370 XOCVIS=XVH2O(WMAG,X) 371.
371 BOCNIR=BOCVIS 372.
372 XOCNIR=XOCVIS 373.
373 C 374.
374 X=1./(1.+WMAG) 375.
375 AV=(-.0147087*X*X+.0292266*X-.0081079)*EOCTRA 376.
376 BV=(1.01673-0.0083652*WMAG)*EOCTRA 377.
377 C 378.
378 ITOC=TGO 379.
379 WTOC=TGO-ITOC 380.
380 ITOC=ITOC-IT0 381.
381 BOCSUM=0. 382.
382 BOCM=0. 383.
383 BOCP=0. 384.
384 C 385.
385 DO 310 K=1,NKTR 386.
386 TRAPOC=AV+BV*AOCEAN(K) 387.
387 BOCM1 =(PLANCK(ITOC-1)-(PLANCK(ITOC-1)-PLANCK(ITOC ))*WTOC) 388.
388 + *(1.-TRAPOC) 389.
389 BOCM =BOCM+BOCM1 390.
390 BOCP1 =(PLANCK(ITOC+1)-(PLANCK(ITOC+1)-PLANCK(ITOC+2))*WTOC) 391.
391 + *(1.-TRAPOC) 392.
392 BOCP =BOCP+BOCP1 393.
393 BOC =(PLANCK(ITOC )-(PLANCK(ITOC )-PLANCK(ITOC+1))*WTOC) 394.
394 + *(1.-TRAPOC) 395.
395 BOCSUM=BOCSUM+BOC 396.
396 ITOC=ITOC+ITNEXT 397.
397 C 398.
398 TRGALB(K)=TRGALB(K)+POCEAN*TRAPOC 399.
399 BGFEMD(K)=BGFEMD(K)+POCEAN*(BOCP1-BOCM1) 400.
400 310 BGFEMT(K)=BGFEMT(K)+POCEAN*BOC 401.
401 DTRUFG(1)=0.5*(BOCP-BOCM) 402.
402 C ----------------------------- 403.
403 C SOIL/VEG ALBEDO SPECIFICATION 404.
404 C ----------------------------- 405.
405 400 DSFRAC=PVT(1) 406.
406 VGFRAC=1.-DSFRAC 407.
407 IF(PEARTH.LT.1.E-04) GO TO 500 408.
408 IF(SNOWE .GT.1.E-04) GO TO 420 409.
409 C 410.
410 BEAVIS=PVT(1)*ALVISD(1+LATHEM)*(1.0-0.5*WEARTH*WETSRA) 411.
411 BEANIR=PVT(1)*ALNIRD(1+LATHEM)*(1.0-0.5*WEARTH*WETSRA) 412.
412 DO 410 K=2,NV 413.
413 BEAVIS=BEAVIS+PVT(K)*ALVISD(K+LATHEM) 414.
414 410 BEANIR=BEANIR+PVT(K)*ALNIRD(K+LATHEM) 415.
415 GO TO 440 416.
416 420 VTFRAC=PVT(1)*EXP(-SNOWE/VTMASK(1)) 417.
417 EXPSNE=VTFRAC 418.
418 DSFRAC=VTFRAC 419.
419 C$ BEAVIS=VTFRAC*ALVISD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 420.
420 BEAVIS=PVT(1)*ALVISD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 421.
421 + *(1.-VTFRAC) 422.
422 C$ BEANIR=VTFRAC*ALNIRD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 423.
423 BEANIR=PVT(1)*ALNIRD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 424.
424 + *(1.-VTFRAC) 425.
425 DO 430 K=2,NV 426.
426 VTFRAC=PVT(K)*EXP(-SNOWE/VTMASK(K)) 427.
427 BEAVIS=BEAVIS+PVT(K)*ALVISD(K+LATHEM)*(1.-VTFRAC) 428.
428 C$ BEAVIS=BEAVIS+VTFRAC*ALVISD(K+LATHEM) *******************CORRECT 429.
429 BEANIR=BEANIR+PVT(K)*ALNIRD(K+LATHEM)*(1.-VTFRAC) 430.
430 C$ BEANIR=BEANIR+VTFRAC*ALNIRD(K+LATHEM) *******************CORRECT 431.
431 430 EXPSNE=EXPSNE+VTFRAC 432.
432 C 433.
433 440 XEAVIS=BEAVIS 434.
434 XEANIR=BEANIR 435.
435 C$ BEAVIS=BEAVIS+BSNVIS*(1.-EXPSNE) 436.
436 C$ BEANIR=BEANIR+BSNNIR*(1.-EXPSNE) 437.
437 C$ XEAVIS=XEAVIS+XSNVIS*(1.-EXPSNE) 438.
438 C$ XEANIR=XEANIR+XSNNIR*(1.-EXPSNE) 439.
439 BEAVIS=BEAVIS*EXPSNE+BSNVIS*(1.-EXPSNE) 440.
440 BEANIR=BEANIR*EXPSNE+BSNNIR*(1.-EXPSNE) 441.
441 XEAVIS=XEAVIS*EXPSNE+XSNVIS*(1.-EXPSNE) 442.
442 XEANIR=XEANIR*EXPSNE+XSNNIR*(1.-EXPSNE) 443.
443 VGFRAC=EXPSNE-DSFRAC 444.
444
445 #if ( defined CLM )
446 c if(ncallclm.ge.1)then
447 BEAVIS=0.7*asdirclm(JLAT)+0.3*asdifclm(JLAT)
448 BEANIR=0.7*aldirclm(JLAT)+0.3*aldifclm(JLAT)
449 XEAVIS=BEAVIS
450 XEANIR=BEANIR
451 c endif
452 c if(ncallclm.eq.0)then
453 c print *,JLAT,BEAVIS,BEANIR
454 c endif
455 #endif
456
457 C 445.
458 ITEA=TGE 446.
459 WTEA=TGE-ITEA 447.
460 ITEA=ITEA-IT0 448.
461 BEASUM=0. 449.
462 BEAM=0. 450.
463 BEAP=0. 451.
464 C 452.
465 C 467.
466 DO 450 K=1,NKTR 453.
467 TRAPEA=AGSIDV(K,1)*(1.-EXPSNE) 454.
468 + +AGSIDV(K,3)*DSFRAC*(1.-WETTRA*WEARTH) 455.
469 + +AGSIDV(K,4)*VGFRAC 456.
470 BEAM1 =(PLANCK(ITEA-1)-(PLANCK(ITEA-1)-PLANCK(ITEA ))*WTEA) 457.
471 + *(1.-TRAPEA) 458.
472 BEAM =BEAM+BEAM1 459.
473 BEAP1 =(PLANCK(ITEA+1)-(PLANCK(ITEA+1)-PLANCK(ITEA+2))*WTEA) 460.
474 + *(1.-TRAPEA) 461.
475 BEAP =BEAP+BEAP1 462.
476 BEA =(PLANCK(ITEA )-(PLANCK(ITEA )-PLANCK(ITEA+1))*WTEA) 463.
477 + *(1.-TRAPEA) 464.
478 BEASUM=BEASUM+BEA 465.
479 ITEA=ITEA+ITNEXT 466.
480 TRGALB(K)=TRGALB(K)+PEARTH*TRAPEA 468.
481 BGFEMD(K)=BGFEMD(K)+PEARTH*(BEAP1-BEAM1) 469.
482 450 BGFEMT(K)=BGFEMT(K)+PEARTH*BEA 470.
483 DTRUFG(2)=0.5*(BEAP-BEAM) 471.
484 if(ncallclm.eq.-1)then
485 print *,'471 JLAT=',JLAT
486 print *,(ITEA-1),(ITEA),(ITEA+1)
487 print *,PLANCK(ITEA-1),PLANCK(ITEA),PLANCK(ITEA+1)
488 print *,' VGFRAC=',VGFRAC,' DSFRAC=',DSFRAC
489 print *,' WTEA=',WTEA,' WEARTH=',WEARTH
490 print *,' SNOWE=',SNOWE,' EXPSNE=',EXPSNE
491 c print *,JLAT,' BEAVIS=',BEAVIS,' BEANIR=',BEANIR
492 endif
493 C 472.
494 C ------------------------------ 473.
495 C OCEAN ICE ALBEDO SPECIFICATION 474.
496 C ------------------------------ 475.
497 500 CONTINUE 476.
498 IF(POICE.LT.1.E-04) GO TO 600 477.
499 EXPSNO=EXP(-SNOWOI/DMOICE) 478.
500 BOIVIS=AOIVIS*EXPSNO+BSNVIS*(1.-EXPSNO) 479.
501 BOINIR=AOINIR*EXPSNO+BSNNIR*(1.-EXPSNO) 480.
502 XOIVIS=BOIVIS 481.
503 XOINIR=BOINIR 482.
504 C 483.
505 ITOI=TGOI 484.
506 WTOI=TGOI-ITOI 485.
507 ITOI=ITOI-IT0 486.
508 BOISUM=0. 487.
509 BOIM=0. 488.
510 BOIP=0. 489.
511 C 490.
512 DO 510 K=1,NKTR 491.
513 TRAPOI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNO) 492.
514 + +AGSIDV(K,2)*EICTRA*EXPSNO 493.
515 BOIM1 =(PLANCK(ITOI-1)-(PLANCK(ITOI-1)-PLANCK(ITOI ))*WTOI) 494.
516 + *(1.-TRAPOI) 495.
517 BOIM =BOIM+BOIM1 496.
518 BOIP1 =(PLANCK(ITOI+1)-(PLANCK(ITOI+1)-PLANCK(ITOI+2))*WTOI) 497.
519 + *(1.-TRAPOI) 498.
520 BOIP =BOIP+BOIP1 499.
521 BOI =(PLANCK(ITOI )-(PLANCK(ITOI )-PLANCK(ITOI+1))*WTOI) 500.
522 + *(1.-TRAPOI) 501.
523 BOISUM=BOISUM+BOI 502.
524 ITOI=ITOI+ITNEXT 503.
525 C 504.
526 TRGALB(K)=TRGALB(K)+POICE*TRAPOI 505.
527 BGFEMD(K)=BGFEMD(K)+POICE*(BOIP1-BOIM1) 506.
528 510 BGFEMT(K)=BGFEMT(K)+POICE*BOI 507.
529 DTRUFG(3)=0.5*(BOIP-BOIM) 508.
530 C 509.
531 C ----------------------------- 510.
532 C LAND ICE ALBEDO SPECIFICATION 511.
533 C ----------------------------- 512.
534 600 CONTINUE 513.
535 IF(PLICE.LT.1.E-04) GO TO 700 514.
536 EXPSNL=EXP(-SNOWLI/DMLICE) 515.
537 BLIVIS=ALIVIS*EXPSNL+BSNVIS*(1.-EXPSNL) 516.
538 BLINIR=ALINIR*EXPSNL+BSNNIR*(1.-EXPSNL) 517.
539
540 #if ( defined CLM )
541 c if(ncallclm.ge.1)then
542 BLIVIS=0.7*asdirclm(JLAT)+0.3*asdifclm(JLAT)
543 BLINIR=0.7*aldirclm(JLAT)+0.3*aldifclm(JLAT)
544 c endif
545 #endif
546
547 XLIVIS=BLIVIS 518.
548 XLINIR=BLINIR 519.
549 C 520.
550 ITLI=TGLI 521.
551 WTLI=TGLI-ITLI 522.
552 ITLI=ITLI-IT0 523.
553 C 524.
554 BLISUM=0. 525.
555 BLIM=0. 526.
556 BLIP=0. 527.
557 BGF=0. 528.
558 C 529.
559 DO 610 K=1,NKTR 530.
560 TRAPLI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNL) 531.
561 + +AGSIDV(K,2)*EICTRA*EXPSNL 532.
562 BLIM1 =(PLANCK(ITLI-1)-(PLANCK(ITLI-1)-PLANCK(ITLI ))*WTLI) 533.
563 + *(1.-TRAPLI) 534.
564 BLIM =BLIM+BLIM1 535.
565 BLIP1 =(PLANCK(ITLI+1)-(PLANCK(ITLI+1)-PLANCK(ITLI+2))*WTLI) 536.
566 + *(1.-TRAPLI) 537.
567 BLIP =BLIP+BLIP1 538.
568 BLI =(PLANCK(ITLI )-(PLANCK(ITLI )-PLANCK(ITLI+1))*WTLI) 539.
569 + *(1.-TRAPLI) 540.
570 BLISUM=BLISUM+BLI 541.
571 ITLI=ITLI+ITNEXT 542.
572 C 543.
573 TRGALB(K)=TRGALB(K)+PLICE*TRAPLI 544.
574 BGFEMD(K)=BGFEMD(K)+PLICE*(BLIP1-BLIM1) 545.
575 610 BGFEMT(K)=BGFEMT(K)+PLICE*BLI 546.
576 DTRUFG(4)=0.5*(BLIP-BLIM) 547.
577 C 548.
578 700 CONTINUE 549.
579 BVSURF=POCEAN*BOCVIS +PEARTH*BEAVIS +POICE*BOIVIS +PLICE*BLIVIS 550.
580 XVSURF=POCEAN*XOCVIS +PEARTH*XEAVIS +POICE*XOIVIS +PLICE*XLIVIS 551.
581 BNSURF=POCEAN*BOCNIR +PEARTH*BEANIR +POICE*BOINIR +PLICE*BLINIR 552.
582 XNSURF=POCEAN*XOCNIR +PEARTH*XEANIR +POICE*XOINIR +PLICE*XLINIR 553.
583
584 #if ( !defined CPL_CHEM ) && ( (defined SVI_ALBEDO || defined GHS_ALB) )
585 IF(COSZ.GE.0.01) then
586 XALBEDO=0.6*XVSURF+0.4*XNSURF
587 SECZ=1./COSZ
588 if(JLAT.le.-2)then
589 print *,' JLAT=',JLAT
590 print *,' COSZ=',COSZ
591 print*,POCEAN,PEARTH,POICE,PLICE
592 print *,' XALBEDO=',XALBEDO
593 print *,BVSURF,XVSURF,BNSURF,XNSURF
594 endif
595 BVSURF=BVSURF+BVSURFA*(1.-XALBEDO)**2*SECZ
596 XVSURF=XVSURF+XVSURFA*(1.-XALBEDO)**2*SECZ
597 BNSURF=BNSURF+BNSURFA*(1.-XALBEDO)**2*SECZ
598 XNSURF=XNSURF+XNSURFA*(1.-XALBEDO)**2*SECZ
599 if(JLAT.eq.-10)then
600 print *,' After add'
601 print *,'BVSURFA=',BVSURFA
602 print *,'DAsrf=',BVSURFA*(1.-XALBEDO)**2*SECZ
603 print *,BVSURF,XVSURF,BNSURF,XNSURF
604 endif
605 endif
606 #endif
607
608 C ---------------------------------------------------------------- 554.
609 C SPECTRAL DISTRIBUTION ASSUMES THAT: AMEAN = 0.6*AVIS + 0.4*ANIR 555.
610 C ---------------------------------------------------------------- 556.
611 C 557.
612 IF(KEEPAL.EQ.1) GO TO 800 558.
613 SRBALB(6)=BVSURF+0.4*VISNIR*(BNSURF-BVSURF) 559.
614 SRXALB(6)=XVSURF+0.4*VISNIR*(XNSURF-XVSURF) 560.
615 DO 710 I=1,5 561.
616 SRBALB(I)=BNSURF-0.6*VISNIR*(BNSURF-BVSURF) 562.
617 710 SRXALB(I)=XNSURF-0.6*VISNIR*(XNSURF-XVSURF) 563.
618 IF(KALVIS.EQ.0) GO TO 800 564.
619 SRBALB(4)=SRBALB(6) 565.
620 SRXALB(4)=SRXALB(6) 566.
621 C 567.
622 C-------------------------------------------------------------------- 568.
623 C DEFINE SURFACE FLUX FACTORS, FLUX DERIVATIVES FOR EACH SURFTYPE 569.
624 C-------------------------------------------------------------------- 570.
625 800 BGF=0. 571.
626 DO 810 K=1,NKTR 572.
627 BGFEMD(K)=BGFEMD(K)*0.5 573.
628 810 BGF=BGF+BGFEMT(K) 574.
629 C 575.
630 BGM=BOCM*POCEAN+BEAM*PEARTH+BOIM*POICE+BLIM*PLICE 576.
631 BGP=BOCP*POCEAN+BEAP*PEARTH+BOIP*POICE+BLIP*PLICE 577.
632 TTRUFG=0.5*(BGP-BGM) 578.
633 C 579.
634 FTRUFG(1)=BOCSUM/BGF 580.
635 FTRUFG(2)=BEASUM/BGF 581.
636 FTRUFG(3)=BOISUM/BGF 582.
637 FTRUFG(4)=BLISUM/BGF 583.
638 C 584.
639 RETURN 585.
640 END 586.
641 c SUBROUTINE SETGAS 587.
642 c 20/06/2005
643 SUBROUTINE SETGAS(KTREND)
644
645 #include "B83XX.COM" 588.
646 #include "chem_para"
647 #include "chem_com"
648
649 EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 649.
650 EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 650.
651 C 651.
652 C 652.
653 C---------------------------------------------------------------------- 653.
654 C GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS 654.
655 C---------------------------------------------------------------------- 655.
656 C 656.
657 COMMON/O3GLOB/ PLB0(40),TLM0(40),U0GAS3(40) 656.11
658 DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 657.
659 DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 658.
660 + ,3.7338E-03/ 659.
661 DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/ 660.
662 DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 661.
663 DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 662.
664 DATA HPCON/34.16319/ 663.
665 DATA PI/3.1415926/ 664.
666 DATA P0/1013.25/ 665.
667 C 666.
668 DIMENSION KGAS(9,3) 667.
669 DATA KGAS/ 1, 2, 3, 0, 0, 9, 11, 12, 13 668.
670 + , 4, 6, 8, 0, 0,10, 0, 0, 0 669.
671 + , 5, 7, 0, 0, 0, 0, 0, 0, 0/ 670.
672 C 671.
673 C ----------------------------------------------------- 672.
674 C USE PLB TO FIX STANDARD HEIGHTS FOR GAS DISTRIBUTIONS 673.
675 C ----------------------------------------------------- 674.
676 C 675.
677 c print *,'FROM SETGAS PREDICTED_GASES=',PREDICTED_GASES
678 c 6/20/2005
679 if(KTREND.le.0)then
680 C assign background GHGs
681 PPMV58(2)=GHGBGR(1) ! CO2
682 PPMV58(6)=GHGBGR(2) ! N2O
683 PPMV58(7)=GHGBGR(3) ! CH4
684 PPMV58(8)=GHGBGR(4) ! F11
685 PPMV58(9)=GHGBGR(5) ! F12
686 endif
687 print *,'PPMV58 from SETGAS'
688 print *,PPMV58
689 NLP=NL+1 676.
690 NLMOD=NLP-LAYRAD 677.
691 PS0=PLB(1) 678.
692 PTOP=PLB(NLP-LAYRAD) 679.
693 C 680.
694 DO 100 L=1,NL 681.
695 DPL(L)=PLB(L)-PLB(L+1) 682.
696 100 PL(L)=(PLB(L)+PLB(L+1))*0.5 683.
697 NLNKTR=NL*NKTR 684.
698 C 685.
699 IF(LASTVC.GE.0) GO TO 107 686.
700 C 687.
701 print *,' Before DO 105'
702 DO 105 L=1,NL 688.
703 P=PLB(L) 689.
704 DO 101 N=2,8 690.
705 IF(P.GT.SPLB(N)) GO TO 102 691.
706 101 CONTINUE 691.5
707 N=9 692.
708 102 N=N-1 693.
709 IF(ABS(SDLB(N)).LT.1.E-04) GO TO 103 694.
710 H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 695.
711 GO TO 104 696.
712 C ALOG
713 103 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 697.
714 C ALOG
715 104 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 698.
716 TLB(L)=T 699.
717 105 HLB(L)=H 700.
718 ! print *,' After 105'
719 HLB(1)=1.E-10 701.
720 HLB(NL+1)=99.99 702.
721 TLB(NL+1)=STLB(8) 703.
722 DO 106 L=1,NL 704.
723 TLT(L)=TLB(L+1) 705.
724 106 TLM(L)=0.5*(TLB(L)+TLT(L)) 706.
725 TLB(NL+1)=TLT(NL) 707.
726 C 708.
727 107 NLAY=LASTVC/100000 709.
728 NATM=(LASTVC-NLAY*100000)/10000 710.
729 IF(NATM.GT.0) GO TO 112 711.
730 C 712.
731 C--------------------------------------------------------------------- 713.
732 C DEFINE GLOBAL MEAN GAS AMOUNTS FOR TRACEGAS & OVERLAP ABSORPTION 714.
733 C--------------------------------------------------------------------- 715.
734 C 716.
735 C ---------------------------- 717.
736 C GLOBAL MEAN H2O DISTRIBUTION 718.
737 C ---------------------------- 719.
738 RHP=0.77 720.
739 EST=10.0**(9.4051-2353.0/TLB(1)) 721.
740 FWB=0.662*RHP*EST/(PLB(1)-RHP*EST) 722.
741 DO 111 L=1,NL 723.
742 PLT=PLB(L+1) 724.
743 DP=PLB(L)-PLT 725.
744 RHP=0.77*(PLT/P0-0.02)/.98 726.
745 EST=10.0**(9.4051-2353.0/TLT(L)) 727.
746 FWT=0.662*RHP*EST/(PLT-RHP*EST) 728.
747 IF(FWT.GT.3.E-06) GO TO 110 729.
748 FWT=3.E-06 730.
749 RHP=FWT*PLT/(EST*(FWT+0.662)) 731.
750 110 ULGASL=0.5*(FWB+FWT)*DP*1270. 732.
751 C$110 ULGASL=0.5*(FWB+FWT)*DP*1268.75 733.
752 U0GAS(L,1)=ULGASL 734.
753 SHL(L)=ULGASL/(ULGASL+1268.75*DP) 735.
754 EQ=0.5*(PLB(L)+PLT)*SHL(L)/(0.662+0.378*SHL(L)) 736.
755 ES=10.**(9.4051-2353./TLM(L)) 737.
756 RHL(L)=EQ/ES 738.
757 111 FWB=FWT 739.
758 112 CONTINUE 740.
759 C ---------------------------- 741.
760 C GLOBAL MEAN O3 DISTRIBUTION 742.
761 C---------------- ---------------------------- 743.
762 ! print *,' Before SETO3D'
763 CALL SETO3D 744.
764 ! print *,' After SETO3D'
765 C---------------- 745.
766 JJLAT=JLAT 746.
767 C IF(JDAY.LT.1) KEEP SETATM O3 DISTRIBUTION 747.
768 C ------------------------------------------ 748.
769 IF(JDAY.LT.1) GO TO 125 749.
770 C---------------- 750.
771 ! print *,' Before O3DDAY'
772 CALL O3DDAY 751.
773 ! print *,' After O3DDAY'
774 C---------------- 752.
775 C 753.
776 DO 120 J=1,JMLAT 754.
777 RADLAT=PI*DLAT(J)/180. 755.
778 120 COSLAT(J)=0.5+0.5*SIN(RADLAT) 756.
779 C 757.
780 DO 121 N=1,NL 758.
781 121 UO3L(N)=0. 759.
782 DO 123 JLAT=1,JMLAT 760.
783 C---------------- 761.
784 ! print *,' Before O3DLAT'
785 CALL O3DLAT 762.
786 ! print *,' After O3DLAT'
787 C---------------- 763.
788 JB=JLAT+1 764.
789 JA=JLAT-1 765.
790 IF(JB.GT.JMLAT) JB=JMLAT 766.
791 IF(JA.LT.1 ) JA=1 767.
792 WTLAT=0.5*(COSLAT(JB)-COSLAT(JA)) 768.
793 DO 122 N=1,NL 769.
794 122 UO3L(N)=UO3L(N)+U0GAS(N,3)*WTLAT 770.
795 123 CONTINUE 771.
796 DO 124 N=1,NL 772.
797 124 U0GAS(N,3)=UO3L(N) 773.
798 125 JLAT=JJLAT 774.
799 ! print *,' After 774'
800 XXXX=SETAO3(OCM) 775.
801 ! print *,' After 775'
802 C 775.11
803 C SAVE GLOBAL MEAN P,T,O3 FOR UPDATING LAPGAS TAU TABLE IN SETLAP 775.12
804 C --------------------------------------------------------------- 775.13
805 C 775.14
806 DO 126 N=1,NL 775.15
807 PLB0(N)=PLB(N) 775.16
808 TLM0(N)=TLM(N) 775.17
809 126 U0GAS3(N)=U0GAS(N,3) 775.18
810 PLB0(NLP)=PLB(NLP) 775.19
811 C ---------------------------- 776.
812 C GLOBAL MEAN NO2 DISTRIBUTION 777.
813 C ---------------------------- 778.
814 ! print *,' After 778'
815 ACM=0.0 779.
816 HI=0.0 780.
817 FI=CMANO2(1) 781.
818 HL=HLB(2) 782.
819 L=1 783.
820 J=1 784.
821 130 J=J+1 785.
822 IF(J.GT.42) GO TO 133 786.
823 HJ=HI+2.0 787.
824 FJ=CMANO2(J) 788.
825 131 DH=HJ-HI 789.
826 IF(HJ.GT.HL) GO TO 132 790.
827 ACM=ACM+(FI+FJ)*DH*0.5 791.
828 HI=HJ 792.
829 FI=FJ 793.
830 GO TO 130 794.
831 132 FF=FI+(FJ-FI)*(HL-HI)/DH 795.
832 DH=HL-HI 796.
833 ACM=ACM+(FI+FJ)*DH*0.5 797.
834 U0GAS(L,5)=ACM 798.
835 ACM=0.0 799.
836 HI=HL 800.
837 FI=FF 801.
838 IF(L.EQ.NL) GO TO 133 802.
839 L=L+1 803.
840 HL=HLB(L+1) 804.
841 GO TO 131 805.
842 133 U0GAS(L,5)=ACM 806.
843 ACM=0.0 807.
844 L=L+1 808.
845 IF(L.LT.NLP) GO TO 133 809.
846 ! print *,' After 809'
847 C ----------------------------------------- 810.
848 C (CO2,O2) UNIFORMLY MIXED GAS DISTRIBUTION 811.
849 C ----------------------------------------- 812.
850 DO 141 K=2,4,2 813.
851 DO 140 N=1,NL 814.
852 140 U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 815.
853 141 CONTINUE 816.
854 C PRINT
855 print *,' CO2',PPMV58(2)
856 c print *,'NLMOD=',NLMOD
857 c print *,'PSIG'
858 c print *,(PSIG(L),L=1,NLMOD+1)
859 c print *,'PLB'
860 c print *,(PLB(L),L=1,NLMOD+1)
861 c print *,(U0GAS(n,2),n=1,nl)
862 C PRINT
863 C ----------------------------------------------------- 817.
864 C (N20,CH4,F11,F12) SPECIFIED VERTICAL GAS DISTRIBUTION 818.
865 C ----------------------------------------------------- 819.
866 DO 151 K=6,9 820.
867 DO 150 N=1,NL 821.
868 U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 822.
869 ZT=(HLB(N+1)-Z0(K))/ZH(K) 823.
870 IF(ZT.LE.0.) GO TO 150 824.
871 ZB=(HLB(N)-Z0(K))/ZH(K) 825.
872 EXPZT=EXP(-ZT) 826.
873 EXPZB=EXP(-ZB) 827.
874 IF(ZB.LT.0.) EXPZB=1.-ZB 828.
875 U0GAS(N,K)=U0GAS(N,K)*(EXPZB-EXPZT)/(ZT-ZB) 829.
876 150 CONTINUE 830.
877 151 CONTINUE 831.
878 C ------------------------------------------------ 832.
879 C SPECIFIED GAS AMOUNTS (INCLUDING SCALING FACTOR) 833.
880 C ------------------------------------------------ 834.
881 C 835.
882 DO 161 K=1,9 836.
883 DO 160 N=1,NL 837.
884 160 ULGAS(N,K)=U0GAS(N,K)*FULGAS(K) 838.
885 161 CONTINUE 839.
886 C PRINT
887 ! print *,' after 161'
888 ! print *,(ULGAS(n,2),n=1,nl)
889 C PRINT
890 C 840.
891 C------------------------------- 841.
892 CALL SETAO2(ULGAS(1,4),NL) 842.
893 C------------------------------- 843.
894 C 844.
895 C -------------------------------------------------------------- 845.
896 C OVERLAP ABSORPTION (ILGAS1,ILGAS2) FOR GLOBAL MEAN GAS AMOUNTS 846.
897 C -------------------------------------------------------------- 847.
898 DO 170 K=1,30 848.
899 170 MLGAS(K)=0 849.
900 IF(LAPGAS.LT.1) GO TO 174 850.
901 DO 172 L=1,3 851.
902 DO 171 K=ILGAS1,ILGAS2 852.
903 M=KGAS(K,L) 853.
904 IF(M.GT.3) MLGAS(M)=1 854.
905 171 CONTINUE 855.
906 172 CONTINUE 856.
907 DO 173 K=1,15 857.
908 173 MLGAS(15+K)=MLGAS(K) 858.
909 174 CONTINUE 859.
910 C 860.
911 C ---------------------------------------------------------------- 861.
912 C TAULAP=OVERLAP ABSORPTION KEPT AS INITIALIZED (NO CHANGES LATER) 862.
913 C ---------------------------------------------------------------- 863.
914 C 864.
915 DO 180 I=1,1000 865.
916 TAULAP(I)=0. 866.
917 180 TAUN(I)=0. 867.
918 C 868.
919 C-------------------------------- 869.
920 IF(LAPGAS.GT.0) CALL TAUGAS 870.
921 C-------------------------------- 871.
922 C 872.
923 DO 181 I=1,NLNKTR 873.
924 181 TAULAP(I)=TAUN(I) 874.
925 C 875.
926 C ---------------------------------------------------------- 876.
927 C MAIN GAS (IMGAS1,IMGAS2) ABSORPTION INTERPOLATED AS NEEDED 877.
928 C ---------------------------------------------------------- 878.
929 C 879.
930 DO 191 L=1,3 880.
931 DO 190 K=IMGAS1,IMGAS2 881.
932 M=KGAS(K,L) 882.
933 IF(M.GT.0) MLGAS(M)=1 883.
934 190 CONTINUE 884.
935 191 CONTINUE 885.
936 DO 192 K=1,13 886.
937 192 MLGAS(K)=MLGAS(K)*(MLGAS(K)-MLGAS(K+15)) 887.
938 IF(IMGAS1.EQ.1) MLGAS(14)=1 888.
939 IF(KWVCON.EQ.1) MLGAS(15)=1 889.
940 DO 193 K=1,30 890.
941 193 MLLAP(K)=MLGAS(K) 891.
942 C 892.
943 RETURN 893.
944 C 894.
945 C----------------------------------------------------------------------- 895.
946 C REDEFINE TAULAP TABLE: GET ABSORPTION FROM TAUGAS TABLE 896.
947 ENTRY SETLAP 897.
948 C----------------------------------------------------------------------- 898.
949 C 899.
950 IF(LAPGAS.EQ.1) RETURN 900.
951 C 901.
952 DO 200 I=1,1000 902.
953 200 TAULAP(I)=0. 903.
954 IF(LAPGAS.EQ.0) RETURN 904.
955 C 905.
956 DO 210 K=1,15 906.
957 210 MLGAS(K)=MLLAP(K+15) 907.
958 C 908.
959 DO 220 I=1,NLNKTR 909.
960 220 TAUN(I)=TAULAP(I) 910.
961 C 911.
962 DO 230 L=1,NL 912.
963 DPL(L)=PLB0(L)-PLB0(L+1) 912.11
964 PL(L)=(PLB0(L)+PLB0(L+1))*0.5 912.12
965 TLM(L)=TLM0(L) 912.13
966 U0GAS(L,3)=U0GAS3(L) 912.14
967 C 912.15
968 ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 913.
969 ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 914.
970 230 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 915.
971 C 916.
972 c
973 tropmass = 28.97296245*1.e-3*0.8/P0
974 trpm=tropmass*1.e3
975 DO 240 L=1,nlev
976 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
977
978 #ifdef PREDICTED_GASES
979 pxxx = dpl(l)
980
981 ULGAS(L,2)=glbgas(l,1)*tropmass/44.0098
982 & *pxxx
983 ULGAS(L,6)=glbgas(l,2)*tropmass/44.0000
984 & *pxxx
985 ULGAS(L,7)=glbgas(l,3)*tropmass/16.0426
986 & *pxxx
987 ULGAS(L,8)=glbgas(l,4)*tropmass/137.3675
988 & *pxxx
989 ULGAS(L,9)=glbgas(l,5)*tropmass/120.9054
990 & *pxxx
991 #else
992 !
993 !prescribed greenhouse
994 ! gas profiles
995 !
996 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2) 918.
997 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6) 920.
998 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7) 921.
999 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8) 922.
1000 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1001 #endif
1002 240 continue
1003 ll=nlev
1004 do 2240 l=nlev+1,NL
1005 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
1006 #ifdef PREDICTED_GASES
1007 pxxx = dpl(l)
1008
1009 ULGAS(L,2)=glbgas(ll,1)*tropmass/44.0098
1010 & *pxxx
1011 ULGAS(L,6)=glbgas(ll,2)*tropmass/44.0000
1012 & *pxxx
1013 ULGAS(L,7)=glbgas(ll,3)*tropmass/16.0426
1014 & *pxxx
1015 ULGAS(L,8)=glbgas(ll,4)*tropmass/137.3675
1016 & *pxxx
1017 ULGAS(L,9)=glbgas(ll,5)*tropmass/120.9054
1018 & *pxxx
1019 #else
1020 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)
1021 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)
1022 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)
1023 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)
1024 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1025 #endif
1026 2240 continue
1027 C PRINT
1028 c print *,' after 240'
1029 c print *,(ULGAS(n,2),n=1,nl)
1030 C PRINT
1031 C 924.
1032 C----------------- 925.
1033 CALL TAUGAS 926.
1034 C----------------- 927.
1035 C 928.
1036 DO 250 I=1,NLNKTR 929.
1037 250 TAULAP(I)=TAUN(I) 930.
1038 C 931.
1039 DO 260 K=1,15 932.
1040 260 MLGAS(K)=MLLAP(K) 933.
1041 C 934.
1042 RETURN 935.
1043 C 936.
1044 C----------------------------------------------------------------------- 937.
1045 C SPECIFY ULGAS: GET MAINGAS ABSORPTION FROM TAUGAS TABLE 938.
1046 ENTRY GETGAS 939.
1047 C----------------------------------------------------------------------- 940.
1048 C 941.
1049 C----------------- 942.
1050 CALL O3DLON 943.
1051 C----------------- 944.
1052 C 945.
1053 DO 300 L=1,NL 946.
1054 DPL(L)=PLB(L)-PLB(L+1) 947.
1055 300 PL(L)=(PLB(L)+PLB(L+1))*0.5 948.
1056 C 949.
1057 IF(KEEPRH.EQ.1) GO TO 311 950.
1058 DO 310 L=1,NL 951.
1059 310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 952.
1060 C$310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 953.
1061 GO TO 313 954.
1062 311 CONTINUE 955.
1063 DO 312 L=1,NL 956.
1064 ES=10.0**(9.4051-2353.0/TLM(L)) 957.
1065 SHL(L)=0.622*(RHL(L)*ES)/(PL(L)-0.378*(RHL(L)*ES)) 958.
1066 312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 959.
1067 C$312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 960.
1068 313 CONTINUE 961.
1069 C 962.
1070 DO 320 I=1,NLNKTR 963.
1071 320 TAUN(I)=TAULAP(I) 964.
1072 C 965.
1073 DO 330 L=1,NL 966.
1074 ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 967.
1075 ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 968.
1076 330 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 969.
1077 C 970.
1078 PART=(PLB(1)-PTOP)/(PS0-PTOP) 971.
1079
1080 !
1081 ! --- Chemistry model patch 080895
1082 !
1083 ! --- Note: most of the modifications in following
1084 ! sections were made originally as a part of chemistry
1085 ! module ( PREDICTED_GASES == CPL_CHEM ). However,
1086 ! they can be used by non-interactive
1087 ! chemistry-climate runs now, as far as the prescribed
1088 ! profiles of chemical species and aerosols are
1089 ! available.
1090 !
1091 ! Chien Wang
1092 ! 080100
1093 !
1094
1095 c ===
1096 c Prescribed gaseous profiles:
1097 c
1098 c DO 340 L=1,NL 972.
1099 c IF(L.EQ.NLMOD) PART=1. 973.
1100 c ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART 974.
1101 c ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART 975.
1102 c ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART 976.
1103 c ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART 977.
1104 c ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART 978.
1105 c ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART 979.
1106 c340 continue
1107 c goto 9341
1108 c
1109 c ===
1110
1111 !
1112 ! --- Use predicted gaseous profiles:
1113 !
1114 tropmass = 28.97296245*1.e-3*0.8/P0
1115 trpm=tropmass*1.e3
1116
1117 !
1118 ! --- Use internal point to avoid possible unstable
1119 ! --- problem related to LBC:
1120 !
1121 jyyy = max(3, min(nlat2,JLAT))
1122 !
1123
1124 do 2340 l=1,nlev
1125 IF(L.EQ.NLMOD) PART=1.
1126
1127 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1128
1129 #ifdef PREDICTED_GASES
1130 !
1131 ! --- predicted greenhouse gas profiles
1132 !
1133 pxxx = dpl(l)*part
1134
1135 c if (JLAT.eq.12) then
1136 c print *,'zco2=',zco2(1,jlat,l)
1137 c endif
1138 ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,l))/44.0098
1139 & *pxxx*tropmass
1140 c if (JLAT.eq.12) then
1141 c print *,'l=',L,' ULGAS(L,2)=',ULGAS(L,2)
1142 c endif
1143
1144 #ifdef O3_RAD
1145 !
1146 ! === Chien Wang 121797 then 062498 ===
1147 ! === add to use predicted ozone ===
1148 ! === in troposphere only ===
1149 if(l.le.n_tropopause)
1150 & ULGAS(L,3)=dmax1(0.0,o3(ILON,jyyy,l))/48.0
1151 & *pxxx*tropmass
1152 #endif
1153
1154 !
1155 ! --- Chem adjustmen of N2O and CH4 concentrations
1156 !
1157 xxxo=dmax1(0.0,xn2o(ILON,jyyy,l))
1158 & *tropmass/44.0000*1.25*P0
1159 yyyo=dmax1(0.0,ch4(ILON,jyyy,l))
1160 & *tropmass/16.0426*1.25*P0
1161 call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1162
1163 ULGAS(L,6)=xxxn*0.8*pxxx/P0
1164 ULGAS(L,7)=yyyn*0.8*pxxx/P0
1165
1166 #ifdef INC_3GASES
1167 !
1168 ! === if hfc, pfc, and sf6 are included:
1169 !
1170 ! === 032698
1171 ! === add hfc134a, pfc and sf6 to equivilent f11:
1172 ! ===
1173 equi_cfc11 = cfc11(ILON,jyyy,l)
1174 & + hfc134a(ilon,jyyy,l)*dhfc134a_df11
1175 & + pfc (ilon,jyyy,l)*dpfmethane_df11
1176 & + sf6 (ilon,jyyy,l)*dsf6_df11
1177 #else
1178 equi_cfc11 = cfc11(ILON,jyyy,l)
1179 #endif
1180 ! ===
1181 ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1182 & *tropmass/137.3675
1183 & *pxxx
1184 ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,l))
1185 & *tropmass/120.9054
1186 & *pxxx
1187
1188 #else
1189 !
1190 ! --- prescribed greenhouse gas profiles
1191 !
1192 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1193 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1194 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1195 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1196 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1197 #endif
1198
1199 #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1200 C-- Added ozone forcing from external source.
1201 C-- changed 18Mar98 CEForest
1202 C NB. ozone is updated daily
1203 C o3 = ppb(m)
1204 C 48 = mol weight of o3
1205 C ULGAS = cm^3 (STP)/cm^2
1206 C
1207 C 15JAN03 CEForest
1208 C changed to use total ozone, rather than anomalies, from GISS data
1209 C
1210 pxxx = dpl(l)*part
1211 ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1212 & *pxxx*tropmass
1213 C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1214 C-- end of change 18Mar98
1215 #endif
1216
1217 2340 continue
1218
1219 ll=nlev
1220 do 2342 l=nlev+1,NL
1221 IF(L.EQ.NLMOD) PART=1.
1222
1223 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1224
1225 #ifdef PREDICTED_GASES
1226 !
1227 ! --- predicted greenhouse gas profiles
1228 !
1229 pxxx = dpl(l)*part
1230
1231 ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,ll))
1232 & *tropmass/44.0098
1233 & *pxxx
1234 !
1235 ! --- Chem adjustmen of N2O and CH4 concentrations
1236 !
1237 xxxo=dmax1(0.0,xn2o(ILON,jyyy,ll))
1238 & *tropmass/44.0000*1.25*P0
1239 yyyo=dmax1(0.0,ch4(ILON,jyyy,ll))
1240 & *tropmass/16.0426*1.25*P0
1241 call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1242
1243 ULGAS(L,6)=xxxn*0.8*pxxx/P0
1244 ULGAS(L,7)=yyyn*0.8*pxxx/P0
1245
1246 #ifdef INC_3GASES
1247 !
1248 ! === if hfc, pfc, and sf6 are included:
1249 !
1250 ! === 032698
1251 ! === add hfc134a, pfc and sf6 to equivilent f11:
1252 ! ===
1253 equi_cfc11 = cfc11(ILON,jyyy,ll)
1254 & + hfc134a(ilon,jyyy,ll)*dhfc134a_df11
1255 & + pfc (ilon,jyyy,ll)*dpfmethane_df11
1256 & + sf6 (ilon,jyyy,ll)*dsf6_df11
1257 #else
1258 equi_cfc11 = cfc11(ILON,jyyy,ll)
1259 #endif
1260 ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1261 & *tropmass/137.3675
1262 & *pxxx
1263 ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,ll))
1264 & *tropmass/120.9054
1265 & *pxxx
1266 #else
1267 !
1268 ! --- prescribed greenhouse gas profiles
1269 !
1270 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1271 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1272 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1273 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1274 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1275 #endif
1276
1277 #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1278 C-- Added ozone forcing from external source.
1279 C-- changed 18Mar98 CEForest
1280 C NB. ozone is updated daily
1281 C o3 = ppb(m)
1282 C 48 = mol weight of o3
1283 C ULGAS = cm^3 (STP)/cm^2
1284 C
1285 C 15JAN03 CEForest
1286 C changed to use total ozone, rather than anomalies, from GISS data
1287 C
1288 C added adjustment to layers (nlev+1:nlev+3) above dynamics layers
1289 pxxx = dpl(l)*part
1290 ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1291 & *pxxx*tropmass
1292 C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1293 C-- end of change 18Mar98
1294 #endif
1295
1296
1297 2342 continue
1298
1299 c
1300 c-------------------------------------------------------
1301
1302 C----------------- 981.
1303 CALL TAUGAS 982.
1304 C----------------- 983.
1305 C 984.
1306 RETURN 985.
1307 C 986.
1308 C----------------------------------------------------------------------- 987.
1309 C IF(KGASSR.GT.0) REDEFINE ULGAS FOR SOLAR FULGAS VALUES 988.
1310 ENTRY SOLGAS 989.
1311 C----------------------------------------------------------------------- 990.
1312 C 991.
1313 C 992.
1314 DO 400 L=1,NL 993.
1315 ULGAS(L,1)=U0GAS(L,1)*FULGAS(1+9) 994.
1316 ULGAS(L,3)=U0GAS(L,3)*FULGAS(3+9) 995.
1317 400 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5+9) 996.
1318 C 997.
1319 PART=(PLB(1)-PTOP)/(PS0-PTOP) 998.
1320 DO 410 L=1,NL 999.
1321 IF(L.EQ.NLMOD) PART=1. 1000.
1322 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2+9)*PART 1001.
1323 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4+9)*PART 1002.
1324 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6+9)*PART 1003.
1325 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7+9)*PART 1004.
1326 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8+9)*PART 1005.
1327 410 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9+9)*PART 1006.
1328 C 1007.
1329 C 1008.
1330 RETURN 1009.
1331 END 1010.
1332 SUBROUTINE SETAER 1011.
1333
1334 #include "chem_para"
1335 #include "chem_com"
1336 #include "B83XX.COM" 1012.
1337
1338 C 1073.
1339 EQUIVALENCE (FEMTRA(1),ECLTRA) 1074.
1340 EQUIVALENCE (ISPARE(2),NEWAQA) 1074.1
1341 EQUIVALENCE (ISPARE(3),NEWCQA) 1074.2
1342 C 1075.
1343 DIMENSION SRAX(40,6,5),SRAS(40,6,5),SRAC(40,6,5) 1076.
1344 C 1077.
1345 C-----------------------------------------------------------------------1078.
1346 C THERMAL: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1079.
1347 C-----------------------------------------------------------------------1080.
1348 C 1081.
1349 DO 100 J=1,NGOLDH 1082.
1350 DO 100 K=1,NKTR 1083.
1351 DO 100 L=1,NL 1084.
1352 100 TRAX(L,K,J)=0. 1085.
1353 C 1086.
1354 DO 103 I=1,NAERO 1087.
1355 DO 103 J=1,NGOLDH 1088.
1356 IF(AGOLDH(I,J).LT.1.E-06) GO TO 103 1089.
1357 C=CGOLDH(I,J) 1090.
1358 BC=EXP(-BGOLDH(I,J)/C) 1091.
1359 ABC=AGOLDH(I,J)*(1.0+BC) 1092.
1360 C 1093.
1361 DO 102 L=1,NL 1094.
1362 C AMIN
1363 ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1364 + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1365 C AMIN
1366 DO 101 K=1,NKTR 1097.
1367 TRANEW=TRACOS(K,I) 1097.5
1368 IF(NEWAQA.GT.0) TRANEW=1.0 1097.6
1369 101 TRAX(L,K,J)=TRAX(L,K,J)+ABCD*(TRAQEX(K,I)-TRANEW*TRAQSC(K,I)) 1098.
1370 102 CONTINUE 1099.
1371 103 CONTINUE 1100.
1372 C 1101.
1373 DO 104 J=1,2 1102.
1374 DO 104 K=1,NKTR 1103.
1375 TRCNEW=TRCCOS(K,J) 1103.5
1376 IF(NEWCQA.GT.0) TRCNEW=1.0 1103.6
1377 104 TRCX(K,J)=TRCQEX(K,J)-TRCNEW*TRCQSC(K,J) 1104.
1378 C 1105.
1379 C-----------------------------------------------------------------------1106.
1380 C SOLAR: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1107.
1381 C-----------------------------------------------------------------------1108.
1382 C 1109.
1383 DO 110 J=1,NGOLDH 1110.
1384 DO 110 K=1,NKSR 1111.
1385 DO 110 L=1,NL 1112.
1386 SRAX(L,K,J)=1.E-30 1113.
1387 SRAS(L,K,J)=1.E-31 1114.
1388 110 SRAC(L,K,J)=0. 1115.
1389 C 1116.
1390 DO 113 I=1,NAERO 1117.
1391 DO 113 J=1,NGOLDH 1118.
1392 IF(AGOLDH(I,J).LT.1.E-06) GO TO 113 1119.
1393 C=CGOLDH(I,J) 1120.
1394 BC=EXP(-BGOLDH(I,J)/C) 1121.
1395 ABC=AGOLDH(I,J)*(1.0+BC) 1122.
1396 C 1123.
1397 DO 112 L=1,NL 1124.
1398 C AMIN
1399 ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1400 + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1401 C AMIN
1402 DO 111 K=1,NKSR 1127.
1403 SRAX(L,K,J)=SRAX(L,K,J)+ABCD*SRAQEX(K,I) 1128.
1404 SRAS(L,K,J)=SRAS(L,K,J)+ABCD*SRAQSC(K,I) 1129.
1405 111 SRAC(L,K,J)=SRAC(L,K,J)+ABCD*SRACOS(K,I)*SRAQSC(K,I) 1130.
1406 112 CONTINUE 1131.
1407 113 CONTINUE 1132.
1408 C 1133.
1409 DO 114 J=1,NGOLDH 1134.
1410 DO 114 K=1,NKSR 1135.
1411 DO 114 L=1,NL 1136.
1412 114 SRAC(L,K,J)=SRAC(L,K,J)/SRAS(L,K,J) 1137.
1413 C 1138.
1414 C----------------- 1139.
1415 ENTRY GETAER 1140.
1416 C----------------- 1141.
1417 C 1142.
1418 C-----------------------------------------------------------------------1143.
1419 C GET CLOUD & AEROSOL AMOUNTS & DISTRIBUTIONS1144.
1420 C-----------------------------------------------------------------------1145.
1421 LBOTCL=0 1146.
1422 LTOPCL=0 1147.
1423 DO 203 L=1,NL 1148.
1424 KCLD=1 1149.
1425 IF(TLM(L).LT.TKCICE) KCLD=2 1150.
1426 IF(CLDTAU(NLP-L).GT.0.1) LTOPCL=NLP-L 1151.
1427 C$ IF(CLDTAU(NLP-L).GT.0.1) LBOTCL=NLP-L *******************CORRECT1152.
1428 IF(CLDTAU( L).GT.0.1) LBOTCL=L 1153.
1429 C$ IF(CLDTAU( L).GT.0.1) LTOPCL=L ***********************CORRECT1154.
1430 C (THERMAL) 1155.
1431 C --------- 1156.
1432 DO 202 K=1,NKTR 1157.
1433 SUMEXT=1.E-30 1158.
1434 DO 201 J=1,NGOLDH 1159.
1435 201 SUMEXT=SUMEXT+FGOLDH(J)*TRAX(L,K,J) 1160.
1436 TRAEXT(L,K)=SUMEXT+CLDTAU(L)*TRCX(K,KCLD)*FCLDTR 1161.
1437 202 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+TRAEXT(L,K) 1162.
1438 203 CONTINUE 1163.
1439 C 1164.
1440 C-----------------------------------------------------------------------1165.
1441 C CLOUD ALBEDO & SURFACE LAYER FOG SPECIFICATION1166.
1442 C-----------------------------------------------------------------------1167.
1443 C 1168.
1444 DO 204 K=1,NKTR 1169.
1445 204 FTAUSL(K)=FOGTSL*TRCX(K,1)*FCLDTR 1170.
1446 IF(LTOPCL.GT.0) GO TO 206 1171.
1447 DO 205 K=1,NKTR 1172.
1448 205 TRCALB(K)=0. 1173.
1449 GO TO 210 1174.
1450 206 KCLD=1 1175.
1451 IF(TLM(LTOPCL).LT.TKCICE) KCLD=2 1176.
1452 DO 207 K=1,NKTR 1177.
1453 207 TRCALB(K)=(1.0-EXP(-CLDTAU(LTOPCL)*TRCX(K,KCLD)))*CLDALB(K,KCLD) 1178.
1454 + *ECLTRA*FCLDTR 1179.
1455 210 CONTINUE 1180.
1456 C (SOLAR) 1181.
1457 C ------- 1182.
1458 KSR=9*KAERSR 1183.
1459 DO 9212 K=1,NKSR 1184.
1460 DO 212 L=1,NL 1185.
1461 EXTSUM=1.E-30 1186.
1462 SCTSUM=1.E-31 1187.
1463 COSSUM=0. 1188.
1464 DO 211 J=1,NGOLDH 1189.
1465 EXTSUM=EXTSUM+FGOLDH(J+KSR)*SRAX(L,K,J) 1190.
1466 SCTSUM=SCTSUM+FGOLDH(J+KSR)*SRAS(L,K,J) 1191.
1467 211 COSSUM=COSSUM+FGOLDH(J+KSR)*SRAS(L,K,J)*SRAC(L,K,J) 1192.
1468
1469 #if ( defined PREDICTED_BC || defined PREDICTED_AEROSOL)
1470 !
1471 ! --- Chemistry model patch, 092901
1472 !
1473 ! === Chien Wang
1474 ! === (1) add to type 3 aerosol with
1475 ! === chemistry model predicted S(VI);
1476 ! === (2) add type 11 aerosol with
1477 ! === chemistry model predicted bcarbon
1478 ! ===
1479 if ( L .le. nlev1 ) then
1480 !
1481 ! === add as global aerosol
1482 ! Note: if needed the AGOLDH for prescribed
1483 ! tropospheric S(VI), SLFT1 & SLFT2, can be
1484 ! set to zero in later part of the code
1485 !
1486 ! FAERSOL/svi_intensity is added for using
1487 ! FAERSOL to switch between diagnostic/prognostic loops
1488 ! while normalize it to 1 in prognostic loop
1489 ! FBC added for black carbon 7/22/04
1490 !
1491 dsviod = 0.0
1492 dbcod = 0.0
1493
1494 #if ( defined PREDICTED_AEROSOL )
1495 dsviod = max(0.0,
1496 & (sviod(1,jlat,L) - sviod(1,jlat,L+1))
1497 & *FAERSOL )
1498 #endif
1499
1500 #if ( defined PREDICTED_BC)
1501 dbcod = max(0.0,
1502 & (bcod(1,jlat,L) - bcod(1,jlat,L+1))
1503 & *FBC )
1504 #endif
1505
1506 EXTSUM = EXTSUM
1507 & + dsviod*SRAQEX(K,3)
1508 & + dbcod*SRAQEX(K,11)
1509 SCTSUM = SCTSUM
1510 & + dsviod*SRAQSC(K,3)
1511 & + dbcod*SRAQSC(K,11)
1512 COSSUM = COSSUM
1513 & + dsviod*SRAQSC(K,3)*SRACOS(K,3)
1514 & + dbcod*SRAQSC(K,11)*SRACOS(K,11)
1515
1516 if(jlat.eq.-22.or.jlat.eq.-33)then
1517 if(L.eq.1.and.k.eq.1)then
1518 print *,'From r95 jlat=',jlat,' L=',L
1519 c print *,' LATHEM=',LATHEM, ' JNORTH=',JNORTH
1520 c print *,'FAERSOL=',FAERSOL,' FBC=',FBC
1521 print *,sviod(1,jlat,L),sviod(1,jlat,L+1)
1522 c print *,dsviod,SRAQEX(K,3)
1523 print *,bcod(1,jlat,L),bcod(1,jlat,L+1)
1524 c print *,dbcod,SRAQEX(K,11)
1525 c print *,SRAQSC(K,11),SRACOS(K,11)
1526 endif
1527 endif
1528 end if
1529 #endif
1530
1531 EXTAER(L,K)=EXTSUM 1193.
1532 SCTAER(L,K)=SCTSUM 1194.
1533 COSAER(L,K)=COSSUM/SCTSUM 1195.
1534
1535 212 continue
1536 9212 continue
1537 c
1538 c ======================================================
1539
1540 IF(NTRACE.GT.0) GO TO 300 1196.
1541 C 1197.
1542 C----------- 1198.
1543 RETURN 1199.
1544 C----------- 1200.
1545 C 1201.
1546 300 CONTINUE 1202.
1547 C-----------------------------------------------------------------------1203.
1548 C ADD TRACER AEROSOL THERMAL & SOLAR CONTRIBUTIONS 1204.
1549 C-----------------------------------------------------------------------1205.
1550 DO 303 JJ=1,NTRACE 1206.
1551 J=NGOLDH+JJ 1207.
1552 I=ITR(JJ) 1208.
1553 C (THERMAL) 1209.
1554 C --------- 1210.
1555 DO 302 K=1,NKTR 1211.
1556 C$ SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRACOS(K,I)*TRAQSC(K,I)) 1212.
1557 SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRAQSC(K,I)) 1212.11
1558 DO 301 L=1,NL 1213.
1559 301 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+SUMEXT*TRACER(L,JJ) 1214.
1560 302 CONTINUE 1215.
1561 303 CONTINUE 1216.
1562 C 1217.
1563 C (SOLAR) 1218.
1564 C ------- 1219.
1565 DO 305 K=1,NKSR 1220.
1566 DO 305 L=1,NL 1221.
1567 EXTSUM=EXTAER(L,K) 1222.
1568 SCTSUM=SCTAER(L,K) 1223.
1569 COSSUM=COSAER(L,K)*SCTAER(L,K) 1224.
1570 DO 304 JJ=1,NTRACE 1225.
1571 J=NGOLDH+JJ 1226.
1572 I=ITR(JJ) 1227.
1573 EXTSUM=EXTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQEX(K,I) 1228.
1574 SCTSUM=SCTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I) 1229.
1575 304 COSSUM=COSSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I)*SRACOS(K,I) 1230.
1576 EXTAER(L,K)=EXTSUM 1231.
1577 SCTAER(L,K)=SCTSUM 1232.
1578 305 COSAER(L,K)=COSSUM/SCTSUM 1233.
1579 RETURN 1234.
1580 END 1235.
1581 SUBROUTINE TAUGAS 1236.
1582
1583 #include "B83XX.COM"
1584
1585 C TAUGAS INPUT REQUIRES: NL,TLM,ULGAS,TRACEG,PL,DPL,TAUTBL,MLGAS 1295.11
1586 C TAUGAS OUTPUT DATA IS: TAUN 1295.12
1587 C 1296.
1588 DIMENSION IGASX(11),KGX(11),NUX(11),IGUX(11),NGX(3),IG1X(3) 1297.
1589 DIMENSION ULOX(165),DUX(165),PX(15),H2OCON(25) 1298.
1590 C 1299.
1591 DATA NTX/8/, TLOX/181./,DTX/23./ 1300.
1592 DATA NPX/15/, PX/1000., 975., 910., 800., 645., 1301.
1593 * 480., 330., 205., 110., 40., 1302.
1594 * 7.5, 3.5, 1.0, 0.1, .001/ 1303.
1595 C 1304.
1596 DATA NGUX/652/, NPUX/15/ 1305.
1597 DATA NGX/10,10,04/, IG1X/2,12,22/ 1306.
1598 DATA 1307.
1599 * IGASX/ 1, 2, 3, 1, 1, 2, 2, 3, 6, 6, 7/, 1308.
1600 * KGX/ 1, 2, 3, 2, 3, 1, 3, 2, 1, 2, 1/, 1309.
1601 * NUX/ 25, 9, 9, 9, 9, 5, 5, 5, 1, 1, 1/, 1310.
1602 * IGUX/ 0,250,340,376,466,502,552,572,622,632,642/ 1311.
1603 C 1312.
1604 C 1313.
1605 DATA ULOX/ .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1,.10E+1, 1314.
1606 *.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1315.
1607 *.50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+1,.10E+2,.80E+1, 1316.
1608 *.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3, 1317.
1609 *.40E-3,.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2, 1318.
1610 *.40E-2,.10E-4,.80E-7,.40E-7, .25E+2,.25E+2,.50E+2,.50E+2, 1319.
1611 *.25E+2,.50E+1,.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3, 1320.
1612 *.10E-5,.10E-5, .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1, 1321.
1613 *.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1322.
1614 * .50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2, 1323.
1615 *.80E+1,.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .50E+1, 1324.
1616 *.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2,.80E+1,.10E+1, 1325.
1617 *.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3,.40E-3, 1326.
1618 *.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2,.40E-2, 1327.
1619 *.10E-4,.80E-7,.40E-7, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1, 1328.
1620 *.35E-1,.31E-1,.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4, 1329.
1621 *.44E-6, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1,.35E-1,.31E-1, 1330.
1622 *.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4,.44E-6, 1331.
1623 *.64E-1,.64E-1,.10E+0,.18E+0,.22E+0,.20E+0,.18E+0,.14E+0,.10E+0, 1332.
1624 *.77E-1,.64E-2,.38E-2,.26E-2,.26E-3,.26E-5/ 1333.
1625 C 1334.
1626 DATA DUX/ .75E+2,.75E+2,.10E+3,.10E+3,.75E+2,.50E+2,.10E+2, 1335.
1627 *.20E+1,.20E+0,.10E+0,.50E-1,.10E-1,.40E-2,.40E-3,.40E-4, 1336.
1628 *.50E+1,.50E+1,.80E+1,.10E+2,.10E+2,.10E+2,.10E+2,.10E+2,.80E+1, 1337.
1629 *.50E+1,.35E+1,.25E+0,.25E+0,.10E+0,.10E-1, .30E-3,.30E-3, 1338.
1630 *.50E-3,.80E-3,.10E-2,.16E-2,.64E-2,.16E-2,.25E-1,.25E-1,.25E-1, 1339.
1631 *.45E-2,.25E-2,.10E-2,.25E-4, .24E+3,.24E+3,.30E+3,.30E+3, 1340.
1632 *.24E+3,.15E+3,.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1, 1341.
1633 *.12E-2,.12E-3, .24E+3,.24E+3,.30E+3,.30E+3,.24E+3,.15E+3, 1342.
1634 *.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1,.12E-2,.12E-3, 1343.
1635 * .10E+2,.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2, 1344.
1636 *.16E+2,.10E+2,.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .10E+2, 1345.
1637 *.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2,.16E+2,.10E+2, 1346.
1638 *.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .60E-3,.60E-3,.10E-2, 1347.
1639 *.16E-2,.20E-2,.32E-2,.13E-1,.32E-1,.50E-1,.50E-1,.50E-1,.90E-2, 1348.
1640 *.50E-2,.20E-2,.50E-4, 45*0./ 1349.
1641 C 1350.
1642 DATA H2OCON/ .767116, .322401, .572299,.58537, .48869, 1351.
1643 * .43539, .44322, .64072, .89293, 1.12733,1.65550, .865210, 1352.
1644 * 1.38403,1.80159,1.99196, 2.03403, 2.20561,2.42859,2.56883, 1353.
1645 * 2.67157,2.71888, .45534, .44735, .44534, .44365/ 1354.
1646 C 1355.
1647 C-------------------------------------------------------------------- 1356.
1648 C ABSORPTION (TAU) INTERPOLATION FOR GAS AMOUNTS IN ULGAS(N,K) 1357.
1649 C-------------------------------------------------------------------- 1358.
1650 C 1359.
1651 IPX=2 1360.
1652 DO 100 IP=1,NL 1361.
1653 C 1362.
1654 20 WPB = (PL(IP)-PX(IPX))/(PX(IPX-1)-PX(IPX)) 1363.
1655 IF(WPB.GE.0. .OR. IPX.GE.NPX) GO TO 30 1364.
1656 IPX = IPX+1 1365.
1657 GO TO 20 1366.
1658 C 1367.
1659 30 WTB = (TLM(IP)-TLOX)/DTX 1368.
1660 ITX = MIN0(MAX0(INT(WTB),0),NTX-2) 1369.
1661 WTB = WTB-FLOAT(ITX) 1370.
1662 C 1371.
1663 WBB = WPB*WTB 1372.
1664 WBA = WPB-WBB 1373.
1665 WAB = WTB-WBB 1374.
1666 WAA = 1.-(WBB+WBA+WAB) 1375.
1667 C 1376.
1668 IAA = NGUX*(ITX+NTX*(IPX-1)) 1377.
1669 IBA = IAA-NGUX*NTX 1378.
1670 C 1379.
1671 DO 90 IGAS=1,11 1380.
1672 IF(MLGAS(IGAS).LT.1) GO TO 90 1381.
1673 C 1382.
1674 UGAS = ULGAS(IP,IGASX(IGAS)) 1383.
1675 IF(UGAS.LT.1.E-10) GO TO 90 1384.
1676 C 1385.
1677 IU = IPX + NPUX*(IGAS-1) 1386.
1678 NU = NUX(IGAS) 1387.
1679 IF(NU.GT.1) GO TO 40 1388.
1680 XUA = 0. 1389.
1681 XUB = 0. 1390.
1682 GO TO 50 1391.
1683 40 XUA = (UGAS-ULOX(IU))/DUX(IU) 1392.
1684 XUB = (UGAS-ULOX(IU-1))/DUX(IU-1) 1393.
1685 50 IUA = INT(XUA) 1394.
1686 IUB = INT(XUB) 1395.
1687 C 1396.
1688 QAA = 1. 1397.
1689 QAB = 1. 1398.
1690 IF(XUA.GT.0. .AND. IUA.LT.NU-1) GO TO 60 1399.
1691 c XUA = DMIN1(DMAX1(XUA,0.),FLOAT(NU-1)) 1400.
1692 XUA = DMIN1(DMAX1(XUA,0.),dble(NU-1)) 1400.
1693 IUA = MIN0(INT(XUA),NU-2) 1401.
1694 QAA = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA)) 1402.
1695 QAB = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA+1)) 1403.
1696 C 1404.
1697 60 QBA = 1. 1405.
1698 QBB = 1. 1406.
1699 IF(XUB.GT.0. .AND. IUB.LT.NU-1) GO TO 70 1407.
1700 c XUB = DMIN1(DMAX1(XUB,0.),FLOAT(NU-1)) 1408.
1701 XUB = DMIN1(DMAX1(XUB,0.),dble(NU-1)) 1408.
1702 IUB = MIN0(INT(XUB),NU-2) 1409.
1703 QBA = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB)) 1410.
1704 QBB = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB+1)) 1411.
1705 C 1412.
1706 70 UAB = XUA-FLOAT(IUA) 1413.
1707 UBB = XUB-FLOAT(IUB) 1414.
1708 UAA = 1.-UAB 1415.
1709 UBA = 1.-UBB 1416.
1710 C 1417.
1711 C 1418.
1712 WAAA = WAA*UAA*QAA 1419.
1713 WAAB = WAA*UAB*QAB 1420.
1714 WABA = WAB*UAA*QAA 1421.
1715 WABB = WAB*UAB*QAB 1422.
1716 WBAA = WBA*UBA*QBA 1423.
1717 WBAB = WBA*UBB*QBB 1424.
1718 WBBA = WBB*UBA*QBA 1425.
1719 WBBB = WBB*UBB*QBB 1426.
1720 C 1427.
1721 NG = NGX(KGX(IGAS)) 1428.
1722 IAAA = IAA+IGUX(IGAS) + NG*IUA 1429.
1723 IAAB = IAAA+NG 1430.
1724 IABA = IAAA+NGUX 1431.
1725 IABB = IABA+NG 1432.
1726 IBAA = IBA+IGUX(IGAS) + NG*IUB 1433.
1727 IBAB = IBAA+NG 1434.
1728 IBBA = IBAA+NGUX 1435.
1729 IBBB = IBBA+NG 1436.
1730 C 1437.
1731 C 1438.
1732 IPG = IP+NL*(IG1X(KGX(IGAS))-1) 1439.
1733 DO 80 IG=1,NG 1440.
1734 TAUN(IPG) = TAUN(IPG) 1441.
1735 * + WAAA*TAUTBL(IAAA+IG) 1442.
1736 * + WAAB*TAUTBL(IAAB+IG) 1443.
1737 * + WABA*TAUTBL(IABA+IG) 1444.
1738 * + WABB*TAUTBL(IABB+IG) 1445.
1739 * + WBAA*TAUTBL(IBAA+IG) 1446.
1740 * + WBAB*TAUTBL(IBAB+IG) 1447.
1741 * + WBBA*TAUTBL(IBBA+IG) 1448.
1742 * + WBBB*TAUTBL(IBBB+IG) 1449.
1743 80 IPG = IPG+NL 1450.
1744 90 CONTINUE 1451.
1745 100 CONTINUE 1452.
1746 C 1453.
1747 IF(MLGAS(12).LT.1) GO TO 110 1454.
1748 C------------------------------------------------------------------- 1455.
1749 C PICK UP CCL3F1 (F11) ABSORPTION 1456.
1750 C------------------------------------------------------------------- 1457.
1751 C 1458.
1752 DO 102 K=1,25 1459.
1753 XKPCMA=TRACEG(K,1) 1460.
1754 IF(XKPCMA.LT.1.E-10) GO TO 102 1461.
1755 DO 101 N=1,NL 1462.
1756 NK=N+(K-1)*NL 1463.
1757 101 TAUN(NK)=TAUN(NK)+ULGAS(N,8)*XKPCMA 1464.
1758 102 CONTINUE 1465.
1759 C 1466.
1760 110 IF(MLGAS(13).LT.1) GO TO 120 1467.
1761 C------------------------------------------------------------------- 1468.
1762 C PICK UP CCL2F2 (F12) ABSORPTION 1469.
1763 C------------------------------------------------------------------- 1470.
1764 C 1471.
1765 DO 112 K=1,25 1472.
1766 XKPCMA=TRACEG(K,2) 1473.
1767 IF(XKPCMA.LT.1.E-10) GO TO 112 1474.
1768 DO 111 N=1,NL 1475.
1769 NK=N+(K-1)*NL 1476.
1770 111 TAUN(NK)=TAUN(NK)+ULGAS(N,9)*XKPCMA 1477.
1771 112 CONTINUE 1478.
1772 C 1479.
1773 120 IF(MLGAS(14).LT.1) GO TO 130 1480.
1774 C------------------------------------------------------------------- 1481.
1775 C PICK UP WINDOW H2O GASEOUS ABSORPTION 1482.
1776 C------------------------------------------------------------------- 1483.
1777 C 1484.
1778 DO 121 N=1,NL 1485.
1779 TAUN(N) = TAUN(N) 1486.
1780 121 CONTINUE 1487.
1781 130 CONTINUE 1488.
1782 C------------------------------------------------------------------- 1489.
1783 C PICK UP H2O CONTINUUM ABSORPTION 1490.
1784 C------------------------------------------------------------------- 1491.
1785 C 1492.
1786 IF(MLGAS(15).LT.1) GO TO 140 1493.
1787 DO 131 N=1,NL 1494.
1788 TAUN(N) = TAUN(N) + 2.21866E-11* 1495.
1789 * PL(N)*ULGAS(N,1)*EXP(1800./TLM(N))* 1496.
1790 * (ULGAS(N,1)/DPL(N)+.808563) 1497.
1791 131 CONTINUE 1498.
1792 C 1499.
1793 C$ ********************************REMOVE FOLLOWING STATEMENT TO CORRECT1500.
1794 IF(NL.GT.0) RETURN 1501.
1795 DO 133 N=1,NL 1502.
1796 PH2O=12.38E-4*ULGAS(N,1)*PL(N)/DPL(N) 1503.
1797 TH2O=EXP(1800./TLM(N)-6.081081) 1504.
1798 COEC=PH2O*TH2O+.0015*(PL(N)-PH2O) 1505.
1799 DO 132 K=2,25 1506.
1800 COEF=H2OCON(K)*1.E-5 1507.
1801 NK=N+(K-1)*NL 1508.
1802 132 TAUN(NK)=TAUN(NK)+ULGAS(N,1)*COEC*COEF 1509.
1803 133 CONTINUE 1510.
1804 140 CONTINUE 1511.
1805 C 1512.
1806 RETURN 1513.
1807 END 1514.
1808 SUBROUTINE THERML 1515.
1809
1810 #include "B83XX.COM"
1811 #if ( defined CLM )
1812 #include "CLM.COM"
1813 #endif
1814
1815 DATA R6,R24/.1666667,4.166667E-02/ 1577.
1816 DATA A,B,C/0.3825,0.5742,0.0433/ 1578.
1817 C 1579.
1818 C-----------------------------------------------------------------------1580.
1819 C LAYER EDGE TEMPERATURE INTERPOLATION1581.
1820 C-----------------------------------------------------------------------1582.
1821 IF(TLGRAD.LT.0.) GO TO 103 1583.
1822 TA=TLM(1) 1584.
1823 TB=TLM(2) 1585.
1824 P1=PLB(1) 1586.
1825 P2=PLB(2) 1587.
1826 P3=PLB(3) 1588.
1827 DT1CPT=0.5*TA*(EXPBYK(PLB(1))-EXPBYK(PLB(2)))/EXPBYK(PL(1)) 1589.
1828 DTHALF=(TA-TB)*(P1-P2)/(P1-P3) 1590.
1829 IF(DTHALF.GT.DT1CPT) DTHALF=DT1CPT 1591.
1830 TLB(1)=TA+DTHALF*TLGRAD 1592.
1831 TLT(1)=TA-DTHALF*TLGRAD 1593.
1832 DO 101 L=3,NL 1594.
1833 TC=TLM(L) 1595.
1834 P4=PLB(L+1) 1596.
1835 DTHALF=0.5*((TA-TB)/(P1-P3)+(TB-TC)/(P2-P4))*(P2-P3)*TLGRAD 1597.
1836 TLB(L-1)=TB+DTHALF 1598.
1837 TLT(L-1)=TB-DTHALF 1599.
1838 TA=TB 1600.
1839 TB=TC 1601.
1840 P1=P2 1602.
1841 P2=P3 1603.
1842 101 P3=P4 1604.
1843 DTHALF=(TA-TB)*(P2-P3)/(P1-P3)*TLGRAD 1605.
1844 TLB(NL)=TC+DTHALF 1606.
1845 TLT(NL)=TC-DTHALF 1607.
1846 L=NLP 1608.
1847 DO 102 N=1,NL 1609.
1848 L=L-1 1610.
1849 IF(PLB(L).GT.PTLISO) GO TO 103 1611.
1850 TLT(L)=TLM(L) 1612.
1851 102 TLB(L)=TLM(L) 1613.
1852 103 CONTINUE 1614.
1853 C-----------------------------------------------------------------------1615.
1854 C WEIGHT ASSIGNMENTS FOR PLANCK FUNCTION INTERPOLATION1616.
1855 C-----------------------------------------------------------------------1617.
1856 DO 104 L=1,NL 1618.
1857 ITL=TLB(L) 1619.
1858 WTLB(L)=TLB(L)-ITL 1620.
1859 ITLB(L)=ITL-IT0 1621.
1860 ITL=TLT(L) 1622.
1861 WTLT(L)=TLT(L)-ITL 1623.
1862 104 ITLT(L)=ITL-IT0 1624.
1863 ITS=TSL 1625.
1864 WTS=TSL-ITS 1626.
1865 ITS=ITS-IT0 1627.
1866 C 1628.
1867 C ------------------------------------------------------------------1629.
1868 C WINDOW REGION FLUX COMPUTATION1630.
1869 C ------------------------------------------------------------------1631.
1870 C DOWNWARD FLUX1632.
1871 C ------------------------------------------------------------------1633.
1872 K=1 1634.
1873 BG=BGFEMT(K) 1635.
1874 c print *,'1635 K=',k,' PEARTH=',PEARTH
1875 c print *,'BG=',BG
1876 WTS1=1.-WTS 1636.
1877 TRSLTS=0. 1637.
1878 TRSLTG=0. 1638.
1879 TRSLWV=0. 1639.
1880 TRSLBS=0. 1640.
1881 DNA=0. 1641.
1882 DNB=0. 1642.
1883 DNC=0. 1643.
1884 NLK0=0 1644.
1885 NLK=NL 1645.
1886 TRDFLB(NLP)=0. 1646.
1887 100 TAUA=TAUN(NLK) 1647.
1888 IF(TAUA.GT.1.E-05) GO TO 120 1648.
1889 TRDFLB(NLK)=0. 1649.
1890 NLK=NLK-1 1650.
1891 IF(NLK.GT.NLK0) GO TO 100 1651.
1892 110 NLK=NLK+1 1652.
1893 TRUFLB(NLK)=BG 1653.
1894 IF(NLK.LT.NLP) GO TO 110 1654.
1895 TRUFG=BG 1655.
1896 TRDFG=0. 1656.
1897 TRUFGW=BG 1657.
1898 TRUFGW=0. 1658.
1899 TRUFTW=TRUFLB(NLP) 1659.
1900 GO TO 200 1660.
1901 120 N=NLK 1661.
1902 130 ITL=ITLT(N) 1662.
1903 BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1663.
1904 ITL=ITLB(N) 1664.
1905 BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1665.
1906 TAUA=TAUN(N) 1666.
1907 TAUB=TAUA+TAUA 1667.
1908 TAUC=10.*TAUA 1668.
1909 IF(TAUA.GT.1.E-01) GO TO 140 1669.
1910 IF(TAUA.LT.1.E-03) GO TO 135 1670.
1911 TAU2=TAUA*TAUA 1671.
1912 BDIF=BBOT-BTOP 1672.
1913 BBTA=BDIF/TAUA 1673.
1914 BBTB=BDIF/TAUB 1674.
1915 BBTC=BDIF/TAUC 1675.
1916 TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1676.
1917 GO TO 145 1677.
1918 135 BDIF=.5*(BTOP+BBOT) 1678.
1919 TRA(N)=1.-TAUA 1679.
1920 ENA(N)=BDIF*TAUA 1680.
1921 DNA=DNA*TRA(N)+ENA(N) 1681.
1922 TRB(N)=1.-TAUB 1682.
1923 ENB(N)=BDIF*TAUB 1683.
1924 DNB=DNB*TRB(N)+ENB(N) 1684.
1925 TRC(N)=1.-TAUC 1685.
1926 ENC(N)=BDIF*TAUC 1686.
1927 DNC=DNC*TRC(N)+ENC(N) 1687.
1928 GO TO 160 1688.
1929 140 BDIF=BBOT-BTOP 1689.
1930 BBTA=BDIF/TAUA 1690.
1931 BBTB=BDIF/TAUB 1691.
1932 BBTC=BDIF/TAUC 1692.
1933 IF(TAUA.GT.7.) GO TO 150 1693.
1934 TRAN=EXP(-TAUA) 1694.
1935 145 TRA(N)=TRAN 1695.
1936 ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1696.
1937 DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1697.
1938 TRBN=TRAN*TRAN 1698.
1939 TRB(N)=TRBN 1699.
1940 ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1700.
1941 DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1701.
1942 TRCN=(TRBN*TRBN*TRAN)**2 1702.
1943 TRC(N)=TRCN 1703.
1944 ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1704.
1945 DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1705.
1946 GO TO 160 1706.
1947 150 TRA(N)=0. 1707.
1948 TRB(N)=0. 1708.
1949 TRC(N)=0. 1709.
1950 ENA(N)=BTOP+BBTA 1710.
1951 ENB(N)=BTOP+BBTB 1711.
1952 ENC(N)=BTOP+BBTC 1712.
1953 DNA=BBOT-BBTA 1713.
1954 DNB=BBOT-BBTB 1714.
1955 DNC=BBOT-BBTC 1715.
1956 160 TRDFLB(N)=A*DNA+B*DNB+C*DNC 1716.
1957 N=N-1 1717.
1958 IF(N.GT.0) GO TO 130 1718.
1959 IF(LTOPCL.LT.1) GO TO 165 1719.
1960 ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1720.
1961 ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1721.
1962 ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1722.
1963 165 CONTINUE 1723.
1964 C ------------------------------------------------------------------1724.
1965 C SURFACE LAYER FLUX COMPUTATION1725.
1966 C ------------------------------------------------------------------1726.
1967 N=1 1727.
1968 TRDFG=TRDFLB(1) 1728.
1969 TAUA=TAUSL(1)+FTAUSL(1) 1729.
1970 IF(TAUA.GT.1.E-05) GO TO 170 1730.
1971 BG=BG+TRDFG*TRGALB(K) 1731.
1972 UNB=BG 1733.
1973 UNC=BG 1734.
1974 FUNABC=BG 1735.
1975 GO TO 180 1736.
1976 170 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1737.
1977 TA=EXP(-TAUA) 1738.
1978 TB=TA*TA 1739.
1979 TC=(TB*TB*TA)**2 1740.
1980 DNA=(DNA-BS)*TA+BS 1741.
1981 DNB=(DNB-BS)*TB+BS 1742.
1982 DNC=(DNC-BS)*TC+BS 1743.
1983 TRDFG=A*DNA+B*DNB+C*DNC 1744.
1984 BG=BG+TRDFG*TRGALB(K) 1745.
1985 UNA=(BG-BS)*TA+BS 1746.
1986 UNB=(BG-BS)*TB+BS 1747.
1987 UNC=(BG-BS)*TC+BS 1748.
1988 FUNABC=A*UNA+B*UNB+C*UNC 1749.
1989 BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1750.
1990 BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1751.
1991 SLABS=1.-A*TA-B*TB-C*TC 1752.
1992 TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1753.
1993 TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1754.
1994 TRSLBS=TRSLBS+BS*SLABS 1755.
1995 C ------------------------------------------------------------------1756.
1996 C UPWARD FLUX COMPUTATION1757.
1997 C ------------------------------------------------------------------1758.
1998 180 TRUFLB(N)=FUNABC 1759.
1999 IF(N.GT.NLK) GO TO 190 1760.
2000 UNA=UNA*TRA(N)+ENA(N) 1761.
2001 UNB=UNB*TRB(N)+ENB(N) 1762.
2002 UNC=UNC*TRC(N)+ENC(N) 1763.
2003 FUNABC=A*UNA+B*UNB+C*UNC 1764.
2004 190 N=N+1 1765.
2005 IF(N.LT.NLP) GO TO 180 1766.
2006 TRUFLB(N)=FUNABC 1767.
2007 TRUFTW=FUNABC 1768.
2008 TRDFGW=TRDFG 1769.
2009 TRUFGW=BG 1770.
2010 TRUFG=BG 1771.
2011 DO 195 L=1,NLP 1772.
2012 DFLB(L,1)=TRDFLB(L) 1773.
2013 195 UFLB(L,1)=TRUFLB(L) 1774.
2014 DFSL(1)=TRDFLB(1) 1775.
2015 UFSL(1)=TRUFLB(1) 1776.
2016 DFLB(1,1)=TRDFGW 1777.
2017 UFLB(1,1)=TRUFGW 1778.
2018 c print *,' 1778 TRUFLB(1)=',TRUFLB(1)
2019 C ------------------------------------------------------------------1779.
2020 C END WINDOW REGION FLUX COMPUTATION; CONTINUE INTEGRATION1780.
2021 C ------------------------------------------------------------------1781.
2022 C ------------------------------------------------------------------1782.
2023 C DOWNWARD FLUX COMPUTATION 1783.
2024 C ------------------------------------------------------------------1784.
2025 200 ITK0=K*ITNEXT 1785.
2026 K=K+1 1786.
2027 IF(K.GT.NKTR) GO TO 300 1787.
2028 DFLB(NLP,K)=0. 1788.
2029 BG=BGFEMT(K) 1789.
2030 ITS=ITS+ITNEXT 1790.
2031 NLK0=NLK0+NL 1791.
2032 NLK=NLK0+NL 1792.
2033 NLL=NL 1793.
2034 210 TAUA=TAUN(NLK) 1794.
2035 IF(TAUA.GT.1.E-05) GO TO 220 1795.
2036 DFLB(NLL,K)=0. 1796.
2037 NLK=NLK-1 1797.
2038 NLL=NLL-1 1798.
2039 IF(NLL.GT.0) GO TO 210 1799.
2040 TRUFG=TRUFG+BG 1800.
2041 DO 215 N=1,NLP 1801.
2042 UFLB(N,K)=BG 1802.
2043 215 TRUFLB(N)=TRUFLB(N)+BG 1803.
2044 GO TO 200 1804.
2045 220 N=NLL 1805.
2046 DNA=0. 1806.
2047 DNB=0. 1807.
2048 DNC=0. 1808.
2049 230 ITL=ITLT(N)+ITK0 1809.
2050 BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1810.
2051 ITL=ITLB(N)+ITK0 1811.
2052 BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1812.
2053 TAUA=TAUN(NLK) 1813.
2054 TAUB=TAUA+TAUA 1814.
2055 TAUC=10.*TAUA 1815.
2056 IF(TAUA.GT.1.E-01) GO TO 240 1816.
2057 IF(TAUA.LT.1.E-03) GO TO 235 1817.
2058 TAU2=TAUA*TAUA 1818.
2059 BDIF=BBOT-BTOP 1819.
2060 BBTA=BDIF/TAUA 1820.
2061 BBTB=BDIF/TAUB 1821.
2062 BBTC=BDIF/TAUC 1822.
2063 TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1823.
2064 GO TO 245 1824.
2065 235 BDIF=.5*(BTOP+BBOT) 1825.
2066 TRA(N)=1.-TAUA 1826.
2067 ENA(N)=BDIF*TAUA 1827.
2068 DNA=DNA*TRA(N)+ENA(N) 1828.
2069 TRB(N)=1.-TAUB 1829.
2070 ENB(N)=BDIF*TAUB 1830.
2071 DNB=DNB*TRB(N)+ENB(N) 1831.
2072 TRC(N)=1.-TAUC 1832.
2073 ENC(N)=BDIF*TAUC 1833.
2074 DNC=DNC*TRC(N)+ENC(N) 1834.
2075 GO TO 260 1835.
2076 240 BDIF=BBOT-BTOP 1836.
2077 BBTA=BDIF/TAUA 1837.
2078 BBTB=BDIF/TAUB 1838.
2079 BBTC=BDIF/TAUC 1839.
2080 IF(TAUA.GT.7.) GO TO 250 1840.
2081 TRAN=EXP(-TAUA) 1841.
2082 245 TRA(N)=TRAN 1842.
2083 ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1843.
2084 DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1844.
2085 TRBN=TRAN*TRAN 1845.
2086 TRB(N)=TRBN 1846.
2087 ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1847.
2088 DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1848.
2089 TRCN=(TRBN*TRBN*TRAN)**2 1849.
2090 TRC(N)=TRCN 1850.
2091 ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1851.
2092 DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1852.
2093 GO TO 260 1853.
2094 250 TRA(N)=0. 1854.
2095 TRB(N)=0. 1855.
2096 TRC(N)=0. 1856.
2097 ENA(N)=BTOP+BBTA 1857.
2098 ENB(N)=BTOP+BBTB 1858.
2099 ENC(N)=BTOP+BBTC 1859.
2100 DNA=BBOT-BBTA 1860.
2101 DNB=BBOT-BBTB 1861.
2102 DNC=BBOT-BBTC 1862.
2103 260 FDNABC=A*DNA+B*DNB+C*DNC 1863.
2104 TRDFLB(N)=TRDFLB(N)+FDNABC 1864.
2105 DFLB(N,K)=FDNABC 1865.
2106 N=N-1 1866.
2107 NLK=NLK-1 1867.
2108 IF(N.GT.0) GO TO 230 1868.
2109 DFSL(K)=FDNABC 1869.
2110 IF(LTOPCL.LT.1) GO TO 265 1870.
2111 ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1871.
2112 ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1872.
2113 ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1873.
2114 265 CONTINUE 1874.
2115 C ------------------------------------------------------------------1875.
2116 C SURFACE LAYER FLUX COMPUTATION1876.
2117 C ------------------------------------------------------------------1877.
2118 N=1 1878.
2119 TAUA=TAUSL(K)+FTAUSL(K) 1879.
2120 IF(TAUA.GT.1.E-05) GO TO 270 1880.
2121 BG=BG+FDNABC*TRGALB(K) 1881.
2122 UNA=BG 1882.
2123 UNB=BG 1883.
2124 UNC=BG 1884.
2125 FUNABC=BG 1885.
2126 GO TO 280 1886.
2127 270 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1887.
2128 TA=EXP(-TAUA) 1888.
2129 TB=TA*TA 1889.
2130 TC=(TB*TB*TA)**2 1890.
2131 DNA=(DNA-BS)*TA+BS 1891.
2132 DNB=(DNB-BS)*TB+BS 1892.
2133 DNC=(DNC-BS)*TC+BS 1893.
2134 FDNABC=A*DNA+B*DNB+C*DNC 1894.
2135 BG=BGFEMT(K)+FDNABC*TRGALB(K) 1895.
2136 UNA=(BG-BS)*TA+BS 1896.
2137 UNB=(BG-BS)*TB+BS 1897.
2138 UNC=(BG-BS)*TC+BS 1898.
2139 FUNABC=A*UNA+B*UNB+C*UNC 1899.
2140 BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1900.
2141 BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1901.
2142 SLABS=1.-A*TA-B*TB-C*TC 1902.
2143 TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1903.
2144 TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1904.
2145 TRSLBS=TRSLBS+BS*SLABS 1905.
2146 C ------------------------------------------------------------------1906.
2147 C UPWARD FLUX COMPUTATION1907.
2148 C ------------------------------------------------------------------1908.
2149 280 TRUFLB(N)=TRUFLB(N)+FUNABC 1909.
2150 UFLB(N,K)=FUNABC 1910.
2151 IF(N.GT.NLL) GO TO 290 1911.
2152 UNA=UNA*TRA(N)+ENA(N) 1912.
2153 UNB=UNB*TRB(N)+ENB(N) 1913.
2154 UNC=UNC*TRC(N)+ENC(N) 1914.
2155 FUNABC=A*UNA+B*UNB+C*UNC 1915.
2156 290 N=N+1 1916.
2157 IF(N.LT.NLP) GO TO 280 1917.
2158 TRUFLB(NLP)=TRUFLB(NLP)+FUNABC 1918.
2159 UFLB(NLP,K)=FUNABC 1919.
2160 UFSL(K)=UFLB(1,K) 1920.
2161 TRDFG=TRDFG+FDNABC 1921.
2162 DFLB(1,K)=FDNABC 1922.
2163 TRUFG=TRUFG+BG 1923.
2164 UFLB(1,K)=BG 1924.
2165 IF(K.EQ.11) TRSLWV=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1925.
2166 GO TO 200 1926.
2167 300 CONTINUE 1927.
2168 c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2169 c print * ,'1927 JLAT=',JLAT,PEARTH,PLICE
2170 c print *,' TRUFLB(1)=',TRUFLB(1),' TRUFG=',TRUFG
2171 c endif
2172
2173 #if ( defined CLM)
2174 c if(ncallclm.ge.1)then
2175 c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2176 c TRUFG=-lwuclm(ILON,JLAT)
2177 c print *,' CLM TRUFG=',TRUFG
2178 c endif
2179 c endif
2180 #endif
2181 C ------------------------------------------------------------------1928.
2182 C END FLUX COMPUTATION1929.
2183 C ------------------------------------------------------------------1930.
2184 TRSLCR=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1931.
2185 TRDFSL=TRDFLB(1) 1932.
2186 TRDFLB(1)=TRDFG 1933.
2187 TRUFSL=TRUFLB(1) 1934.
2188 TRUFLB(1)=TRUFG 1935.
2189 DO 310 L=1,NLP 1936.
2190 310 TRNFLB(L)=TRUFLB(L)-TRDFLB(L) 1937.
2191 DO 320 L=1,NL 1938.
2192 320 TRFCRL(L)=TRNFLB(L+1)-TRNFLB(L) 1939.
2193 PFW=10.*TRUFTW 1940.
2194 IPF=PFW 1941.
2195 IF(IPF.LT.10) GO TO 330 1942.
2196 DPF=PFW-IPF 1943.
2197 IPF=IPF+180 1944.
2198 GO TO 350 1945.
2199 330 PFW=10.*PFW 1946.
2200 IPF=PFW 1947.
2201 IF(IPF.LT.10) GO TO 340 1948.
2202 DPF=PFW-IPF 1949.
2203 IPF=IPF+90 1950.
2204 GO TO 350 1951.
2205 340 PFW=10.*PFW 1952.
2206 IPF=PFW 1953.
2207 IF(IPF.LT.1) IPF=1 1954.
2208 350 BTEMPW=TKPFW(IPF)+DPF*(TKPFW(IPF+1)-TKPFW(IPF)) 1955.
2209 RETURN 1956.
2210 END 1957.
2211 SUBROUTINE SOLAR 1958.
2212 C-----------------------------------------------------------------------1959.
2213 C SOLAR RETURNS 1960.
2214 C-----------------------------------------------------------------------1961.
2215 C SRDFLB SOLAR DOWNWARD FLUX AT LAYER BOTTOM 1962.
2216 C SRUFLB SOLAR UPWARD FLUX AT LAYER BOTTOM EDGE 1963.
2217 C SRNFLB SOLAR NET (DOWNWARD) FLUX (WATTS/M**2) 1964.
2218 C SRFHRL SOLAR HEATING RATE : FLUX (WATTS/M**2) 1965.
2219 C SRRVIS VISALB OF ATMOSPHERE (AS IF RSURFX=0.) 1966.
2220 C SRTATM ATMOS. TRANSMISSIVITY (TOTAL SPECTRUM) 1967.
2221 C PLAVIS PLANETARY ALBEDO 0.2-0.7 MICRON REGION 1968.
2222 C ALBVIS ALBEDO AT GROUND 0.2-0.7 MICRON REGION 1969.
2223 C PLANIR PLANETARY ALBEDO WAV>0.7 MICRON REGION 1970.
2224 C ALBNIR ALBEDO AT GROUND WAV>0.7 MICRON REGION 1971.
2225 C-----------------------------------------------------------------------1972.
2226 C COMMENT 1973.
2227 C-----------------------------------------------------------------------1974.
2228 C SOLAR DATA IS RETURNED IN RADCOM LINES: N,O,P,Q1975.
2229 C NORMS0=1 FLUXES ARE NORMALIZED BY SOLAR CONSTANT1976.
2230 C VERTICAL FLUX DISTRIBUTIONS CONTAIN SOLAR ZENITH1977.
2231 C ANGLE (COSZ) DEPENDENCE 1978.
2232 C RETURNED SOLAR FLUX VALUES SHOULD BE MULTIPLIED 1979.
2233 C BY COSZ WHEN COMPUTING ATMOSPHERIC HEATING RATE 1980.
2234 C-----------------------------------------------------------------------1981.
2235
2236 #include "B83XX.COM"
2237
2238 DIMENSION PFR(52),PFRI(52), PI0C(14),DKS0(14) 2036.
2239 DATA PFR/ 2037.
2240 1.4144,.4917,.5265,.5530,.5757,.5966,.6159,.6345,.6522,.6689,.6849,2038.
2241 2.7003,.7152,.7293,.7428,.7557,.7680,.7796,.7905,.8008,.8105,.8198,2039.
2242 3.8286,.8368,.8444,.8515,.8581,.8642,.8699,.8750,.8798,.8843,.8886,2040.
2243 4.8928,.8968,.9005,.9040,.9072,.9101,.9129,.9153,.9174,.9193,.9212,2041.
2244 5.9227,.9242,.9254,.9266,.9275,.9284,.864245 ,.864245 / 2042.
2245 DATA PFRI/ 2043.
2246 1.4950,.5300,.5620,.5882,.6088,.6302,.6537,.6763,.6969,.7157,.7332,2044.
2247 2.7499,.7658,.7806,.7945,.8074,.8194,.8306,.8409,.8504,.8592,.8674,2045.
2248 3.8751,.8822,.8886,.8946,.9000,.9050,.9097,.9139,.9177,.9210,.9246,2046.
2249 4.9280,.9313,.9343,.9371,.9394,.9415,.9438,.9458,.9475,.9488,.9500,2047.
2250 5.9507,.9515,.9529,.9532,.9538,.9541,.876178 ,.876178 / 2048.
2251 DATA PI0C/.66,.91,.975,.99,.995,.999,.999,.999,.999,.999,.999, 2049.
2252 + .999,.9999,.99999/ 2050.
2253 DATA DKS0/.01,.03,.04,.04,.04,.002,.004,.013,.002,.003,.003, 2051.
2254 + .072,.20,.53/ 2052.
2255 DIMENSION DBLN(20), KSLAM(14), CPFFL(40) 2053.
2256 DATA DBLN/2.,4.,8.,16.,32.,64.,128.,256.,512.,1024.,2048.,4096., 2054.
2257 + 8192.,16384.,32768.,65536.,131072.,262144.,524288.,1048576./ 2055.
2258 DATA NKSLAM/14/, KSLAM/1,1,2,2,5,5,5,5,1,1,1,3,4,6/ 2056.
2259 DATA XCMNO2/5.465/ 2057.
2260 DATA XCMO3/.0399623/ 2058.
2261 DATA TOTRAY/0.000155/ 2059.
2262 C 2060.
2263 DIMENSION SRBALB(6),SRXALB(6) 2061.
2264 EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 2062.
2265 C 2063.
2266 EQUIVALENCE 2064.
2267 + (BXA(1),BOCVIS),(BXA(5),BEAVIS),(BXA( 9),BOIVIS),(BXA(13),BLIVIS)2065.
2268 +,(BXA(2),BOCNIR),(BXA(6),BEANIR),(BXA(10),BOINIR),(BXA(14),BLINIR)2066.
2269 +,(BXA(3),XOCVIS),(BXA(7),XEAVIS),(BXA(11),XOIVIS),(BXA(15),XLIVIS)2067.
2270 +,(BXA(4),XOCNIR),(BXA(8),XEANIR),(BXA(12),XOINIR),(BXA(16),XLINIR)2068.
2271 +, (BXA(17),EXPSNE),(BXA(18),EXPSNO),(BXA(19),EXPSNL)2069.
2272 +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 2070.
2273 +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 2071.
2274 C 2072.
2275 EQUIVALENCE (SRXATM(1),SRXVIS),(SRXATM(2),SRXNIR) 2073.
2276 EQUIVALENCE (SRXATM(3),XXAVIS),(SRXATM(4),XXANIR) 2074.
2277 C 2075.
2278 EQUIVALENCE (ISPARE(1),NEWASZ) 2075.5
2279 C 2076.
2280 C-----------------------------------------------------------------------2077.
2281 C SOLAR: NET FLUX AT GROUND FOR FRACTIONAL GRID SURFACE ALBEDOS 2078.
2282 C 2079.
2283 C PFNFG(DT,XA,RSA,RX,RB)=(DT*(1.-RB)-XA*(RX-RB)*(1.-RSA)) 2080.
2284 C + /(1.-RSA*RB) 2081.
2285 C-----------------------------------------------------------------------2082.
2286 C 2083.
2287 C 2084.
2288 C O3ABS(X)= 1.08173*X/(1.00+ 2085.
2289 C $ 138.57*X)**0.805 + 0.0658*X/(1.00+(103.63*X)**3) 2086.
2290 C 2087.
2291 S0COSZ=S0 2088.
2292 IF(NORMS0.EQ.0) S0COSZ=S0*COSZ 2089.
2293 C 2090.
2294 DO 10 N=1,NLP 2091.
2295 SRNFLB(N)=0. 2092.
2296 SRDFLB(N)=0. 2093.
2297 SRUFLB(N)=0. 2094.
2298 SRFHRL(N)=0. 2095.
2299 10 CONTINUE 2096.
2300 SRIVIS=0. 2097.
2301 SROVIS=0. 2098.
2302 SRINIR=0. 2099.
2303 SRONIR=0. 2100.
2304 SRDVIS=0. 2101.
2305 SRUVIS=0. 2102.
2306 SRDNIR=0. 2103.
2307 SRUNIR=0. 2104.
2308 SRTVIS=0. 2105.
2309 SRAVIS=0. 2106.
2310 SRTNIR=0. 2107.
2311 SRANIR=0. 2108.
2312 SRSLHR=0. 2109.
2313 PLAVIS=1. 2110.
2314 PLANIR=1. 2111.
2315 ALBVIS=1. 2112.
2316 ALBNIR=1. 2113.
2317 SRRVIS=1. 2114.
2318 SRRNIR=0. 2115.
2319 SRTNIR=0. 2116.
2320 SRXVIS=0. 2117.
2321 SRXNIR=0. 2118.
2322 C 2119.
2323 XXVIS=.53/(1.-SRBALB(6)) 2120.
2324 XXNIR=.47/(1.-SRBALB(5)) 2121.
2325 DO 20 N=1,4 2122.
2326 20 FSRNFG(N)=XXVIS*(1.-BXA(4*N-3))+XXNIR*(1.-BXA(4*N-2)) 2123.
2327 C 2124.
2328 IF(COSZ.LT.0.01) RETURN 2125.
2329 COSMAG=35.0/SQRT(1224.*COSZ*COSZ+1.0) 2126.
2330 TAURAY=TOTRAY*FRAYLE 2127.
2331 CPF=49.999/COSMAG 2128.
2332 IPF=CPF 2129.
2333 DPF=CPF-IPF 2130.
2334 IF(ISOSCT.EQ.1) IPF=51 2131.
2335 CPFF=(1.0-DPF)*PFR(IPF)+DPF*PFR(IPF+1) 2132.
2336 CPFFI=(1.0-DPF)*PFRI(IPF)+DPF*PFRI(IPF+1) 2133.
2337 SECZ=1./COSZ 2134.
2338 DO 100 N=1,NL 2135.
2339 CPFFL(N)=CPFF 2136.
2340 IF(TLM(N).LT.TKCICE) CPFFL(N)=CPFFI 2137.
2341 100 CONTINUE 2138.
2342 C 2139.
2343 K = 0 2140.
2344 300 K = K+1 2141.
2345 C 2142.
2346 KLAM=KSLAM(K) 2143.
2347 DKS0K=DKS0(K) 2144.
2348 DKS0X=DKS0K*S0COSZ 2145.
2349 RBNB=SRBALB(KLAM) 2146.
2350 RBNX=SRXALB(KLAM) 2147.
2351 RCNB=0.0 2148.
2352 RCNX=0.0 2149.
2353 C 2150.
2354 N = 0 2151.
2355 200 N = N+1 2152.
2356 C 2153.
2357 CPFF=CPFFL(N) 2154.
2358 SRB(N)=RBNB 2155.
2359 SRX(N)=RBNX 2156.
2360 TLN=TLM(N) 2157.
2361 PLN=PL(N) 2158.
2362 ULN=ULGAS(N,1) 2159.
2363 RTAU=1.E-06 2160.
2364 GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114),K 2161.
2365 101 CONTINUE 2162.
2366 C--------K=6-------H2O DS0=.01 2163.
2367 TERMA=(35.66+TLN*(.0416-.0004622*TLN+.001057*PLN))*(1.+.04286*PLN)2164.
2368 TERMB=(1.+.00171*ULN)*(1.+PLN*(189.088+.1316*PLN)) 2165.
2369 TAU1 =TERMA/TERMB 2166.
2370 IF(TAU1.GT.0.02343) TAU1=0.02343 2167.
2371 TAU=TAU1*ULN 2168.
2372 GO TO 120 2169.
2373 102 CONTINUE 2170.
2374 C--------K=5-------H2O DS0=.03 2171.
2375 TERMA=(2.792+TLN*(.0914-.0002848*TLN+.0003395*PLN)) 2172.
2376 + *(1.+.02964*PLN) 2173.
2377 TERMB=(1.0+.000657*ULN)*(1.+PLN*(240.70+.13847*PLN)) 2174.
2378 TAU1 =TERMA/TERMB 2175.
2379 IF(TAU1.GT.0.00520) TAU1=0.00520 2176.
2380 TAU=TAU1*ULN 2177.
2381 GO TO 120 2178.
2382 103 CONTINUE 2179.
2383 C--------K=4-------H2O DS0=.04 2180.
2384 TERMA=(.4768+.467E-04*PLN*TLN)*(1.+TLN*(.00191-.719E-05*TLN)) 2181.
2385 TERMB=(1.+.717E-04*ULN)*(1.+PLN*(130.56+.0876*PLN))/(1.+.0266*PLN)2182.
2386 TAU1 =TERMA/TERMB 2183.
2387 IF(TAU1.GT.0.00150) TAU1=0.0015 2184.
2388 TAU=TAU1*ULN 2185.
2389 GO TO 120 2186.
2390 104 CONTINUE 2187.
2391 C--------K=3-------H2O DS0=.04 2188.
2392 TERMA=(.000247*TLN-.091+PLN*(.00035+.78E-06*TLN))*(1.+.2847*PLN) 2189.
2393 TERMB=(1.+.2066E-04*ULN)*(1.+PLN*(137.17+.16132*PLN)) 2190.
2394 TAU =(TERMA/TERMB)*ULN 2191.
2395 GO TO 120 2192.
2396 105 CONTINUE 2193.
2397 C--------K=2-------H2O DS0=.04 2194.
2398 TERMA=(PLN*(1.974/TLN+.0001117*TLN)-10.713)*(1.+.005788*TLN) 2195.
2399 + *(1.+.001517*PLN) 2196.
2400 TERMB=(1.+.3218E-04*ULN)*(1.+PLN*(863.44+.2048*PLN)) 2197.
2401 TAU =(TERMA/TERMB)*ULN 2198.
2402 GO TO 120 2199.
2403 106 CONTINUE 2200.
2404 C--------K=4-------O2 DS0=.002 2201.
2405 ULN=ULGAS(N,4) 2202.
2406 TERMA=(.2236E-05-.1181E-09*TLN)*(1.+PLN*(.6364E-05*PLN+.001168)) 2203.
2407 TERMB=1.+.1521E-05*ULN 2204.
2408 TAU =(TERMA/TERMB)*ULN 2205.
2409 GO TO 120 2206.
2410 107 CONTINUE 2207.
2411 C--------K=3-------O2 DS0=.004 2208.
2412 ULN=ULGAS(N,4) 2209.
2413 TERMA=(.3179E-06-.9263E-11*TLN)*(1.+PLN*(.8832E-05*PLN+.0005292)) 2210.
2414 TERMB=1.+.1968E-06*ULN 2211.
2415 TAU =(TERMA/TERMB)*ULN 2212.
2416 GO TO 120 2213.
2417 108 CONTINUE 2214.
2418 C--------K=2-------O2 DS0=.013 2215.
2419 ULN=ULGAS(N,4) 2216.
2420 TERMA=(.2801E-07-.1638E-12*TLN)*(1.+PLN*(.1683E-04*PLN-.001721)) 2217.
2421 TERMB=1.+.8097E-07*ULN 2218.
2422 TAU =(TERMA/TERMB)*ULN 2219.
2423 GO TO 120 2220.
2424 109 CONTINUE 2221.
2425 C--------K=4-------CO2 DS0=.002 2222.
2426 ULN=ULGAS(N,2) 2223.
2427 TERMA=(50.73-.03155*TLN-PLN*(.5543+.00091*TLN))*(1.-.1004*PLN) 2224.
2428 TERMB=(1.+.006468*ULN)*(1.+PLN*(49.51+.8285*PLN)) 2225.
2429 TAU =(TERMA/TERMB)*ULN 2226.
2430 IF(PLN.LT.175.0) TAU=(.00018*PLN+0.00001)*ULN 2227.
2431 GO TO 120 2228.
2432 110 CONTINUE 2229.
2433 C--------K=3-------CO2 DS0=.003 2230.
2434 ULN=ULGAS(N,2) 2231.
2435 TERMA=(1.+.01319*TLN)*(PLN*(.008001*ULN+.4589E-03)-.8396*ULN) 2232.
2436 TERMB=ULN*(PLN+295.7+1.967*ULN)+.15126*PLN 2233.
2437 TAU =(TERMA/TERMB)*ULN 2234.
2438 GO TO 120 2235.
2439 111 CONTINUE 2236.
2440 C--------K=2-------CO2 DS0=.003 2237.
2441 ULN=ULGAS(N,2) 2238.
2442 TERMA=(1.+.02257*TLN)*(PLN*(.002295*ULN-.5489E-04)-.7571*ULN) 2239.
2443 TERMB=ULN*(PLN+803.9+2.477*ULN)-.09899*PLN 2240.
2444 TAU =(TERMA/TERMB)*ULN 2241.
2445 GO TO 120 2242.
2446 112 CONTINUE 2243.
2447 TAU=0.0 2244.
2448 GO TO 120 2245.
2449 113 CONTINUE 2246.
2450 TAU=0.0 2247.
2451 GO TO 120 2248.
2452 114 CONTINUE 2249.
2453 TAU=XCMNO2*ULGAS(N,5)+XCMO3*ULGAS(N,3) 2250.
2454 RTAU=TAURAY*(PLB(N)-PLB(N+1)) 2251.
2455 120 CONTINUE 2252.
2456 IF(TAU.LT.0.0) TAU=0.0 2253.
2457 CTAU=CLDTAU(N)*FCLDSR 2254.
2458 CPI0=PI0C(K) 2255.
2459 ATAU=EXTAER(N,KLAM) 2256.
2460 TAU=TAU+CTAU+ATAU+RTAU 2257.
2461 IF(TAU.LT.TAUMIN) GO TO 180 2258.
2462 CTAUSC=CPI0*CTAU 2259.
2463 ATAUSC=SCTAER(N,KLAM) 2260.
2464 TAUSCT=CTAUSC+ATAUSC+RTAU 2261.
2465 PIZERO=TAUSCT/TAU 2262.
2466 IF(PIZERO.GT.0.001) GO TO 130 2263.
2467 GO TO 180 2264.
2468 130 CONTINUE 2265.
2469 APFF=COSAER(N,KLAM) 2266.
2470 APFF0=APFF 2266.1
2471 IF(NEWASZ.GT.0) CALL HGAER1(COSZ,ATAUSC,APFF0,APFF) 2266.2
2472 PFF=(CPFF*CTAUSC+APFF*ATAUSC)/TAUSCT 2267.
2473 IF(ISOSCT.GT.1) GO TO 131 2268.
2474 GO TO 132 2269.
2475 131 TAU=TAU-TAUSCT*PFF 2270.
2476 PIZERO=PIZERO*(1.-PFF)/(1.-PIZERO*PFF) 2271.
2477 PFF=0. 2272.
2478 132 CONTINUE 2273.
2479 PR=1.0-PFF 2274.
2480 PT=1.0+PFF 2275.
2481 IF(TAU.LT.0.015625) GO TO 140 2276.
2482 C ALOG
2483 DBLS=7.001+1.44269*LOG(TAU) 2277.
2484 C ALOG
2485 NDBLS=DBLS 2278.
2486 TAU=TAU/DBLN(NDBLS) 2279.
2487 GO TO 150 2280.
2488 140 XANB=EXP(-TAU-TAU) 2281.
2489 XANX=EXP(-TAU*SECZ) 2282.
2490 TANB=PT*XANB 2283.
2491 XXT=(SECZ-2.0)*TAU 2284.
2492 TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2285.
2493 RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2286.
2494 XXT=(SECZ+2.0)*TAU 2287.
2495 RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2288.
2496 BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2289.
2497 XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2290.
2498 RASB=RASB*BNORM 2291.
2499 RASX=RASX*XNORM 2292.
2500 TANB=TANB*BNORM 2293.
2501 TANX=TANX*XNORM 2294.
2502 GO TO 170 2295.
2503 150 XANB=EXP(-TAU-TAU) 2296.
2504 XANX=EXP(-TAU*SECZ) 2297.
2505 TANB=PT*XANB 2298.
2506 XXT=(SECZ-2.0)*TAU 2299.
2507 TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2300.
2508 RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2301.
2509 XXT=(SECZ+2.0)*TAU 2302.
2510 RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2303.
2511 BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2304.
2512 XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2305.
2513 RASB=RASB*BNORM 2306.
2514 RASX=RASX*XNORM 2307.
2515 TANB=TANB*BNORM 2308.
2516 TANX=TANX*XNORM 2309.
2517 DO 160 NN=1,NDBLS 2310.
2518 RARB=RASB*RASB 2311.
2519 RARX=XANX*RASX 2312.
2520 XATB=XANB+TANB 2313.
2521 DENOM=1.0-RARB 2314.
2522 DB=(TANB+XANB*RARB)/DENOM 2315.
2523 DX=(TANX+RARX*RASB)/DENOM 2316.
2524 UB=RASB*(XANB+DB) 2317.
2525 UX=RARX+RASB*DX 2318.
2526 RASB=RASB+XATB*UB 2319.
2527 RASX=RASX+XATB*UX 2320.
2528 TANB=XANB*TANB+XATB*DB 2321.
2529 TANX=XANX*TANX+XATB*DX 2322.
2530 XANB=XANB*XANB 2323.
2531 XANX=XANX*XANX 2324.
2532 160 CONTINUE 2325.
2533 170 RARB=RASB*RBNB 2326.
2534 RARX=RASB*RBNX 2327.
2535 XATB=XANB+TANB 2328.
2536 DENOM=1.0-RARB 2329.
2537 DB=(TANB+XANB*RARB)/DENOM 2330.
2538 DX=(TANX+XANX*RARX)/DENOM 2331.
2539 UB=RBNB*(XANB+DB) 2332.
2540 UX=RBNX*XANX+RBNB*DX 2333.
2541 RBNB=RASB+XATB*UB 2334.
2542 RBNX=RASX+XATB*UX 2335.
2543 XATC=XATB/(1.0-RASB*RCNB) 2336.
2544 RCNX=RASX+(XANX*RCNX+TANX*RCNB)*XATC 2337.
2545 RCNB=RASB+RCNB*XATB*XATC 2338.
2546 GO TO 190 2339.
2547 180 RASB=0.0 2340.
2548 RASX=0.0 2341.
2549 TANB=0.0 2342.
2550 TANX=0.0 2343.
2551 XANB=EXP(-TAU-TAU) 2344.
2552 XANX=EXP(-TAU*SECZ) 2345.
2553 DX=0.0 2346.
2554 UX=RBNX*XANX 2347.
2555 RBNB=RBNB*XANB*XANB 2348.
2556 RBNX=UX*XANB 2349.
2557 RCNB=RCNB*XANB*XANB 2350.
2558 RCNX=RCNX*XANX*XANB 2351.
2559 190 RNB(N)=RASB 2352.
2560 RNX(N)=RASX 2353.
2561 TNB(N)=TANB 2354.
2562 TNX(N)=TANX 2355.
2563 XNB(N)=XANB 2356.
2564 XNX(N)=XANX 2357.
2565 IF(N.LT.NL) GO TO 200 2358.
2566 C 2359.
2567 IF(K.EQ.NKSLAM) GO TO 301 2360.
2568 SRDFLB(NLP)=SRDFLB(NLP)+DKS0X 2361.
2569 SRUFLB(NLP)=SRUFLB(NLP)+DKS0X*RBNX 2362.
2570 SRDFLB(NL)=SRDFLB(NL)+DKS0X*(XANX+DX) 2363.
2571 SRUFLB(NL)=SRUFLB(NL)+DKS0X*UX 2364.
2572 RMEAN=RBNX 2365.
2573 DO 230 M=2,NL 2366.
2574 N=NLP-M 2367.
2575 XBNB=XNB(N) 2368.
2576 XBNX=XNX(N) 2369.
2577 RBNX=RNX(N) 2370.
2578 IF(RBNX.GT.1.E-05) GO TO 210 2371.
2579 RASB=RASB*XBNB*XBNB 2372.
2580 TANX=TANX*XBNB 2373.
2581 GO TO 220 2374.
2582 210 RBNB=RNB(N) 2375.
2583 TBNB=TNB(N) 2376.
2584 TBNX=TNX(N) 2377.
2585 RARB=RASB*RBNB 2378.
2586 XBTB=XBNB+TBNB 2379.
2587 DENOM=1.0-RARB 2380.
2588 TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2381.
2589 RASB=RBNB+XBTB*XBTB*RASB/DENOM 2382.
2590 220 XANX=XANX*XBNX 2383.
2591 RBNB=SRB(N) 2384.
2592 RBNX=SRX(N) 2385.
2593 DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2386.
2594 UX=RBNX*XANX+RBNB*DX 2387.
2595 SRUFLB(N)=SRUFLB(N)+DKS0X*UX 2388.
2596 230 SRDFLB(N)=SRDFLB(N)+DKS0X*(XANX+DX) 2389.
2597 SRRNIR=SRRNIR+DKS0K*RCNX 2390.
2598 SRTNIR=SRTNIR+DKS0K*(TANX+XANX) 2391.
2599 SRXNIR=SRXNIR+DKS0K*XANX 2392.
2600 GO TO 300 2393.
2601 C 2394.
2602 301 CONTINUE 2395.
2603 SRTNIR=SRTNIR/0.459 2396.
2604 SRRNIR=SRRNIR/0.459 2397.
2605 SRXNIR=SRXNIR/0.459 2398.
2606 SRANIR=1.0-SRTNIR-SRRNIR 2399.
2607 C 2400.
2608 VRD(NLP)=DKS0X 2401.
2609 VRU(NLP)=DKS0X*RBNX 2402.
2610 O3PATH=(1.9+XANX*(COSMAG-1.9))*ULGAS(NL,3) 2403.
2611 ATOP=0. 2404.
2612 ABOT=O3ABS(O3PATH) 2405.
2613 ASUM=(ABOT-ATOP)*XANX 2406.
2614 O3A(NL)=ASUM*S0COSZ 2407.
2615 ATOP=ABOT 2408.
2616 VRD(NL)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2409.
2617 VRU(NL)=DKS0X*UX 2410.
2618 FAC(NL)=UX 2411.
2619 RMEAN=RBNX 2412.
2620 N=NL 2413.
2621 305 N=N-1 2414.
2622 XBNB=XNB(N) 2415.
2623 XBNX=XNX(N) 2416.
2624 RBNX=RNX(N) 2417.
2625 IF(RBNX.GT.1.E-05) GO TO 310 2418.
2626 RASB=RASB*XBNB*XBNB 2419.
2627 TANX=TANX*XBNB 2420.
2628 GO TO 320 2421.
2629 310 RBNB=RNB(N) 2422.
2630 TBNB=TNB(N) 2423.
2631 TBNX=TNX(N) 2424.
2632 RARB=RASB*RBNB 2425.
2633 XBTB=XBNB+TBNB 2426.
2634 DENOM=1.0-RARB 2427.
2635 TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2428.
2636 RASB=RBNB+XBTB*XBTB*RASB/DENOM 2429.
2637 320 XANX=XANX*XBNX 2430.
2638 RBNB=SRB(N) 2431.
2639 RBNX=SRX(N) 2432.
2640 DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2433.
2641 UX=RBNX*XANX+RBNB*DX 2434.
2642 FAC(N)=UX 2435.
2643 VRU(N)=DKS0X*UX 2436.
2644 O3PATH=O3PATH+(1.9+XANX*(COSMAG-1.9))*ULGAS(N,3) 2437.
2645 ABOT=O3ABS(O3PATH) 2438.
2646 ASUM=ASUM+(ABOT-ATOP)*XANX 2439.
2647 ATOP=ABOT 2440.
2648 VRD(N)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2441.
2649 O3A(N)=ASUM*S0COSZ 2442.
2650 IF(N.GT.1) GO TO 305 2443.
2651 C 2444.
2652 O3SUM=0. 2445.
2653 DO 324 I=1,NL 2446.
2654 324 O3SUM=O3SUM+ULGAS(I,3) 2447.
2655 SRXVIS=XANX*(1.-O3ABS(COSMAG*O3SUM)/0.53) 2448.
2656 SRTVIS=TANX+XANX-ASUM/DKS0K 2449.
2657 RGRND=UX/(XANX+DX+1.E-05) 2450.
2658 IF(RGRND.GT.1.0) RGRND=1.0 2451.
2659 ASUM=ASUM*RGRND 2452.
2660 VRU(N)=VRU(N)-ASUM*S0COSZ 2453.
2661 325 CONTINUE 2454.
2662 O3PATH=O3PATH+1.9*ULGAS(N,3) 2455.
2663 ATOP=O3ABS(O3PATH) 2456.
2664 ASUM=ASUM+(ATOP-ABOT)*FAC(N) 2457.
2665 ABOT=ATOP 2458.
2666 N=N+1 2459.
2667 VRU(N)=VRU(N)-ASUM*S0COSZ 2460.
2668 IF(N.LT.NLP) GO TO 325 2461.
2669 SRRVIS=RCNX-ASUM/DKS0K 2462.
2670 SRAVIS=1.0-SRRVIS-SRTVIS 2463.
2671 TFU=VRU(NLP) 2464.
2672 BFU=VRU(1) 2465.
2673 IF(BFU.GE.0.) GO TO 327 2466.
2674 DO 326 N=1,NLP 2467.
2675 326 VRU(N)=(VRU(N)-BFU)*(TFU/(TFU-BFU)) 2468.
2676 BFU=VRU(1) 2469.
2677 327 BFD=VRD(1) 2470.
2678 IF(BFD.GT.BFU) GO TO 329 2471.
2679 TFD=VRD(NLP) 2472.
2680 BFUD=BFU/TFD 2473.
2681 TFDD=TFD/(TFD-BFD) 2474.
2682 DO 328 N=1,NLP 2475.
2683 328 VRD(N)=(VRD(N)*(1.-BFUD)-BFD+BFUD*TFD)*TFDD 2476.
2684 329 SRDVIS=VRD(1) 2477.
2685 SRUVIS=VRU(1) 2478.
2686 ALBVIS=SRUVIS/(SRDVIS+1.E-10) 2479.
2687 TAU1=0. 2480.
2688 SRIVIS=VRD(NLP) 2481.
2689 SROVIS=VRU(NLP) 2482.
2690 PLAVIS=SROVIS/SRIVIS 2483.
2691 C 2484.
2692 TAU2=0. 2485.
2693 TAU3=0. 2486.
2694 TRN1=0. 2487.
2695 TRN2=0. 2488.
2696 TRN3=0. 2489.
2697 N=NLP 2490.
2698 C 2491.
2699 C THE FOLLOWING IS CONSIDERED PART OF THE NEAR-IR SPECTRUM 2492.
2700 C -------------------------------------------------------- 2493.
2701 DO 330 M=1,NL 2494.
2702 N=N-1 2495.
2703 PLN=PL(N) 2496.
2704 ULN=ULGAS(N,2)*SECZ 2497.
2705 ULX=ULN 2498.
2706 IF(ULN.GT.7.0) ULN=7.0 2499.
2707 C--------K=5-------CO2 DS0=.002 2500.
2708 TERMA=.003488*PLN*(1.+39.59*EXP(-8.769*ULN/(1.+4.419*ULN))) 2501.
2709 + *(1.+ULN*(.001938*PLN-.00503*ULN)) 2502.
2710 TERMB=(1.+.04712*PLN*(1.+.4877*ULN)) 2503.
2711 TAU=TERMA/TERMB 2504.
2712 IF(TAU.LT.1.E-06) TAU=1.E-06 2505.
2713 TAU1=TAU1+TAU*ULX 2506.
2714 ULN=ULGAS(N,1)*SECZ 2507.
2715 C--------K=7-------H2O DS0=.01(DS0=.008 + DS0=.002 CO2 OVERLAP) 2508.
2716 TERMA=.001582*PLN*(1.+6.769*EXP(-9.59*ULN/(1.+5.026*ULN))) 2509.
2717 + *(1.+ULN*(.2757E-03*PLN+.001429*ULN)) 2510.
2718 TERMB=(1.+.003683*PLN*(1.+1.187*ULN)) 2511.
2719 TAU2=TAU2+(TERMA/TERMB)*ULN 2512.
2720 ULN=ULGAS(N,4)*SECZ 2513.
2721 C--------K=5-------O2 DS0=.001 2514.
2722 TERMA=(.1366E-03-.2203E-07*TLN)*(1.+PLN*(.1497E-06*ULN+.001261)) 2515.
2723 TERMB=(1.+.3867E-03*ULN)/(1.+.2075E-04*ULN) 2516.
2724 TAU3=TAU3+(TERMA/TERMB)*ULN 2517.
2725 IF(TAU1.LT.10.0) TRN1=EXP(-TAU1) 2518.
2726 IF(TAU2.LT.10.0) TRN2=EXP(-TAU2) 2519.
2727 IF(TAU3.LT.10.0) TRN3=EXP(-TAU3) 2520.
2728 FAC(N)=.004358*TRN1+.01743*TRN2+.00218*TRN3 2521.
2729 330 SRDFLB(N)=SRDFLB(N)+SRDFLB(N)*FAC(N) 2522.
2730 FAC(NLP)=.023968 2523.
2731 SRDFLB(NLP)=SRDFLB(NLP)+SRDFLB(NLP)*FAC(NLP) 2524.
2732 DO 340 N=1,NLP 2525.
2733 340 SRUFLB(N)=SRUFLB(N)+SRUFLB(N)*FAC(1) 2526.
2734 SRINIR=SRDFLB(NLP) 2527.
2735 SRONIR=SRUFLB(NLP) 2528.
2736 PLANIR=SRONIR/SRINIR 2529.
2737 SRDNIR=SRDFLB(1) 2530.
2738 SRUNIR=SRUFLB(1) 2531.
2739 ALBNIR=SRUNIR/(SRDNIR+1.E-10) 2532.
2740 DO 350 N=1,NLP 2533.
2741 SRDFLB(N)=SRDFLB(N)+VRD(N) 2534.
2742 SRUFLB(N)=SRUFLB(N)+VRU(N) 2535.
2743 350 SRNFLB(N)=SRDFLB(N)-SRUFLB(N) 2536.
2744 DO 360 N=1,NL 2537.
2745 360 SRFHRL(N)=SRNFLB(N+1)-SRNFLB(N) 2538.
2746 SRSLHR=FRACSL*SRFHRL(1) 2539.
2747 C 2540.
2748 C--------------------------------- 2541.
2749 CALL O2HEAT(FAC,COSZ,S0COSZ) 2542.
2750 C--------------------------------- 2543.
2751 C 2544.
2752 DO 500 L=1,NL 2545.
2753 500 SRFHRL(L)=SRFHRL(L)+FAC(L) 2546.
2754 L=NLP 2547.
2755 DO 510 N=1,NL 2548.
2756 L=L-1 2549.
2757 IF(PLB(L).GT.0.09) GO TO 520 2550.
2758 510 SRFHRL(L)=FAC(L)+O3A(L) 2551.
2759 520 CONTINUE 2552.
2760 C I=NLP+1-II 2553.
2761 C 2554.
2762 C-----------------------------------------------------------------------2555.
2763 C SOLAR NET FLUX (SRNFLB(1)) DISTRIBUTION ACCORDING TO SURFACE TYPE 2556.
2764 CR NOT USED AND NOT SAFE (CAUSES DIVIDE CHECKS) 2556.1
2765 C-----------------------------------------------------------------------2557.
2766 CR FSRVIS=0.53 2558.
2767 CR FSRNIR=0.47 2559.
2768 C 2560.
2769 CR RASVIS=0. 2561.
2770 CR IF(SRUVIS.GT.1.E-03) RASVIS=(SRDVIS-SRTVIS*SRIVIS)/SRUVIS 2562.
2771 CR XXAVIS=0. 2563.
2772 CR DENOM=SRIVIS*(SRXALB(6)-SRBALB(6)) 2564.
2773 CR IF(ABS(DENOM).GT.1.E-03) XXAVIS=(SRUVIS-SRDVIS*SRBALB(6))/DENOM 2565.
2774 C$ PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.
2775 CR IF(SRIVIS.GT.1.E-03) PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.11
2776 CR RASNIR=0. 2567.
2777 CR IF(PNFVIS.LT.1.E-03) RETURN 2568.
2778 CR IF(SRUNIR.GT.1.E-03) RASNIR=(SRDNIR-SRTNIR*SRINIR)/SRUNIR 2569.
2779 CR XXANIR=0. 2570.
2780 CR DENOM=SRINIR*(SRXALB(5)-SRBALB(5)) 2571.
2781 CR IF(ABS(DENOM).GT.1.E-03) XXANIR=(SRUNIR-SRDNIR*SRBALB(5))/DENOM 2572.
2782 C$ PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.
2783 CR IF(SRINIR.GT.1.E-03) PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.11
2784 CR IF(PNFNIR.LT.1.E-03) RETURN 2574.
2785 C 2575.
2786 CR FNSROC=0. 2576.
2787 CR IF(POCEAN.LT.1.E-04) GO TO 601 2577.
2788 CR POCVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOCVIS,BOCVIS) 2578.
2789 CR POCNIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOCVIS,BOCVIS) 2579.
2790 CR FNSROC=(FSRVIS*POCVIS/PNFVIS+FSRNIR*POCNIR/PNFNIR) 2580.
2791 C 2581.
2792 CR601 FNSREA=0. 2582.
2793 CR IF(PEARTH.LT.1.E-04) GO TO 602 2583.
2794 CR PEAVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XEAVIS,BEAVIS) 2584.
2795 CR PEANIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XEANIR,BEANIR) 2585.
2796 CR FNSREA=(FSRVIS*PEAVIS/PNFVIS+FSRNIR*PEANIR/PNFNIR) 2586.
2797 C 2587.
2798 CR602 FNSROI=0. 2588.
2799 CR IF(POICE .LT.1.E-04) GO TO 603 2589.
2800 CR POIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOIVIS,BOIVIS) 2590.
2801 CR POINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOINIR,BOINIR) 2591.
2802 CR FNSROI=(FSRVIS*POIVIS/PNFVIS+FSRNIR*POINIR/PNFNIR) 2592.
2803 C 2593.
2804 CR603 FNSRLI=0. 2594.
2805 CR IF(PLICE .LT.1.E-04) GO TO 604 2595.
2806 CR PLIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XLIVIS,BLIVIS) 2596.
2807 CR PLINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XLINIR,BLINIR) 2597.
2808 CR FNSRLI=(FSRVIS*PLIVIS/PNFVIS+FSRNIR*PLINIR/PNFNIR) 2598.
2809 C 2599.
2810 CR604 FNORM=FNSROC*POCEAN+FNSREA*PEARTH+FNSROI*POICE+FNSRLI*PLICE 2600.
2811 C 2601.
2812 CR FSRNFG(1)=FNSROC/FNORM 2602.
2813 CR FSRNFG(2)=FNSREA/FNORM 2603.
2814 CR FSRNFG(3)=FNSROI/FNORM 2604.
2815 CR FSRNFG(4)=FNSRLI/FNORM 2605.
2816 C 2606.
2817 RETURN 2607.
2818 END 2608.
2819 SUBROUTINE SETAO2(O2CMA,NL) 2609.
2820 DIMENSION O2CMA(40),O2FHRL(40) 2610.
2821 DIMENSION SFWM2(18),SIGMA(18,6) 2611.
2822 DATA SFWM2/ 2612.
2823 A 2.196E-03, 0.817E-03, 1.163E-03, 1.331E-03, 1.735E-03, 1.310E-03,2613.
2824 B 1.311E-03, 2.584E-03, 2.864E-03, 4.162E-03, 5.044E-03, 6.922E-03,2614.
2825 C 6.906E-03,10.454E-03, 5.710E-03, 6.910E-03,14.130E-03,18.080E-03/2615.
2826 DATA SIGMA/ 2616.
2827 A 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2617.
2828 B 4.33E-21, 4.89E-21, 6.63E-21, 1.60E-20, 7.20E-20, 1.59E-18, 2618.
2829 C 2.10E-21, 2.32E-21, 3.02E-21, 6.30E-21, 3.46E-20, 7.52E-19, 2619.
2830 D 5.95E-22, 9.72E-22, 2.53E-21, 7.57E-21, 7.38E-20, 7.44E-19, 2620.
2831 E 3.33E-22, 1.02E-22, 4.09E-21, 1.63E-20, 8.79E-20, 3.81E-19, 2621.
2832 F 1.09E-21, 1.16E-21, 1.45E-21, 3.32E-21, 2.00E-20, 4.04E-19, 2622.
2833 G 1.15E-21, 1.30E-21, 1.90E-21, 4.89E-21, 2.62E-20, 4.08E-19, 2623.
2834 H 3.90E-22, 4.90E-22, 9.49E-22, 3.33E-21, 2.14E-20, 2.39E-19, 2624.
2835 I 1.29E-22, 2.18E-22, 8.28E-22, 3.46E-21, 1.94E-20, 1.06E-19, 2625.
2836 J 6.26E-23, 7.80E-23, 2.62E-22, 1.83E-21, 1.25E-20, 3.95E-20, 2626.
2837 K 2.74E-23, 3.58E-23, 8.64E-23, 4.03E-22, 2.13E-21, 1.95E-20, 2627.
2838 L 1.95E-23, 2.44E-23, 4.89E-23, 2.87E-22, 1.95E-21, 1.36E-20, 2628.
2839 M 1.84E-23, 1.96E-23, 2.71E-23, 8.52E-23, 6.48E-22, 3.89E-21, 2629.
2840 N 1.80E-23, 1.81E-23, 1.87E-23, 2.69E-23, 1.34E-22, 1.52E-21, 2630.
2841 O 1.80E-23, 1.80E-23, 1.82E-23, 2.40E-23, 5.71E-23, 5.70E-22, 2631.
2842 P 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 3.50E-23, 2632.
2843 Q 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 2.68E-23, 2633.
2844 R 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23/ 2634.
2845 REAL WTKO2(6)/0.05,0.20,0.25,0.25,0.20,0.05/ 2635.
2846 C 2636.
2847 DATA STPMOL/2.68714E+19/,S00/1367.0/ 2637.
2848 DATA NW/18/,NZ/11/,NKO2/6/ 2638.
2849 DIMENSION ZTABLE(40,11) 2639.
2850 DIMENSION ZCOSJ(11) 2640.
2851 NLP=NL+1 2641.
2852 FSUM=0.0 2642.
2853 DO 100 I=1,NW 2643.
2854 100 FSUM=FSUM+SFWM2(I) 2644.
2855 DO 110 J=1,NZ 2645.
2856 110 ZTABLE(NLP,J)=FSUM 2646.
2857 SUMMOL=0.0 2647.
2858 DO 150 N=1,NL 2648.
2859 L=NLP-N 2649.
2860 SUMMOL=SUMMOL+O2CMA(L)*STPMOL 2650.
2861 DO 140 J=1,NZ 2651.
2862 ZCOS=0.01*(1/J)+0.1*(J-1) 2652.
2863 ZCOSJ(J)=ZCOS 2653.
2864 FSUM=0.0 2654.
2865 DO 130 I=1,NW 2655.
2866 WSUM=0.0 2656.
2867 DO 120 K=1,NKO2 2657.
2868 TAU=SIGMA(I,K)*SUMMOL/ZCOS 2658.
2869 IF(TAU.GT.30.0) TAU=30.0 2659.
2870 120 WSUM=WSUM+WTKO2(K)*EXP(-TAU) 2660.
2871 130 FSUM=FSUM+WSUM*SFWM2(I) 2661.
2872 140 ZTABLE(L,J)=FSUM 2662.
2873 150 CONTINUE 2663.
2874 DO 170 J=1,NZ 2664.
2875 DO 160 L=1,NL 2665.
2876 160 ZTABLE(L,J)=ZTABLE(L+1,J)-ZTABLE(L,J) 2666.
2877 170 CONTINUE 2667.
2878 RETURN 2668.
2879 C 2669.
2880 C--------------------------------- 2670.
2881 ENTRY O2HEAT(O2FHRL,COSZ,S0) 2671.
2882 C--------------------------------- 2672.
2883 C 2673.
2884 ZCOS=1.0+10.0*COSZ 2674.
2885 JI=ZCOS 2675.
2886 IF(JI.GT.10) JI=10 2676.
2887 JJ=JI+1 2677.
2888 WTJ=ZCOS-JI 2678.
2889 WTI=1.0-WTJ 2679.
2890 DO 200 L=1,NLP-1 2680.
2891 200 O2FHRL(L)=(WTI*ZTABLE(L,JI)+WTJ*ZTABLE(L,JJ))*S0/S00 2681.
2892 RETURN 2682.
2893 END 2683.
2894 FUNCTION O3ABS(OCM) 2684.
2895 c DOUBLE PRECISION O3UVAB 2684.1
2896 DIMENSION AO3(460) 2685.
2897 C 2686.
2898 IP=0 2687.
2899 XX=OCM*1.E+04 2688.
2900 IX=XX 2689.
2901 IF(IX.GT.99) GO TO 110 2690.
2902 IF(IX.LT.1 ) GO TO 130 2691.
2903 GO TO 120 2692.
2904 110 IP=IP+90 2693.
2905 XX=XX*0.1 2694.
2906 IX=XX 2695.
2907 IF(IX.GT.99) GO TO 110 2696.
2908 120 DX=XX-IX 2697.
2909 IX=IX+IP 2698.
2910 O3ABS=AO3(IX)+DX*(AO3(IX+1)-AO3(IX)) 2699.
2911 RETURN 2700.
2912 130 O3ABS=XX*AO3(1) 2701.
2913 RETURN 2702.
2914 C 2703.
2915 C---------------------- 2704.
2916 ENTRY SETAO3(OCM) 2705.
2917 C---------------------- 2706.
2918 C 2707.
2919 ! print *,'After 2707'
2920 DO 140 I=1,460 2708.
2921 II=(I-10)/90-4 2709.
2922 XX=I-((I-10)/90)*90 2710.
2923 ! print *,i,ii,xx
2924 ! OCM=XX*10.**II 2711.
2925 ! 05/14/2006
2926 OCM=XX*10.**float(II)
2927 ! print *,ocm
2928 ! 05/14/2006
2929 140 AO3(I)=O3UVAB(OCM) 2712.
2930 ! print *,'After 2712'
2931 O3ABS=1. 2713.
2932 RETURN 2714.
2933 END 2715.
2934 FUNCTION O3UVAB(OCM) 2716.
2935 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 2717.
2936 c REAL OCM 2718.
2937 C-----------------------------------------------------------------------2719.
2938 C**** OZONE ABSORPTION COEFFICIENT DATA FROM HANDBOOK OF GEOPHYSICS 19612720.
2939 C**** T = -44 DEG CENTR. 2721.
2940 C-----------------------------------------------------------------------2722.
2941 DIMENSION X(226),F(226) 2723.
2942 DIMENSION OWMUV2(115),OWMUV3(111),OKEUV2(115),OKEUV3(111) 2724.
2943 EQUIVALENCE (X(1),OWMUV2(1)),(X(116),OWMUV3(1)), 2725.
2944 *(F(1),OKEUV2(1)),(F(116),OKEUV3(1)) 2726.
2945 DATA OWMUV2/.2002,.2012,.2022,.2032,.2042,.2052,.2062,.2072,.2082,2727.
2946 $.2092,.2102,.2112,.2122,.2132,.2142,.2152,.2162,.2172,.2182,.2192,2728.
2947 $.2202,.2212,.2222,.2232,.2242,.2252,.2262,.2272,.2282,.2292,.2302,2729.
2948 $.2312,.2322,.2332,.2342,.2352,.2362,.2372,.2382,.2392,.2400,.2402,2730.
2949 $.2412,.2422,.2432,.2438,.2444,.2452,.2458,.2463,.2472,.2478,.2482,2731.
2950 $.2490,.2492,.2500,.2508,.2519,.2527,.2539,.2543,.2553,.2562,.2566,2732.
2951 $.2571,.2575,.2579,.2587,.2597,.2604,.2617,.2624,.2635,.2643,.2650,2733.
2952 $.2654,.2662,.2669,.2675,.2682,.2692,.2695,.2702,.2712,.2718,.2722,2734.
2953 $.2732,.2742,.2746,.2752,.2762,.2772,.2782,.2792,.2802,.2812,.2822,2735.
2954 $.2830,.2842,.2852,.2862,.2872,.2882,.2892,.2902,.2912,.2922,.2932,2736.
2955 $.2942,.2952,.2962,.2972,.2982,.2992,.2998/ 2737.
2956 DATA OWMUV3/.3004,.3016,.3021,.3029,.3036,.3037,.3051,.3053,.3059,2738.
2957 $.3061,.3066,.3075,.3077,.3083,.3085,.3092,.3098,.3100,.3104,.3106,2739.
2958 $.3109,.3112,.3130,.3135,.3146,.3148,.3151,.3154,.3167,.3170,.3173,2740.
2959 $.3176,.3190,.3194,.3199,.3200,.3209,.3210,.3216,.3220,.3223,.3226,2741.
2960 $.3239,.3242,.3245,.3248,.3253,.3255,.3269,.3272,.3275,.3279,.3292,2742.
2961 $.3295,.3299,.3303,.3309,.3312,.3328,.3332,.3334,.3338,.3357,.3365,2743.
2962 $.3369,.3372,.3391,.3395,.3398,.3401,.3417,.3421,.3426,.3430,.3437,2744.
2963 $.3439,.3451,.3455,.3460,.3463,.3466,.3472,.3481,.3485,.3489,.3493,2745.
2964 $.3499,.3501,.3506,.3514,.3521,.3523,.3546,.3550,.3554,.3556,.3561,2746.
2965 $.3567,.3572,.3573,.3588,.3594,.3599,.3600,.3604,.3606,.3639,.3647,2747.
2966 $.3650,.3654,.3660/ 2748.
2967 DATA OKEUV2/ 8.3, 8.3, 8.1, 8.3, 8.6, 9.0, 9.7, 10.8, 11.7,2749.
2968 $ 13.0, 14.3, 16.0, 18.0, 20.6, 23.0, 26.1, 29.3, 32.6, 36.9, 40.8,2750.
2969 $ 46.9, 51.4, 56.7, 63.4, 69.1, 76.6, 84.0, 91.4, 99.9,110.0,118.0,2751.
2970 $126.0,136.0,145.0,154.0,164.0,175.0,186.0,192.0,201.0,210.0,212.0,2752.
2971 $221.0,230.0,239.0,248.0,250.0,259.0,264.0,264.0,273.0,277.0,275.0,2753.
2972 $283.0,283.0,290.0,283.0,297.0,290.0,300.0,290.0,302.0,295.0,283.0,2754.
2973 $293.0,290.0,286.0,297.0,281.0,280.0,271.0,275.0,254.0,264.0,250.0,2755.
2974 $248.0,242.0,228.0,230.0,216.0,213.0,211.0,199.0,188.0,188.0,178.0,2756.
2975 $169.0,153.0,155.0,148.0,136.0,127.0,117.0,108.0, 97.0, 88.7, 81.3,2757.
2976 $ 78.7, 67.9, 61.4, 54.3, 49.6, 43.1, 38.9, 34.6, 30.2, 27.5, 23.9,2758.
2977 $ 21.0, 18.6, 16.2, 14.2, 12.3, 10.7, 9.5/ 2759.
2978 DATA OKEUV3/8.880,7.520,6.960,6.160,5.810,5.910,4.310,4.430,4.130,2760.
2979 $4.310,4.020,3.330,3.390,3.060,3.100,2.830,2.400,2.490,2.330,2.320,2761.
2980 $2.120,2.200,1.436,1.595,1.074,1.138,1.068,1.262,0.818,0.948,0.860,2762.
2981 $1.001,0.543,0.763,0.665,0.781,0.382,0.406,0.373,0.608,0.484,0.601,2763.
2982 $0.209,0.276,0.259,0.470,0.319,0.354,0.131,0.223,0.185,0.339,0.080,2764.
2983 $0.093,0.079,0.184,0.139,0.214,0.053,0.074,0.068,0.152,0.038,0.070,2765.
2984 $.0540000,.1030000,.0240000,.0382500,.0292500,.0550000,.0135000, 2766.
2985 $.0155250,.0127500,.0188250,.0167250,.0262500,.0115500,.0140250, 2767.
2986 $.0099750,.0115500,.0081000,.0104250,.0050100,.0057000,.0046650, 2768.
2987 $.0073425,.0051825,.0055275,.0040575,.0077700,.0048900,.0054600, 2769.
2988 $.0015375,.0017775,.0013275,.0014100,.0011550,.0023325,.0018825, 2770.
2989 $.0019650,.0009600,.0013650,.0011925,.0013200,.0008925,.0009825, 2771.
2990 $.0001350,.0006300,.0004500,.0006225,0.0/ 2772.
2991 C 2773.
2992 C THEKAERAKA SOLAR FLUX 2774.
2993 C 2775.
2994 DIMENSION Y(190),H(190) 2776.
2995 DATA H/.007,.900,.007,.007,.030,.070,.230,.630,1.25,2.71,10.7,2777.
2996 1 22.9,57.5,64.9,66.7,59.3,63.0,72.3,70.4,104.,130.,185.,232.,204.,2778.
2997 2 222.,315.,482.,584.,514.,603.,689.,764.,830.,975.,1059.,1081.,2779.
2998 31074.,1069.,1093.,1083.,1068.,1132.,1181.,1157.,1120.,1098.,1098.,2780.
2999 41189.,1429.,1644.,1751.,1774.,1747.,1693.,1639.,1663.,1810.,1922.,2781.
3000 52006.,2057.,2066.,2048.,2033.,2044.,2074.,1976.,1950.,1960.,1942.,2782.
3001 61920.,1882.,1833.,1833.,1852.,1842.,1818.,1783.,1754.,1725.,1720.,2783.
3002 71695.,1705.,1712.,1719.,1715.,1712.,1700.,1682.,1666.,1647.,1635.,2784.
3003 81602.,1570.,1544.,1511.,1486.,1456.,1427.,1402.,1389.,1344.,1314.,2785.
3004 91290.,1260.,1235.,1211.,1185.,1159.,1134.,1109.,1085.,1060.,1036.,2786.
3005 A1013.,990.,968.,947.,926.,908.,891.,880.,869.,858.,847.,837.,820.,2787.
3006 B 803.,785.,767.,748.,668.,593.,535.,485.,438.,397.,358.,337.,312.,2788.
3007 C 288.,267.,245.,223.,202.,180.,159.,142.,126.,114.,103., 90., 79.,2789.
3008 D 69.0,62.0,55.0,48.0,43.0,39.0,35.0,31.0,26.0,22.6,19.2,16.6,14.6,2790.
3009 E 13.5,12.3,11.1,10.3, 9.5,8.70,7.80,7.10,6.50,5.92,5.35,4.86,4.47,2791.
3010 F 4.11,3.79,1.82,0.99,.585,.367,.241,.165,.117,.0851,.0634,.0481/2792.
3011 DATA Y/.115,.120,.125,.130,.140,.150,.160,.170,.180,.190,.200,2793.
3012 1 .210,.220,.225,.230,.235,.240,.245,.250,.255,.260,.265,.270,.275,2794.
3013 2 .280,.285,.290,.295,.300,.305,.310,.315,.320,.325,.330,.335,2795.
3014 3 .340,.345,.350,.355,.360,.365,.370,.375,.380,.385,.390,2796.
3015 4 .395,.400,.405,.410,.415,.420,.425,.430,.435,.440,.445,2797.
3016 5 .450,.455,.460,.465,.470,.475,.480,.485,.490,.495,.500,2798.
3017 6 .505,.510,.515,.520,.525,.530,.535,.540,.545,.550,.555,2799.
3018 7 .560,.565,.570,.575,.580,.585,.590,.595,.600,.605,.610,2800.
3019 8 .620,.630,.640,.650,.660,.670,.680,.690,.700,.710,.720,2801.
3020 9 .730,.740,.750,.760,.770,.780,.790,.800,.810,.820,.830,2802.
3021 A .840,.850,.860,.870,.880,.890,.900,.910,.920,.930,.940,.950,.960,2803.
3022 B 0.97,0.98,0.99,1.00,1.05,1.10,1.15,1.20,1.25,1.30,1.35,1.40,1.45,2804.
3023 C 1.50,1.55,1.60,1.65,1.70,1.75,1.80,1.85,1.90,1.95,2.00,2.10,2.20,2805.
3024 D 2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.10,3.20,3.30,3.40,3.50,2806.
3025 E 3.60,3.70,3.80,3.90,4.00,4.10,4.20,4.30,4.40,4.50,4.60,4.70,4.80,2807.
3026 F 4.9, 5.0, 6.0, 7.0, 8.0, 9.0,10.0,11.0,12.0,13.0,14.0,15.00/2808.
3027 NH=190 2809.
3028 NG=226 2810.
3029 XA=X(1) 2811.
3030 XB=X(NG) 2812.
3031 SOLCON=0.1353D0 2813.
3032 ABINT=0.D0 2814.
3033 X2=DMIN1(X(NG),Y(NH)) 2815.
3034 IF(XA.GE.X2) GO TO 160 2816.
3035 X1=DMAX1(X(1),Y(1)) 2817.
3036 IF(XB.LE.X1) GO TO 160 2818.
3037 YA=XA 2819.
3038 IF(XA.LT.X1) YA=X1 2820.
3039 YB=XB 2821.
3040 IF(YB.GT.X2) YB=X2 2822.
3041 DO 100 JG=2,NG 2823.
3042 XJ=X(JG) 2824.
3043 IF(XJ.GT.YA) GO TO 110 2825.
3044 100 CONTINUE 2825.1
3045 JG=NG+1 2825.2
3046 110 IG=JG-1 2826.
3047 XI=X(IG) 2827.
3048 TAU=F(IG)*OCM 2828.
3049 IF(TAU.GT.35.D0) TAU=35.D0 2829.
3050 GI=1.D0-DEXP(-TAU) 2830.
3051 TAU=F(JG)*OCM 2831.
3052 IF(TAU.GT.35.D0) TAU=35.D0 2832.
3053 GJ=1.D0-DEXP(-TAU) 2833.
3054 B=(GJ-GI)/(XJ-XI) 2834.
3055 A=GJ-B*XJ 2835.
3056 DO 120 JH=2,NH 2836.
3057 YJ=Y(JH) 2837.
3058 IF(YJ.GT.YA) GO TO 130 2838.
3059 120 CONTINUE 2838.1
3060 JH=NH+1 2838.2
3061 130 IH=JH-1 2839.
3062 YI=Y(IH) 2840.
3063 HI=H(IH)/10000.D0 2841.
3064 HJ=H(JH)/10000.D0 2842.
3065 D=(HJ-HI)/(YJ-YI) 2843.
3066 C=HJ-D*YJ 2844.
3067 X2=YA 2845.
3068 140 X1=X2 2846.
3069 X2=DMIN1(XJ,YJ) 2847.
3070 DELTA=(XJ-YJ)/(XJ+YJ) 2848.
3071 IF(X2.GT.YB) X2=YB 2849.
3072 DINT=(X2-X1)*(A*C+0.5D0*(B*C+A*D)*(X2+X1)+B*D*(X2*(X2+X1)+X1*X1)/ 2850.
3073 $3.D0) 2851.
3074 ABINT=ABINT+DINT 2852.
3075 IF(X2.GE.YB) GO TO 160 2853.
3076 IF(DELTA.GT.1.D-14) GO TO 150 2854.
3077 XI=XJ 2855.
3078 GI=GJ 2856.
3079 JG=JG+1 2857.
3080 XJ=X(JG) 2858.
3081 TAU=F(JG)*OCM 2859.
3082 IF(TAU.GT.35.D0) TAU=35.D0 2860.
3083 GJ=1.D0-DEXP(-TAU) 2861.
3084 B=(GJ-GI)/(XJ-XI) 2862.
3085 A=GJ-B*XJ 2863.
3086 IF(DABS(DELTA).LE.1.D-14) GO TO 150 2864.
3087 GO TO 140 2865.
3088 150 YI=YJ 2866.
3089 HI=HJ 2867.
3090 JH=JH+1 2868.
3091 YJ=Y(JH) 2869.
3092 HJ=H(JH)/10000.D0 2870.
3093 D=(HJ-HI)/(YJ-YI) 2871.
3094 C=HJ-D*YJ 2872.
3095 GO TO 140 2873.
3096 160 O3UVAB=ABINT/SOLCON 2874.
3097 RETURN 2875.
3098 END 2876.
3099 SUBROUTINE SETO3D 2877.
3100
3101 #include "B83XX.COM"
3102
3103 C-----------------------------------------------------------------------2915.
3104 C 2916.
3105 C LONDON ET AL (1976) JUL,1957-DEC,1970 NCAR ATLAS OF TOTAL OZONE2917.
3106 C 2918.
3107 C AVERAGE GLOBAL COLUMN AMOUNT -- O3AVE(MONTH,LATITUDE,LONGITUDE)2919.
3108 C 2920.
3109 C MONTH=1-12 JAN,FEB,...,DEC 2921.
3110 C LAT =1-18 -85,-75,..., 85 2922.
3111 C 2923.
3112 C-----------------------------------------------------------------------2924.
3113 REAL O3AVEA(216),O3AVEB(216),O3AVEC(216),O3AVED(216),O3AVEE(216) 2925.
3114 REAL O3AVEF(216),O3AVEG(216),O3AVEH(216),O3AVEI(216),O3AVEJ(216) 2926.
3115 REAL O3AVEK(216),O3AVEL(216),O3AVEM(216),O3AVEN(216),O3AVEO(216) 2927.
3116 REAL O3AVEP(216),O3AVEQ(216),O3AVER(216),O3AVE(12,18,18) 2928.
3117 EQUIVALENCE (O3AVE(1,1,10),O3AVEA(1)),(O3AVE(1,1,11),O3AVEB(1)) 2929.
3118 1 ,(O3AVE(1,1,12),O3AVEC(1)),(O3AVE(1,1,13),O3AVED(1)) 2930.
3119 2 ,(O3AVE(1,1,14),O3AVEE(1)),(O3AVE(1,1,15),O3AVEF(1)) 2931.
3120 3 ,(O3AVE(1,1,16),O3AVEG(1)),(O3AVE(1,1,17),O3AVEH(1)) 2932.
3121 4 ,(O3AVE(1,1,18),O3AVEI(1)),(O3AVE(1,1,01),O3AVEJ(1)) 2933.
3122 5 ,(O3AVE(1,1,02),O3AVEK(1)),(O3AVE(1,1,03),O3AVEL(1)) 2934.
3123 6 ,(O3AVE(1,1,04),O3AVEM(1)),(O3AVE(1,1,05),O3AVEN(1)) 2935.
3124 7 ,(O3AVE(1,1,06),O3AVEO(1)),(O3AVE(1,1,07),O3AVEP(1)) 2936.
3125 8 ,(O3AVE(1,1,08),O3AVEQ(1)),(O3AVE(1,1,09),O3AVER(1)) 2937.
3126 DATA O3AVEA/ 2938.
3127 A .317,.295,.291,.292,.293,.298,.300,.305,.313,.324,.369,.355, 2939.
3128 B .319,.300,.296,.292,.291,.300,.301,.304,.314,.322,.358,.350, 2940.
3129 C .312,.301,.295,.287,.286,.298,.302,.305,.316,.322,.343,.335, 2941.
3130 D .299,.291,.285,.280,.279,.290,.295,.300,.307,.319,.327,.316, 2942.
3131 E .281,.275,.279,.268,.266,.278,.282,.290,.295,.306,.306,.296, 2943.
3132 F .266,.261,.259,.256,.252,.261,.267,.277,.280,.289,.285,.277, 2944.
3133 G .252,.249,.248,.246,.240,.249,.252,.262,.264,.273,.265,.258, 2945.
3134 H .240,.238,.240,.242,.237,.242,.240,.249,.252,.258,.251,.245, 2946.
3135 I .232,.230,.238,.241,.240,.238,.234,.241,.241,.245,.239,.236, 2947.
3136 J .235,.235,.244,.252,.253,.244,.236,.237,.232,.230,.230,.232, 2948.
3137 K .249,.256,.264,.269,.267,.261,.245,.245,.238,.234,.233,.237, 2949.
3138 L .278,.289,.294,.300,.294,.284,.265,.265,.256,.249,.248,.261, 2950.
3139 M .318,.338,.343,.351,.342,.324,.300,.296,.287,.275,.279,.299, 2951.
3140 N .347,.368,.383,.383,.370,.351,.335,.319,.304,.288,.296,.321, 2952.
3141 O .364,.394,.418,.410,.402,.371,.358,.340,.312,.298,.302,.325, 2953.
3142 P .356,.388,.421,.414,.394,.360,.337,.319,.299,.285,.292,.313, 2954.
3143 Q .364,.403,.431,.426,.398,.358,.328,.303,.292,.287,.297,.324, 2955.
3144 R .373,.421,.447,.440,.408,.355,.323,.295,.289,.291,.305,.329/ 2956.
3145 DATA O3AVEB/ 2957.
3146 A .318,.295,.291,.293,.293,.299,.301,.305,.314,.326,.372,.358, 2958.
3147 B .321,.300,.295,.293,.291,.301,.301,.306,.314,.326,.361,.353, 2959.
3148 C .315,.302,.296,.291,.288,.300,.303,.306,.318,.328,.348,.340, 2960.
3149 D .307,.296,.291,.284,.278,.298,.299,.305,.314,.326,.335,.324, 2961.
3150 E .294,.285,.286,.272,.270,.286,.288,.296,.302,.315,.315,.304, 2962.
3151 F .278,.271,.265,.260,.258,.270,.273,.283,.287,.298,.293,.284, 2963.
3152 G .262,.259,.254,.250,.247,.255,.259,.268,.270,.282,.274,.266, 2964.
3153 H .247,.246,.244,.245,.239,.245,.247,.255,.255,.266,.257,.250, 2965.
3154 I .235,.235,.239,.244,.240,.238,.236,.244,.244,.249,.244,.239, 2966.
3155 J .233,.234,.243,.251,.249,.240,.234,.235,.232,.231,.231,.231, 2967.
3156 K .247,.254,.263,.267,.262,.253,.242,.240,.237,.232,.232,.237, 2968.
3157 L .279,.287,.296,.282,.286,.275,.260,.257,.253,.246,.246,.258, 2969.
3158 M .320,.336,.345,.348,.325,.309,.293,.282,.279,.267,.272,.294, 2970.
3159 N .346,.369,.379,.377,.348,.330,.317,.299,.286,.280,.288,.312, 2971.
3160 O .368,.406,.412,.401,.373,.345,.332,.312,.293,.284,.293,.316, 2972.
3161 P .366,.409,.423,.418,.386,.349,.326,.307,.290,.278,.295,.312, 2973.
3162 Q .366,.407,.428,.429,.396,.352,.323,.296,.287,.282,.298,.318, 2974.
3163 R .372,.420,.446,.441,.407,.352,.320,.292,.286,.290,.305,.327/ 2975.
3164 DATA O3AVEC/ 2976.
3165 A .319,.296,.292,.294,.294,.299,.302,.306,.316,.328,.372,.359, 2977.
3166 B .321,.300,.295,.297,.293,.303,.305,.309,.319,.332,.367,.359, 2978.
3167 C .322,.309,.302,.297,.293,.309,.309,.314,.326,.338,.362,.353, 2979.
3168 D .324,.313,.303,.294,.295,.314,.311,.318,.330,.342,.353,.343, 2980.
3169 E .315,.308,.296,.286,.287,.305,.306,.314,.326,.335,.338,.326, 2981.
3170 F .294,.290,.281,.271,.273,.287,.290,.299,.307,.319,.312,.303, 2982.
3171 G .274,.272,.264,.258,.258,.268,.272,.281,.286,.297,.290,.281, 2983.
3172 H .254,.254,.251,.248,.248,.254,.257,.263,.267,.276,.271,.262, 2984.
3173 I .240,.239,.241,.245,.241,.243,.244,.250,.251,.256,.250,.246, 2985.
3174 J .230,.231,.238,.249,.246,.237,.234,.233,.234,.233,.230,.228, 2986.
3175 K .238,.244,.251,.258,.253,.244,.236,.235,.233,.228,.228,.230, 2987.
3176 L .259,.269,.276,.279,.268,.254,.246,.241,.238,.235,.237,.246, 2988.
3177 M .289,.305,.312,.306,.289,.270,.261,.255,.249,.246,.252,.268, 2989.
3178 N .321,.347,.354,.343,.315,.291,.281,.273,.262,.259,.268,.285, 2990.
3179 O .351,.394,.396,.384,.353,.315,.300,.288,.275,.271,.282,.296, 2991.
3180 P .363,.414,.422,.415,.382,.333,.313,.292,.281,.276,.292,.306, 2992.
3181 Q .366,.415,.430,.433,.398,.346,.313,.288,.282,.280,.299,.317, 2993.
3182 R .372,.421,.445,.441,.406,.348,.316,.289,.285,.289,.306,.327/ 2994.
3183 DATA O3AVED/ 2995.
3184 A .320,.296,.293,.294,.295,.300,.303,.308,.317,.330,.374,.361, 2996.
3185 B .322,.300,.297,.299,.296,.307,.310,.314,.323,.339,.373,.366, 2997.
3186 C .329,.313,.310,.304,.302,.320,.318,.326,.338,.352,.373,.367, 2998.
3187 D .343,.330,.318,.306,.315,.333,.329,.337,.354,.366,.370,.366, 2999.
3188 E .334,.324,.311,.299,.312,.326,.329,.333,.352,.357,.354,.342, 3000.
3189 F .304,.300,.291,.279,.285,.302,.308,.315,.324,.328,.325,.312, 3001.
3190 G .277,.276,.268,.262,.266,.279,.283,.289,.296,.303,.299,.283, 3002.
3191 H .256,.257,.253,.249,.252,.259,.266,.269,.274,.278,.273,.263, 3003.
3192 I .242,.243,.243,.248,.247,.251,.255,.256,.258,.260,.253,.249, 3004.
3193 J .231,.234,.238,.250,.255,.251,.250,.246,.248,.244,.237,.229, 3005.
3194 K .235,.241,.248,.257,.259,.257,.248,.246,.245,.244,.233,.230, 3006.
3195 L .256,.261,.267,.270,.269,.262,.251,.247,.247,.248,.239,.248, 3007.
3196 M .293,.304,.306,.302,.288,.272,.259,.256,.256,.256,.254,.269, 3008.
3197 N .327,.344,.356,.346,.319,.291,.272,.270,.264,.267,.270,.285, 3009.
3198 O .356,.392,.402,.388,.359,.312,.289,.281,.276,.281,.285,.297, 3010.
3199 P .368,.416,.424,.415,.388,.328,.304,.285,.279,.284,.295,.309, 3011.
3200 Q .370,.418,.436,.436,.402,.338,.306,.283,.278,.284,.301,.320, 3012.
3201 R .373,.422,.446,.441,.407,.345,.312,.286,.275,.291,.307,.328/ 3013.
3202 DATA O3AVEE/ 3014.
3203 A .319,.295,.293,.295,.296,.300,.304,.309,.318,.332,.375,.362, 3015.
3204 B .325,.301,.300,.302,.300,.309,.313,.319,.328,.345,.378,.370, 3016.
3205 C .332,.314,.312,.310,.310,.327,.329,.335,.347,.362,.381,.375, 3017.
3206 D .348,.334,.324,.312,.328,.346,.366,.352,.372,.381,.377,.373, 3018.
3207 E .337,.327,.318,.303,.322,.335,.342,.347,.363,.366,.358,.344, 3019.
3208 F .301,.297,.292,.282,.291,.307,.314,.321,.331,.332,.324,.309, 3020.
3209 G .275,.271,.269,.264,.270,.279,.286,.292,.299,.301,.293,.281, 3021.
3210 H .255,.253,.252,.251,.253,.258,.265,.269,.275,.277,.268,.262, 3022.
3211 I .245,.244,.246,.250,.249,.253,.254,.257,.259,.260,.252,.249, 3023.
3212 J .240,.239,.245,.255,.256,.260,.256,.253,.253,.251,.243,.237, 3024.
3213 K .247,.248,.252,.263,.270,.268,.258,.256,.256,.252,.244,.238, 3025.
3214 L .263,.263,.268,.277,.282,.276,.261,.259,.259,.258,.251,.251, 3026.
3215 M .299,.304,.309,.309,.302,.291,.269,.266,.268,.269,.269,.275, 3027.
3216 N .346,.358,.365,.353,.335,.307,.276,.272,.276,.283,.289,.300, 3028.
3217 O .379,.400,.414,.401,.373,.319,.286,.280,.283,.293,.303,.314, 3029.
3218 P .382,.421,.437,.427,.398,.323,.293,.280,.280,.293,.308,.321, 3030.
3219 Q .375,.424,.444,.440,.405,.334,.298,.278,.276,.290,.306,.326, 3031.
3220 R .374,.424,.448,.443,.406,.345,.310,.284,.281,.292,.309,.328/ 3032.
3221 DATA O3AVEF/ 3033.
3222 A .318,.294,.294,.295,.298,.301,.304,.311,.320,.333,.377,.361, 3034.
3223 B .324,.298,.300,.304,.305,.310,.315,.323,.331,.348,.383,.371, 3035.
3224 C .337,.311,.314,.313,.317,.330,.333,.344,.354,.369,.386,.377, 3036.
3225 D .350,.330,.324,.317,.332,.349,.351,.362,.378,.390,.380,.372, 3037.
3226 E .333,.322,.314,.307,.323,.339,.345,.358,.369,.372,.357,.340, 3038.
3227 F .300,.292,.286,.284,.294,.307,.316,.327,.335,.334,.323,.307, 3039.
3228 G .275,.269,.264,.263,.269,.277,.285,.292,.300,.303,.290,.279, 3040.
3229 H .254,.251,.250,.251,.254,.256,.261,.267,.271,.276,.266,.261, 3041.
3230 I .243,.242,.242,.247,.248,.250,.247,.251,.252,.258,.253,.247, 3042.
3231 J .237,.239,.243,.253,.255,.255,.246,.243,.244,.245,.239,.236, 3043.
3232 K .246,.247,.253,.263,.265,.265,.253,.245,.247,.247,.239,.238, 3044.
3233 L .265,.265,.276,.283,.284,.280,.261,.254,.253,.258,.250,.250, 3045.
3234 M .306,.309,.321,.316,.318,.292,.273,.259,.265,.271,.273,.277, 3046.
3235 N .365,.369,.381,.363,.347,.313,.278,.264,.275,.290,.302,.307, 3047.
3236 O .396,.416,.431,.415,.405,.322,.282,.271,.288,.303,.321,.328, 3048.
3237 P .397,.433,.455,.436,.404,.322,.287,.273,.276,.302,.320,.333, 3049.
3238 Q .382,.429,.451,.442,.408,.331,.297,.274,.273,.295,.311,.333, 3050.
3239 R .375,.427,.450,.445,.407,.343,.309,.283,.280,.295,.311,.330/ 3051.
3240 DATA O3AVEG/ 3052.
3241 A .317,.293,.293,.295,.299,.299,.305,.311,.320,.335,.378,.360, 3053.
3242 B .323,.296,.300,.304,.306,.310,.317,.325,.334,.353,.385,.367, 3054.
3243 C .335,.307,.310,.312,.318,.328,.335,.347,.357,.376,.390,.372, 3055.
3244 D .346,.324,.320,.317,.332,.349,.354,.367,.384,.393,.384,.368, 3056.
3245 E .331,.318,.311,.305,.324,.339,.349,.365,.378,.377,.360,.339, 3057.
3246 F .301,.293,.286,.285,.296,.309,.321,.334,.344,.339,.325,.309, 3058.
3247 G .276,.270,.266,.267,.271,.280,.287,.295,.303,.308,.294,.282, 3059.
3248 H .257,.253,.250,.252,.254,.257,.261,.266,.271,.279,.268,.261, 3060.
3249 I .240,.241,.241,.246,.246,.250,.246,.249,.253,.259,.254,.248, 3061.
3250 J .234,.238,.245,.256,.258,.259,.244,.243,.241,.243,.237,.235, 3062.
3251 K .244,.249,.259,.271,.274,.274,.257,.251,.248,.248,.238,.237, 3063.
3252 L .270,.272,.289,.297,.298,.294,.277,.267,.260,.262,.251,.254, 3064.
3253 M .329,.338,.353,.338,.333,.313,.296,.275,.273,.282,.281,.296, 3065.
3254 N .401,.414,.424,.392,.369,.329,.298,.272,.282,.303,.321,.341, 3066.
3255 O .420,.451,.461,.432,.389,.331,.291,.272,.279,.313,.343,.358, 3067.
3256 P .411,.451,.468,.447,.403,.320,.289,.271,.277,.308,.334,.349, 3068.
3257 Q .386,.434,.456,.443,.404,.332,.297,.273,.273,.300,.317,.339, 3069.
3258 R .378,.430,.453,.446,.407,.342,.310,.282,.279,.296,.314,.332/ 3070.
3259 DATA O3AVEH/ 3071.
3260 A .315,.292,.293,.295,.299,.297,.303,.311,.320,.334,.378,.358, 3072.
3261 B .320,.294,.298,.303,.306,.308,.316,.325,.337,.355,.387,.362, 3073.
3262 C .330,.304,.307,.311,.315,.323,.334,.345,.360,.381,.389,.366, 3074.
3263 D .339,.318,.312,.314,.328,.344,.355,.368,.388,.401,.384,.360, 3075.
3264 E .325,.313,.302,.300,.318,.339,.354,.369,.381,.380,.360,.337, 3076.
3265 F .299,.291,.285,.284,.296,.313,.326,.340,.350,.343,.328,.312, 3077.
3266 G .277,.271,.269,.269,.272,.281,.288,.296,.308,.311,.298,.289, 3078.
3267 H .257,.253,.252,.254,.253,.257,.262,.267,.272,.281,.272,.265, 3079.
3268 I .241,.241,.241,.246,.245,.248,.246,.248,.253,.260,.255,.250, 3080.
3269 J .234,.236,.242,.256,.260,.260,.246,.244,.240,.241,.237,.237, 3081.
3270 K .243,.246,.257,.273,.279,.276,.261,.258,.251,.246,.238,.238, 3082.
3271 L .270,.269,.288,.299,.308,.299,.283,.276,.269,.263,.252,.257, 3083.
3272 M .327,.339,.358,.349,.351,.337,.313,.292,.288,.280,.284,.302, 3084.
3273 N .407,.419,.432,.407,.390,.356,.324,.298,.300,.304,.327,.368, 3085.
3274 O .421,.455,.459,.439,.393,.333,.306,.287,.289,.311,.345,.377, 3086.
3275 P .408,.452,.465,.443,.399,.323,.296,.276,.279,.309,.338,.362, 3087.
3276 Q .387,.437,.459,.444,.404,.334,.301,.276,.277,.302,.320,.345, 3088.
3277 R .379,.433,.455,.447,.408,.343,.313,.282,.279,.298,.315,.336/ 3089.
3278 DATA O3AVEI/ 3090.
3279 A .313,.291,.291,.293,.299,.296,.302,.310,.319,.333,.379,.354, 3091.
3280 B .316,.292,.295,.300,.307,.306,.315,.322,.333,.354,.384,.354, 3092.
3281 C .322,.302,.301,.307,.309,.319,.331,.340,.357,.379,.385,.356, 3093.
3282 D .328,.310,.301,.306,.316,.332,.347,.359,.380,.397,.379,.348, 3094.
3283 E .315,.304,.293,.296,.308,.328,.345,.360,.374,.376,.356,.329, 3095.
3284 F .292,.285,.277,.278,.288,.304,.318,.330,.340,.340,.324,.306, 3096.
3285 G .271,.266,.262,.263,.266,.277,.283,.291,.301,.307,.293,.284, 3097.
3286 H .253,.249,.249,.252,.250,.256,.261,.267,.271,.278,.267,.263, 3098.
3287 I .240,.238,.240,.247,.244,.248,.247,.250,.254,.258,.251,.249, 3099.
3288 J .233,.236,.243,.254,.259,.258,.248,.246,.241,.243,.238,.238, 3100.
3289 K .242,.246,.256,.268,.273,.271,.260,.255,.250,.244,.240,.239, 3101.
3290 L .258,.266,.278,.290,.295,.288,.277,.269,.265,.257,.253,.256, 3102.
3291 M .294,.308,.325,.326,.322,.308,.297,.284,.278,.271,.277,.287, 3103.
3292 N .338,.368,.383,.371,.357,.329,.316,.294,.287,.288,.303,.324, 3104.
3293 O .375,.420,.429,.411,.382,.328,.312,.293,.287,.299,.322,.354, 3105.
3294 P .388,.440,.454,.437,.396,.328,.307,.285,.282,.305,.330,.359, 3106.
3295 Q .386,.439,.457,.444,.404,.338,.309,.283,.280,.304,.321,.349, 3107.
3296 R .379,.435,.456,.448,.408,.345,.316,.286,.281,.300,.317,.337/ 3108.
3297 DATA O3AVEJ/ 3109.
3298 A .313,.290,.290,.291,.298,.294,.301,.309,.318,.331,.378,.353, 3110.
3299 B .313,.291,.291,.296,.304,.302,.311,.318,.330,.348,.382,.350, 3111.
3300 C .315,.297,.294,.300,.306,.310,.325,.334,.348,.364,.378,.346, 3112.
3301 D .316,.301,.292,.297,.305,.317,.334,.346,.360,.371,.366,.335, 3113.
3302 E .304,.293,.283,.286,.295,.313,.330,.344,.356,.359,.346,.316, 3114.
3303 F .284,.276,.268,.271,.279,.297,.309,.320,.325,.330,.317,.296, 3115.
3304 G .265,.258,.254,.257,.261,.273,.280,.288,.289,.296,.287,.274, 3116.
3305 H .250,.245,.244,.249,.247,.255,.260,.265,.268,.273,.263,.257, 3117.
3306 I .237,.235,.238,.246,.246,.249,.247,.249,.251,.257,.249,.247, 3118.
3307 J .234,.236,.245,.256,.259,.255,.248,.249,.244,.245,.242,.238, 3119.
3308 K .244,.249,.259,.271,.273,.270,.258,.256,.253,.247,.243,.242, 3120.
3309 L .261,.273,.283,.291,.292,.284,.271,.269,.263,.257,.254,.257, 3121.
3310 M .289,.305,.319,.321,.315,.301,.287,.281,.273,.268,.272,.282, 3122.
3311 N .321,.347,.364,.358,.344,.319,.305,.293,.282,.281,.291,.313, 3123.
3312 O .357,.400,.409,.397,.373,.332,.314,.295,.286,.293,.309,.333, 3124.
3313 P .377,.429,.442,.429,.396,.338,.317,.294,.287,.302,.321,.351, 3125.
3314 Q .385,.439,.458,.443,.407,.345,.318,.292,.284,.304,.322,.349, 3126.
3315 R .380,.437,.458,.449,.408,.348,.319,.289,.283,.301,.319,.340/ 3127.
3316 DATA O3AVEK/ 3128.
3317 A .311,.289,.289,.290,.298,.293,.300,.308,.317,.329,.377,.352, 3129.
3318 B .308,.290,.288,.291,.301,.296,.307,.315,.326,.340,.377,.344, 3130.
3319 C .305,.291,.287,.293,.297,.302,.315,.325,.335,.346,.369,.333, 3131.
3320 D .299,.289,.281,.287,.293,.302,.317,.327,.335,.344,.353,.318, 3132.
3321 E .287,.279,.272,.277,.281,.295,.309,.320,.325,.332,.331,.301, 3133.
3322 F .272,.264,.259,.262,.268,.281,.292,.300,.300,.309,.305,.282, 3134.
3323 G .257,.249,.246,.250,.254,.264,.271,.278,.279,.285,.278,.263, 3135.
3324 H .246,.239,.239,.245,.245,.252,.255,.261,.262,.267,.259,.250, 3136.
3325 I .234,.231,.239,.245,.245,.248,.245,.249,.248,.254,.246,.243, 3137.
3326 J .235,.237,.247,.258,.260,.257,.250,.250,.245,.246,.241,.240, 3138.
3327 K .248,.254,.264,.276,.276,.272,.262,.258,.255,.250,.248,.246, 3139.
3328 L .267,.278,.289,.300,.296,.286,.272,.270,.263,.258,.258,.262, 3140.
3329 M .292,.310,.325,.329,.319,.302,.288,.280,.273,.268,.274,.281, 3141.
3330 N .323,.346,.365,.365,.347,.320,.305,.291,.282,.281,.292,.305, 3142.
3331 O .352,.390,.405,.398,.378,.338,.316,.300,.290,.294,.309,.330, 3143.
3332 P .376,.424,.440,.431,.404,.350,.323,.303,.293,.303,.321,.349, 3144.
3333 Q .386,.442,.462,.448,.411,.354,.324,.298,.289,.306,.325,.349, 3145.
3334 R .381,.441,.459,.452,.410,.352,.322,.293,.286,.301,.320,.342/ 3146.
3335 DATA O3AVEL/ 3147.
3336 A .309,.290,.288,.288,.295,.292,.299,.307,.315,.327,.375,.350, 3148.
3337 B .306,.289,.287,.288,.298,.293,.304,.311,.320,.333,.372,.340, 3149.
3338 C .298,.286,.282,.288,.290,.294,.308,.316,.322,.332,.362,.325, 3150.
3339 D .289,.280,.274,.281,.282,.290,.304,.312,.317,.325,.342,.309, 3151.
3340 E .276,.269,.264,.268,.271,.281,.293,.300,.304,.313,.318,.290, 3152.
3341 F .262,.256,.253,.255,.258,.267,.278,.283,.283,.293,.294,.272, 3153.
3342 G .250,.245,.241,.245,.246,.255,.261,.267,.265,.282,.272,.256, 3154.
3343 H .240,.235,.236,.243,.240,.245,.249,.254,.253,.260,.254,.247, 3155.
3344 I .232,.229,.239,.245,.244,.247,.241,.245,.241,.246,.243,.241, 3156.
3345 J .235,.236,.247,.258,.258,.254,.246,.246,.239,.240,.238,.240, 3157.
3346 K .248,.253,.263,.273,.271,.267,.256,.253,.245,.243,.243,.244, 3158.
3347 L .265,.274,.287,.293,.290,.281,.267,.262,.256,.251,.253,.258, 3159.
3348 M .293,.307,.324,.323,.315,.298,.284,.275,.268,.263,.271,.278, 3160.
3349 N .326,.348,.370,.363,.347,.320,.304,.290,.281,.278,.291,.306, 3161.
3350 O .357,.391,.412,.404,.380,.347,.322,.303,.296,.296,.313,.334, 3162.
3351 P .381,.431,.447,.439,.412,.363,.331,.311,.301,.308,.331,.353, 3163.
3352 Q .389,.449,.470,.456,.417,.363,.329,.306,.296,.308,.331,.354, 3164.
3353 R .382,.441,.462,.454,.413,.354,.325,.296,.289,.301,.319,.343/ 3165.
3354 DATA O3AVEM/ 3166.
3355 A .309,.290,.288,.289,.293,.292,.299,.306,.313,.325,.374,.350, 3167.
3356 B .306,.289,.286,.285,.296,.291,.300,.308,.316,.326,.369,.339, 3168.
3357 C .297,.284,.281,.285,.288,.290,.302,.308,.315,.324,.355,.323, 3169.
3358 D .287,.278,.272,.275,.277,.284,.295,.300,.306,.316,.333,.304, 3170.
3359 E .273,.266,.261,.263,.267,.274,.284,.288,.292,.302,.311,.286, 3171.
3360 F .260,.253,.250,.252,.253,.261,.268,.273,.275,.284,.288,.269, 3172.
3361 G .247,.244,.241,.245,.243,.250,.254,.260,.260,.270,.268,.254, 3173.
3362 H .238,.234,.235,.242,.239,.243,.244,.250,.249,.255,.253,.245, 3174.
3363 I .231,.231,.238,.244,.242,.246,.238,.242,.239,.243,.242,.239, 3175.
3364 J .236,.238,.247,.257,.254,.253,.245,.244,.237,.235,.235,.236, 3176.
3365 K .250,.254,.263,.270,.266,.264,.254,.250,.244,.239,.237,.243, 3177.
3366 L .270,.279,.289,.290,.285,.279,.267,.261,.256,.250,.251,.258, 3178.
3367 M .301,.317,.329,.322,.314,.298,.285,.277,.270,.263,.270,.282, 3179.
3368 N .342,.367,.380,.369,.351,.326,.309,.294,.286,.284,.295,.314, 3180.
3369 O .380,.412,.424,.411,.388,.357,.331,.311,.303,.302,.325,.347, 3181.
3370 P .398,.448,.457,.449,.419,.373,.343,.318,.309,.314,.341,.366, 3182.
3371 Q .396,.456,.480,.466,.424,.370,.338,.311,.303,.311,.336,.363, 3183.
3372 R .384,.442,.464,.456,.414,.358,.327,.297,.290,.302,.322,.344/ 3184.
3373 DATA O3AVEN/ 3185.
3374 A .311,.291,.287,.288,.293,.292,.297,.305,.312,.325,.373,.350, 3186.
3375 B .307,.290,.286,.285,.293,.292,.300,.305,.315,.326,.366,.341, 3187.
3376 C .300,.287,.283,.282,.288,.292,.300,.306,.313,.324,.351,.323, 3188.
3377 D .290,.281,.274,.276,.279,.285,.293,.298,.303,.315,.330,.308, 3189.
3378 E .276,.272,.265,.264,.267,.274,.281,.287,.288,.302,.309,.289, 3190.
3379 F .263,.259,.254,.253,.257,.262,.267,.272,.274,.285,.287,.273, 3191.
3380 G .252,.247,.244,.248,.247,.252,.254,.260,.262,.270,.268,.259, 3192.
3381 H .243,.238,.239,.244,.241,.245,.245,.251,.251,.257,.253,.249, 3193.
3382 I .236,.233,.238,.244,.244,.246,.238,.243,.242,.245,.243,.242, 3194.
3383 J .237,.241,.247,.256,.255,.254,.245,.245,.242,.234,.234,.236, 3195.
3384 K .252,.259,.266,.271,.269,.269,.257,.256,.251,.242,.240,.245, 3196.
3385 L .277,.286,.296,.298,.292,.290,.276,.275,.267,.259,.259,.267, 3197.
3386 M .323,.342,.352,.339,.333,.319,.303,.298,.288,.280,.285,.296, 3198.
3387 N .374,.403,.413,.392,.376,.351,.332,.319,.306,.303,.317,.340, 3199.
3388 O .408,.448,.448,.433,.410,.375,.351,.330,.317,.318,.343,.368, 3200.
3389 P .418,.467,.473,.464,.426,.383,.347,.328,.316,.319,.347,.376, 3201.
3390 Q .402,.459,.482,.474,.426,.374,.343,.313,.306,.313,.338,.368, 3202.
3391 R .384,.440,.463,.458,.415,.360,.328,.299,.291,.301,.319,.344/ 3203.
3392 DATA O3AVEO/ 3204.
3393 A .313,.291,.288,.288,.292,.292,.298,.305,.312,.324,.364,.351, 3205.
3394 B .311,.294,.289,.286,.294,.293,.302,.306,.316,.326,.358,.345, 3206.
3395 C .308,.296,.291,.286,.294,.297,.303,.310,.316,.330,.354,.331, 3207.
3396 D .301,.292,.284,.282,.286,.295,.301,.307,.310,.326,.334,.318, 3208.
3397 E .290,.283,.274,.273,.276,.286,.291,.297,.299,.314,.314,.302, 3209.
3398 F .280,.272,.266,.263,.264,.272,.277,.283,.286,.297,.295,.286, 3210.
3399 G .267,.261,.256,.254,.255,.260,.263,.268,.272,.280,.276,.271, 3211.
3400 H .254,.250,.249,.249,.247,.251,.251,.256,.259,.264,.261,.258, 3212.
3401 I .242,.242,.243,.245,.244,.248,.242,.247,.248,.252,.248,.248, 3213.
3402 J .237,.242,.249,.256,.255,.255,.245,.244,.243,.237,.236,.236, 3214.
3403 K .253,.256,.267,.271,.270,.270,.259,.258,.252,.245,.242,.248, 3215.
3404 L .279,.283,.296,.296,.294,.292,.280,.279,.269,.260,.260,.268, 3216.
3405 M .327,.339,.357,.345,.338,.328,.319,.309,.293,.284,.285,.302, 3217.
3406 N .386,.409,.421,.405,.388,.363,.346,.332,.314,.311,.319,.348, 3218.
3407 O .419,.450,.459,.445,.418,.384,.361,.338,.322,.320,.340,.373, 3219.
3408 P .419,.461,.473,.468,.423,.358,.358,.331,.316,.319,.343,.376, 3220.
3409 Q .401,.453,.477,.469,.423,.375,.345,.314,.307,.312,.333,.361, 3221.
3410 R .382,.437,.461,.455,.415,.361,.329,.299,.291,.301,.316,.341/ 3222.
3411 DATA O3AVEP/ 3223.
3412 A .314,.293,.289,.290,.292,.294,.299,.305,.312,.323,.363,.352, 3224.
3413 B .315,.298,.293,.290,.294,.299,.303,.307,.316,.324,.365,.350, 3225.
3414 C .315,.303,.296,.291,.300,.306,.311,.316,.323,.336,.360,.341, 3226.
3415 D .308,.301,.293,.291,.297,.308,.312,.318,.324,.337,.345,.329, 3227.
3416 E .299,.292,.284,.283,.285,.299,.306,.311,.317,.326,.327,.314, 3228.
3417 F .285,.280,.272,.272,.274,.284,.293,.296,.301,.308,.306,.297, 3229.
3418 G .272,.266,.262,.261,.262,.269,.275,.280,.283,.289,.284,.280, 3230.
3419 H .256,.253,.251,.251,.251,.255,.256,.264,.266,.271,.267,.263, 3231.
3420 I .241,.242,.244,.245,.245,.248,.245,.251,.251,.255,.252,.251, 3232.
3421 J .236,.239,.247,.253,.253,.251,.242,.244,.239,.237,.235,.236, 3233.
3422 K .248,.250,.262,.267,.264,.262,.254,.250,.244,.240,.235,.239, 3234.
3423 L .268,.270,.286,.287,.284,.278,.267,.264,.256,.250,.245,.256, 3235.
3424 M .301,.308,.329,.322,.317,.300,.297,.281,.272,.264,.263,.279, 3236.
3425 N .351,.362,.380,.372,.360,.337,.320,.305,.295,.285,.287,.316, 3237.
3426 O .383,.406,.427,.415,.391,.365,.345,.324,.310,.304,.310,.342, 3238.
3427 P .393,.428,.450,.441,.404,.373,.353,.324,.310,.310,.321,.356, 3239.
3428 Q .387,.435,.461,.456,.412,.370,.341,.313,.303,.306,.321,.353, 3240.
3429 R .381,.432,.457,.452,.413,.361,.328,.299,.291,.298,.314,.338/ 3241.
3430 DATA O3AVEQ/ 3242.
3431 A .315,.293,.289,.291,.293,.295,.298,.305,.312,.323,.362,.354, 3243.
3432 B .316,.301,.295,.291,.294,.300,.303,.307,.316,.322,.361,.350, 3244.
3433 C .318,.305,.297,.292,.298,.306,.311,.314,.324,.334,.354,.340, 3245.
3434 D .309,.301,.292,.289,.295,.305,.312,.317,.326,.335,.343,.326, 3246.
3435 E .295,.288,.279,.279,.284,.297,.305,.305,.316,.321,.324,.310, 3247.
3436 F .279,.272,.266,.269,.272,.281,.289,.291,.299,.303,.305,.293, 3248.
3437 G .263,.259,.254,.257,.259,.266,.273,.276,.281,.285,.284,.277, 3249.
3438 H .247,.246,.244,.248,.247,.252,.253,.261,.265,.269,.267,.259, 3250.
3439 I .235,.236,.239,.244,.243,.246,.243,.247,.251,.253,.249,.246, 3251.
3440 J .231,.234,.243,.250,.251,.247,.240,.238,.233,.234,.232,.233, 3252.
3441 K .242,.244,.257,.262,.260,.255,.247,.243,.235,.235,.228,.233, 3253.
3442 L .257,.263,.278,.280,.275,.269,.258,.252,.242,.239,.235,.243, 3254.
3443 M .280,.288,.308,.307,.299,.287,.274,.267,.255,.250,.246,.259, 3255.
3444 N .309,.319,.348,.340,.332,.309,.293,.286,.273,.264,.261,.282, 3256.
3445 O .339,.357,.388,.376,.360,.334,.320,.305,.289,.282,.279,.306, 3257.
3446 P .365,.393,.424,.411,.386,.355,.340,.316,.300,.303,.297,.329, 3258.
3447 Q .375,.415,.445,.439,.404,.365,.336,.310,.298,.299,.306,.338, 3259.
3448 R .379,.428,.453,.447,.412,.360,.326,.298,.291,.296,.310,.335/ 3260.
3449 DATA O3AVER/ 3261.
3450 A .316,.295,.291,.292,.292,.296,.299,.305,.313,.323,.361,.355, 3262.
3451 B .317,.301,.296,.292,.292,.300,.302,.305,.314,.319,.358,.348, 3263.
3452 C .316,.303,.295,.289,.291,.301,.306,.307,.317,.324,.348,.336, 3264.
3453 D .303,.294,.286,.283,.285,.296,.304,.304,.313,.322,.333,.318, 3265.
3454 E .283,.277,.272,.272,.273,.284,.290,.296,.302,.309,.314,.299, 3266.
3455 F .265,.262,.259,.259,.259,.268,.274,.282,.286,.293,.293,.279, 3267.
3456 G .252,.249,.248,.249,.247,.253,.258,.265,.272,.277,.273,.265, 3268.
3457 H .241,.238,.240,.242,.241,.244,.246,.252,.257,.260,.256,.249, 3269.
3458 I .231,.229,.238,.241,.241,.242,.237,.242,.244,.247,.242,.239, 3270.
3459 J .231,.233,.242,.249,.251,.246,.237,.235,.230,.230,.229,.230, 3271.
3460 K .241,.250,.257,.265,.262,.257,.245,.243,.234,.230,.229,.231, 3272.
3461 L .260,.273,.281,.285,.280,.272,.257,.256,.245,.238,.237,.245, 3273.
3462 M .285,.302,.312,.314,.305,.294,.278,.277,.262,.252,.251,.262, 3274.
3463 N .310,.331,.347,.346,.336,.320,.303,.298,.281,.267,.267,.283, 3275.
3464 O .331,.354,.383,.378,.364,.342,.324,.315,.293,.278,.279,.297, 3276.
3465 P .350,.379,.414,.398,.381,.343,.335,.317,.299,.287,.285,.311, 3277.
3466 Q .367,.404,.436,.428,.399,.361,.332,.307,.295,.293,.298,.327, 3278.
3467 R .376,.424,.450,.442,.409,.358,.326,.296,.290,.294,.306,.332/ 3279.
3468 C 3280.
3469 DIMENSION AO3AVE(18,12),SO3JF(11,19),SO3SO(11,19) 3281.
3470 DATA AO3AVE/ .3148,.3160,.3171,.3159,.3027,.2824,.2645,3282.
3471 A.2493,.2376,.2344,.2455,.2667,.3038,.3467,.3753,.3842,.3817,.3780,3283.
3472 B.2926,.2959,.3008,.3035,.2943,.2763,.2600,.2463,.2366,.2366,.2500,3284.
3473 C.2735,.3166,.3661,.4076,.4270,.4310,.4309,.2904,.2937,.2974,.2959,3285.
3474 D.2869,.2704,.2561,.2454,.2403,.2443,.2590,.2844,.3293,.3803,.4210,3286.
3475 E.4439,.4534,.4539,.2918,.2943,.2965,.2940,.2834,.2687,.2561,.2476,3287.
3476 F.2450,.2538,.2676,.2888,.3259,.3692,.4077,.4325,.4454,.4476,.2951,3288.
3477 G.2979,.2994,.3001,.2904,.2731,.2575,.2467,.2441,.2548,.2675,.2873,3289.
3478 H.3181,.3517,.3828,.4002,.4080,.4096,.2960,.3012,.3084,.3132,.3044,3290.
3479 I.2852,.2660,.2515,.2465,.2521,.2641,.2802,.3023,.3257,.3417,.3457,3291.
3480 J.3521,.3517,.3008,.3070,.3153,.3211,.3127,.2934,.2714,.2545,.2437,3292.
3481 K.2440,.2528,.2665,.2875,.3064,.3191,.3222,.3210,.3201,.3074,.3126,3293.
3482 L.3221,.3276,.3211,.3015,.2783,.2603,.2478,.2431,.2499,.2624,.2784,3294.
3483 M.2928,.3024,.3017,.2954,.2914,.3156,.3224,.3326,.3391,.3300,.3071,3295.
3484 N.2827,.2632,.2489,.2399,.2455,.2566,.2720,.2854,.2939,.2931,.2889,3296.
3485 O.2854,.3282,.3354,.3456,.3504,.3368,.3124,.2899,.2692,.2532,.2389,3297.
3486 P.2415,.2521,.2672,.2844,.2967,.3003,.2986,.2966,.3723,.3713,.3661,3298.
3487 Q.3538,.3332,.3072,.2826,.2626,.2481,.2359,.2373,.2489,.2700,.2936,3299.
3488 R.3113,.3172,.3154,.3130,.3554,.3533,.3467,.3353,.3146,.2925,.2723,3300.
3489 S.2562,.2450,.2350,.2387,.2554,.2828,.3140,.3331,.3406,.3408,.3351/3301.
3490 C 3302.
3491 DATA SO3JF/ 3303.
3492 A 13.0,12.3,11.7,10.5,8.90,6.20,4.50,3.30,2.20,1.80,1.00, 3304.
3493 B 13.6,12.9,11.9,10.3,8.30,6.10,4.45,3.40,2.50,1.85,1.00, 3305.
3494 C 14.8,13.9,12.8,10.3,8.00,6.00,4.55,3.60,2.70,1.90,1.00, 3306.
3495 D 16.6,15.1,14.0,11.0,7.95,6.00,4.65,3.70,2.95,1.95,1.00, 3307.
3496 E 18.1,16.0,14.6,12.0,8.00,6.00,4.80,3.75,3.00,1.98,1.00, 3308.
3497 F 18.3,16.3,14.8,12.6,8.20,6.15,4.80,3.80,3.05,2.00,1.00, 3309.
3498 G 17.3,16.1,14.7,12.7,9.10,6.10,4.70,3.75,3.00,2.00,1.00, 3310.
3499 H 16.3,15.5,14.5,12.6,9.00,6.00,4.55,3.65,2.95,1.98,1.00, 3311.
3500 I 15.7,14.9,14.1,12.4,8.70,5.90,4.40,3.45,2.80,1.96,1.00, 3312.
3501 J 15.3,14.1,13.5,12.2,8.30,5.85,4.25,3.40,2.75,1.95,1.00, 3313.
3502 K 15.6,14.9,14.0,12.4,9.00,6.10,4.55,3.50,2.85,1.96,1.00, 3314.
3503 L 17.4,16.6,16.0,14.0,10.0,7.30,5.10,3.90,3.00,1.97,1.00, 3315.
3504 M 17.6,18.3,17.8,15.8,12.3,9.00,6.05,4.40,3.20,1.97,1.00, 3316.
3505 N 16.0,16.9,17.8,16.8,15.2,12.0,7.90,5.10,3.65,1.97,1.00, 3317.
3506 O 12.3,13.8,15.7,16.2,16.2,14.8,10.0,6.00,4.00,1.96,1.00, 3318.
3507 P 12.0,11.9,12.0,13.8,14.3,14.3,12.0,6.80,4.30,1.95,1.00, 3319.
3508 Q 11.9,11.8,11.7,11.6,11.8,12.0,10.3,7.20,4.50,1.90,1.00, 3320.
3509 R 11.6,11.5,11.4,11.2,11.0,10.4,9.00,7.20,4.15,1.85,1.00, 3321.
3510 S 11.2,10.9,10.7,10.5,10.0,9.75,8.60,7.00,3.80,1.80,1.00/ 3322.
3511 DATA SO3SO/ 3323.
3512 A 10.5,10.5,10.5,10.6,10.5,10.3,8.20,4.80,3.10,1.90,1.00, 3324.
3513 B 11.5,11.5,11.6,12.1,12.1,10.8,8.05,4.95,3.40,1.92,1.00, 3325.
3514 C 12.7,13.8,14.0,14.1,12.9,10.9,7.95,5.10,3.70,1.96,1.00, 3326.
3515 D 15.4,15.9,16.0,15.4,13.2,10.7,7.40,5.15,3.85,1.98,1.00, 3327.
3516 E 17.9,18.0,17.4,16.1,13.0,10.0,6.70,4.90,3.80,1.99,1.00, 3328.
3517 F 18.3,18.6,17.8,16.1,12.1,9.10,5.95,4.80,3.70,2.00,1.00, 3329.
3518 G 18.6,18.5,17.8,15.9,11.1,8.00,5.55,4.40,3.45,2.00,1.00, 3330.
3519 H 18.2,18.1,17.2,15.1,10.3,7.40,5.10,4.00,3.10,1.99,1.00, 3331.
3520 I 17.5,16.8,16.2,14.0,9.90,7.00,4.90,3.85,2.95,1.98,1.00, 3332.
3521 J 16.5,15.8,15.0,12.9,9.40,6.65,4.80,3.70,2.90,1.96,1.00, 3333.
3522 K 16.3,15.8,15.0,12.9,9.20,6.80,5.00,3.85,2.95,1.96,1.00, 3334.
3523 L 16.4,16.2,15.8,14.0,9.80,7.10,5.10,3.95,3.00,1.96,1.00, 3335.
3524 M 16.6,16.5,16.2,14.8,10.8,7.75,5.50,4.05,3.05,1.97,1.00, 3336.
3525 N 16.5,16.6,16.5,16.0,12.1,9.00,6.00,4.40,3.10,1.97,1.00, 3337.
3526 O 15.8,16.2,16.4,16.1,14.2,10.9,6.60,4.50,3.20,1.97,1.00, 3338.
3527 P 12.2,14.2,15.5,15.3,14.7,12.4,7.40,4.70,3.10,1.96,1.00, 3339.
3528 Q 11.6,11.9,12.1,14.0,13.9,12.3,8.00,4.40,2.95,1.90,1.00, 3340.
3529 R 11.2,11.2,11.4,11.6,11.8,10.9,8.00,3.95,2.60,1.87,1.00, 3341.
3530 S 11.0,10.8,10.5,10.3,10.1,9.70,7.00,3.65,2.20,1.80,1.00/ 3342.
3531 C 3343.
3532 DIMENSION XJDMO(14),HKMSPR(14),HKMAUT(14) 3344.
3533 DIMENSION CNCAUT(14),CNCSPR(14),DEGLAT(14) 3345.
3534 DATA DEGLAT/-85.0,-71.0,-59.0,-47.0,-35.0,-22.0,-9.0, 3346.
3535 + 9.0,22.0,35.0,47.0,59.0,71.0,85.0/ 3347.
3536 DATA XJDMO/-15.0,16.0,45.0,75.0,105.0,136.0,166.0,197.0,228.0 3348.
3537 + ,258.0,289.0,319.0,350.0,381.0/ 3349.
3538 DATA HKMSPR/18.5,18.5,19.0,23.5,24.0,24.5,26.5, 3350.
3539 + 26.5,25.0,22.5,21.0,20.0,18.5,16.5/ 3351.
3540 DATA HKMAUT/16.5,18.5,20.0,21.0,22.5,25.0,26.5, 3352.
3541 + 26.5,24.5,24.0,23.5,19.0,18.5,18.5/ 3353.
3542 DATA CNCSPR/0.0181,0.0212,0.0187,0.0167,0.0162,0.0183,0.0175, 3354.
3543 + 0.0187,0.0200,0.0196,0.0225,0.0291,0.0287,0.0300/ 3355.
3544 DATA CNCAUT/0.0300,0.0287,0.0291,0.0225,0.0196,0.0200,0.0187, 3356.
3545 + 0.0175,0.0183,0.0162,0.0167,0.0187,0.0212,0.0181/ 3357.
3546 C 3358.
3547 DIMENSION PLBSO3(11),SOJDAY(6),PMLAT(6) 3359.
3548 DATA PLBSO3/10.0,7.0,5.0,3.0,2.0,1.5,1.0,0.7,0.5,0.3,0.1/ 3360.
3549 DATA SOJDAY/-91.,31.,92.,213.,274.,396./ 3361.
3550 DATA PMLAT/1.,1.,-1.,-1.,1.,1./ 3362.
3551 DIMENSION AO3JIM(144),O3LB(40),PLB0(40) 3363.
3552 DIMENSION CONCS(144),CONCA(144),BHKMS(144),BHKMA(144) 3364.
3553 DIMENSION WTJLAT(144),WTJLON(144),ILATIJ(144),ILONIJ(144) 3365.
3554 DIMENSION WTLSEP(144),WTLJAN(144),LSEPJ(144),LJANJ(144) 3366.
3555 DATA ACMMGG/2.37251E-4/,ACMPKM/7.1509E-4/,H10MB/31.05467/ 3367.
3556 DATA A,B,C,D/0.331,23.0,4.553,5.23/ 3368.
3557 LOGICAL SKIPI 3369.
3558 C 3370.
3559 C-----------------------------------------------------------------------3371.
3560 C----SET O3 VERTICAL PROFILE PARAMETERS FOR LATITUDE GCM GRID POINTS 3372.
3561 C-----------------------------------------------------------------------3373.
3562 SKIPI =.FALSE. 3374.
3563 IF(ABS(FLONO3).LT.1.E-04) SKIPI =.TRUE. 3375.
3564 DO 100 L=1,NL 3376.
3565 100 PLB0(L)=PLB(L) 3377.
3566 DO 103 J=1,JMLAT 3378.
3567 DLATJ=DLAT(J) 3379.
3568 ILATI=(DLATJ+95.001)/10. 3380.
3569 IF(ILATI.LT. 1) ILATI= 1 3381.
3570 IF(ILATI.GT.17) ILATI=17 3382.
3571 ILATIJ(J)=ILATI 3383.
3572 LATD=ILATI*10-95 3384.
3573 WTJL=(DLATJ-LATD)*0.1 3385.
3574 WTJLAT(J)=WTJL 3386.
3575 DO 101 JJ=2,14 3387.
3576 II=JJ-1 3388.
3577 IF(DLATJ.LE.DEGLAT(JJ)) GO TO 102 3389.
3578 101 CONTINUE 3389.1
3579 JJ=14 3390.
3580 102 WTJJ=(DLATJ-DEGLAT(II))/(DEGLAT(JJ)-DEGLAT(II)) 3391.
3581 WTII=1.-WTJJ 3392.
3582 CONCS(J)=WTII*CNCSPR(II)+WTJJ*CNCSPR(JJ) 3393.
3583 CONCA(J)=WTII*CNCAUT(II)+WTJJ*CNCAUT(JJ) 3394.
3584 BHKMS(J)=WTII*HKMSPR(II)+WTJJ*HKMSPR(JJ) 3395.
3585 103 BHKMA(J)=WTII*HKMAUT(II)+WTJJ*HKMAUT(JJ) 3396.
3586 C 3397.
3587 DO 104 I=1,IMLON 3398.
3588 DLONI=DLON(I) 3399.
3589 ILONG=DLONI/20.0 3400.
3590 WTJLG=(DLONI-ILONG*20)/20.0 3401.
3591 WTJLON(I)=WTJLG 3402.
3592 WTILG=1.-WTJLG 3403.
3593 ILONG=ILONG+1 3404.
3594 JLONG=ILONG+1 3405.
3595 IF(ILONG.GT.18) ILONG=18 3406.
3596 IF(ILONG.GT.17) JLONG=1 3407.
3597 104 ILONIJ(I)=ILONG 3408.
3598 NLAY=LASTVC/100000 3409.
3599 NATM=(LASTVC-NLAY*100000)/10000 3410.
3600 IF(NATM.GT.0) GO TO 106 3411.
3601 C 3412.
3602 O3B=0.343 3413.
3603 DO 105 L=1,NL 3414.
3604 HLT=HLB(L+1) 3415.
3605 O3T=A*(1.0+EXP(-B/C))/(1.0+EXP((HLT-B)/C))+(0.343-A)*EXP(-HLT/D) 3416.
3606 U0GAS(L,3)=(O3B-O3T) 3417.
3607 105 O3B=O3T 3418.
3608 C 3419.
3609 106 AO3J=0.0 3420.
3610 RETURN 3421.
3611 C-----------------------------------------------------------------------3422.
3612 ENTRY O3DDAY 3423.
3613 C-----------------------------------------------------------------------3424.
3614 XJDAY=JDAY 3425.
3615 WTAUT=(XJDAY-91.)/213. 3426.
3616 IF(XJDAY.LT. 91.) WTAUT=( 91.-XJDAY)/152. 3427.
3617 IF(XJDAY.GT.304.) WTAUT=(456.-XJDAY)/152. 3428.
3618 WTSPR=1.-WTAUT 3429.
3619 DO 200 JMO=1,14 3430.
3620 XJDMJ=XJDMO(JMO) 3431.
3621 IF(XJDAY.LT.XJDMJ) GO TO 201 3432.
3622 200 XJDMI=XJDMJ 3433.
3623 XJDMI=XJDMO(13) 3434.
3624 201 DAYMO=XJDMJ-XJDMI 3435.
3625 WTJM=(XJDAY-XJDMI)/DAYMO 3436.
3626 WTIM=1.-WTJM 3437.
3627 JMO=JMO-1 3438.
3628 IMO=JMO-1 3439.
3629 IF(IMO.LT.1) IMO=12 3440.
3630 IF(JMO.GT.12) JMO=1 3441.
3631 JJDAY=1 3442.
3632 SJDAY=SOJDAY(JJDAY) 3443.
3633 202 JJDAY=JJDAY+1 3444.
3634 SIDAY=SJDAY 3445.
3635 SJDAY=SOJDAY(JJDAY) 3446.
3636 IF(XJDAY.GT.SJDAY) GO TO 202 3447.
3637 WTJAN=(XJDAY-SIDAY)/(SJDAY-SIDAY) 3448.
3638 IF(JJDAY.EQ.3.OR.JJDAY.EQ.5) WTJAN=1.-WTJAN 3449.
3639 WTSEP=1.0-WTJAN 3450.
3640 DO 203 J=1,JMLAT 3451.
3641 DLATJ=DLAT(J) 3452.
3642 DLSEP=10.0+0.099999*DLATJ*PMLAT(JJDAY) 3453.
3643 DLJAN=10.0+0.099999*DLATJ*PMLAT(JJDAY-1) 3454.
3644 LSEP=DLSEP 3455.
3645 LJAN=DLJAN 3456.
3646 LJANJ(J)=LJAN 3457.
3647 LSEPJ(J)=LSEP 3458.
3648 WTLSEP(J)=DLSEP-LSEP 3459.
3649 203 WTLJAN(J)=DLJAN-LJAN 3460.
3650 IF(AO3J.GT.1.E-10) GO TO 400 3461.
3651 C 3462.
3652 C-----------------------------------------------------------------------3463.
3653 ENTRY O3DLAT 3464.
3654 C-----------------------------------------------------------------------3465.
3655 ILATI=ILATIJ(JLAT) 3466.
3656 WTJL=WTJLAT(JLAT) 3467.
3657 WTIL=1.-WTJL 3468.
3658 JLATI=ILATI+1 3469.
3659 LSEP=LSEPJ(JLAT) 3470.
3660 LJAN=LJANJ(JLAT) 3471.
3661 WTLS=WTLSEP(JLAT) 3472.
3662 WTLJ=WTLJAN(JLAT) 3473.
3663 AO3J=WTIM*(WTIL*AO3AVE(ILATI,IMO)+WTJL*AO3AVE(JLATI,IMO)) 3474.
3664 + +WTJM*(WTIL*AO3AVE(ILATI,JMO)+WTJL*AO3AVE(JLATI,JMO)) 3475.
3665 BHKMJ=WTSPR*BHKMS(JLAT)+WTAUT*BHKMA(JLAT) 3476.
3666 CONCJ=WTSPR*CONCS(JLAT)+WTAUT*CONCA(JLAT) 3477.
3667 AO3JJ=AO3J 3478.
3668 IF(SKIPI) GO TO 400 3479.
3669 DO 300 I=1,IMLON 3480.
3670 ILONG=ILONIJ(I) 3481.
3671 JLONG=ILONG+1 3482.
3672 IF(JLONG.GT.18) JLONG=1 3483.
3673 WTJLG=WTJLON(I) 3484.
3674 WTILG=1.0-WTJLG 3485.
3675 AO3J=WTIM*(WTIL*(WTILG*O3AVE(IMO,ILATI,ILONG) 3486.
3676 + +WTJLG*O3AVE(IMO,ILATI,JLONG)) 3487.
3677 + +WTJL*(WTILG*O3AVE(IMO,JLATI,ILONG) 3488.
3678 + +WTJLG*O3AVE(IMO,JLATI,JLONG))) 3489.
3679 + +WTJM*(WTIL*(WTILG*O3AVE(JMO,ILATI,ILONG) 3490.
3680 + +WTJLG*O3AVE(JMO,ILATI,JLONG)) 3491.
3681 + +WTJL*(WTILG*O3AVE(JMO,JLATI,ILONG) 3492.
3682 + +WTJLG*O3AVE(JMO,JLATI,JLONG))) 3493.
3683 300 AO3JIM(I)=AO3J 3494.
3684 AO3J=AO3JJ 3495.
3685 C 3496.
3686 C-----------------------------------------------------------------------3497.
3687 ENTRY O3DLON 3498.
3688 C-----------------------------------------------------------------------3499.
3689 C 3500.
3690 IF(SKIPI) RETURN 3501.
3691 AO3J=AO3JJ+ABS((AO3JIM(ILON)-AO3JJ))*FLONO3 3502.
3692 C 3503.
3693 400 CKMJ=0.25*AO3J/CONCJ 3504.
3694 GTOP=0.0 3505.
3695 POI=0.0 3506.
3696 FI=0.0 3507.
3697 L=NL 3508.
3698 PLL=PLB0(L) 3509.
3699 J=12 3510.
3700 401 J=J-1 3511.
3701 IF(J.LT.1) GO TO 404 3512.
3702 POJ=PLBSO3(J) 3513.
3703 FJ=WTSEP*(WTLS*SO3SO(J,LSEP+1)+(1.-WTLS)*SO3SO(J,LSEP)) 3514.
3704 + +WTJAN*(WTLJ*SO3JF(J,LJAN+1)+(1.-WTLJ)*SO3JF(J,LJAN)) 3515.
3705 402 DP=POJ-POI 3516.
3706 IF(POJ.GT.PLL) GO TO 403 3517.
3707 GTOP=GTOP+(FI+FJ)*DP*ACMMGG 3518.
3708 POI=POJ 3519.
3709 FI=FJ 3520.
3710 GO TO 401 3521.
3711 403 FF=(FJ-FI)/DP 3522.
3712 DP=PLL-POI 3523.
3713 FF=FI+FF*DP 3524.
3714 GTOP=GTOP+(FI+FF)*DP*ACMMGG 3525.
3715 POI=PLL 3526.
3716 FI=FF 3527.
3717 O3LB(L)=GTOP 3528.
3718 L=L-1 3529.
3719 PLL=PLB0(L) 3530.
3720 GO TO 402 3531.
3721 404 FI=FJ*ACMPKM 3532.
3722 HI=H10MB 3533.
3723 HJ=BHKMJ+CKMJ 3534.
3724 XPBC=EXP(-BHKMJ/CKMJ) 3535.
3725 XPHC=EXP(HJ/CKMJ) 3536.
3726 DTERM=1.0+XPHC*XPBC 3537.
3727 ATERM=(1.0+XPBC)/DTERM 3538.
3728 FTERM=ATERM/DTERM*XPHC*XPBC/CKMJ 3539.
3729 TTERM=AO3J-GTOP-FI*(HI-HJ)*0.5 3540.
3730 AA=TTERM/(FTERM*(HI-HJ)*0.5+1.0-ATERM) 3541.
3731 FJ=AA*FTERM 3542.
3732 GTOPBC=GTOP+(FI+FJ)*(HI-HJ)*0.5-AA*ATERM 3543.
3733 TOP=AA*(1.0+XPBC) 3544.
3734 GO TO 406 3545.
3735 405 DH=HI-HJ 3546.
3736 FF=(FJ-FI)/DH 3547.
3737 DH=HI-H 3548.
3738 FF=FI+FF*DH 3549.
3739 GTOP=GTOP+(FI+FF)*DH*0.5 3550.
3740 HI=H 3551.
3741 FI=FF 3552.
3742 O3LB(L)=GTOP 3553.
3743 L=L-1 3554.
3744 406 CONTINUE 3555.
3745 H=HLB(L) 3556.
3746 IF(H.GT.HJ) GO TO 405 3557.
3747 O3LB(L)=TOP/(1.+XPBC*EXP(H/CKMJ))+GTOPBC 3558.
3748 L=L-1 3559.
3749 IF(L.GT.0) GO TO 406 3560.
3750 O3LB(NLP)=0. 3561.
3751 DO 407 L=1,NL 3562.
3752 407 U0GAS(L,3)=(O3LB(L)-O3LB(L+1)) 3563.
3753 RETURN 3564.
3754 END 3565.
3755 BLOCK DATA 3566.
3756
3757 #include "B83XX.COM"
3758
3759 C-----------------------------------------------------------------------3597.
3760 C SEASONAL ALBEDOS FOR 11 VEGETATION TYPES 3598.
3761 C-----------------------------------------------------------------------3599.
3762 C 3600.
3763 EQUIVALENCE 3601.
3764 + (VADATA(1,1,1),ALVISK(1,1)),(VADATA(1,1,2),ALNIRK(1,1)) 3602.
3765 +, (VADATA(1,1,3),FIELDC(1,1)),(VADATA(1,4,3),VTMASK(1)) 3603.
3766 C$$ + (VADATA(1,1,1),ALMEAN(1,1)),(VADATA(1,1,2),RATIRV(1,1)) 3604.
3767 C$$ +, (VADATA(1,1,3),VTMASK(1)),(VADATA(1,2,3),FIELDC(1,1)) 3605.
3768 C 3606.
3769 EQUIVALENCE 3607.
3770 + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 3608.
3771 +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 3609.
3772 +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 3610.
3773 +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 3611.
3774 +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 3612.
3775 +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 3613.
3776 C 3614.
3777 EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 3615.
3778 EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 3616.
3779 C 3617.
3780 EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 3618.
3781 EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 3619.
3782 C 3620.
3783 EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 3621.
3784 + ,(FRC(4), FCLO),(FRC(5), FCOV) 3622.
3785 C 3623.
3786 DIMENSION ALVISK(11,4),ALNIRK(11,4) 3624.
3787 C$$ DIMENSION ALMEAN(11,4),RATIRV(11,4) 3625.
3788 DIMENSION FIELDC(11,3),VTMASK(11) 3626.
3789 C 3627.
3790 C 1 2 3 4 3628.
3791 C WINTER SPRING SUMMER AUTUMN 3629.
3792 C 3630.
3793 DATA ALVISK/ 3631.
3794 C 1 2 3 4 5 6 7 8 9 10 11 3632.
3795 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3633.
3796 1 .350, .067, .089, .089, .078, .100, .067, .061, .100, .070, .001,3634.
3797 2 .350, .063, .100, .100, .073, .055, .067, .061, .100, .070, .001,3635.
3798 3 .350, .085, .091, .139, .085, .058, .083, .061, .100, .070, .001,3636.
3799 4 .350, .080, .090, .111, .064, .055, .061, .061, .100, .070, .001/3637.
3800 C 3638.
3801 DATA ALNIRK/ 3639.
3802 C 1 2 3 4 5 6 7 8 9 10 11 3640.
3803 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3641.
3804 1 .350, .200, .267, .267, .233, .300, .200, .183, .100, .070, .001,3642.
3805 2 .350, .206, .350, .300, .241, .218, .200, .183, .100, .070, .001,3643.
3806 3 .350, .298, .364, .417, .298, .288, .250, .183, .100, .070, .001,3644.
3807 4 .350, .255, .315, .333, .204, .218, .183, .183, .100, .070, .001/3645.
3808 C 3646.
3809 C$$ DATA ALMEAN/ 3647.
3810 C 1 2 3 4 5 6 7 8 9 10 11 3648.
3811 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3649.
3812 C$$ 1 .350, .120, .160, .160, .140, .180, .120, .110, .100, .070, .001,3650.
3813 C$$ 2 .350, .120, .200, .180, .140, .120, .120, .110, .100, .070, .001,3651.
3814 C$$ 3 .350, .170, .200, .250, .170, .150, .150, .110, .100, .070, .001,3652.
3815 C$$ 4 .350, .150, .180, .200, .120, .120, .110, .110, .100, .070, .001/3653.
3816 C 3654.
3817 C$$ DATA RATIRV/ 3655.
3818 C 1 2 3 4 5 6 7 8 9 10 11 3656.
3819 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3657.
3820 C$$ 1 1.00, 3.00, 3.00, 3.00, 3.00, 3.00, 3.00, 3.00, 1.00, 3.50, 1.50,3658.
3821 C$$ 2 1.00, 3.30, 3.50, 3.00, 3.30, 4.00, 3.00, 3.00, 1.00, 3.50, 1.50,3659.
3822 C$$ 3 1.00, 3.50, 4.00, 3.00, 3.50, 5.00, 3.00, 3.00, 1.00, 3.50, 1.50,3660.
3823 C$$ 4 1.00, 3.20, 3.50, 3.00, 3.20, 4.00, 3.00, 3.00, 1.00, 3.50, 1.50/3661.
3824 C 3662.
3825 DATA FIELDC/ 3663.
3826 C (KG/M**2) 3664.
3827 C 1 2 3 4 5 6 7 8 9 10 11 3665.
3828 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3666.
3829 1 10.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 200., 10.0, 30.0, 999.,3667.
3830 2 10.0, 200., 200., 300., 300., 450., 450., 450., 10.0, 200., 999.,3668.
3831 3 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0/3669.
3832 C 3670.
3833 DATA VTMASK/ 3671.
3834 C (KG/M**2) 3672.
3835 C 1 2 3 4 5 6 7 8 9 10 11 3673.
3836 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3674.
3837 4 10.0, 20.0, 20.0, 50.0, 200., 500.,1000.,2500., 10.0, 30.0, .001/3676.
3838 C 3677.
3839 C 3678.
3840 DATA DLAT/ 3679.
3841 +-90.000000,-82.173913,-74.347826,-66.521739,-58.695652,-50.869565,3680.
3842 +-43.043478,-35.217391,-27.391304,-19.565217,-11.739130,- 3.913043,3681.
3843 + 3.913043, 11.739130, 19.565217, 27.391304, 35.217391, 43.043478,3682.
3844 + 50.869565, 58.695652, 66.521739, 74.347826, 82.173913, 90.000000,3683.
3845 + 22*0.0000/ 3684.
3846 C 3685.
3847 DATA DLON/ 3686.
3848 + 0.0, 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0, 3687.
3849 + 90.0, 100.0, 110.0, 120.0, 130.0, 140.0, 150.0, 160.0, 170.0, 3688.
3850 + 180.0, 190.0, 200.0, 210.0, 220.0, 230.0, 240.0, 250.0, 260.0, 3689.
3851 + 270.0, 280.0, 290.0, 300.0, 310.0, 320.0, 330.0, 340.0, 350.0, 3690.
3852 +36*0.0/ 3691.
3853 C 3692.
3854 C-----------------------------------------------------------------------3693.
3855 C TRACE GAS REFERENCE AMOUNTS & DISTRIBUTIONS ARE DEFINED IN SETGAS3694.
3856 C-----------------------------------------------------------------------3695.
3857 C 3696.
3858 C 3697.
3859 C H2O CO2 O3 O2 NO2 N2O CH4 F11 F12 3698.
3860 C 1 2 3 4 5 6 7 8 9 3699.
3861 DATA FULGAS/ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 3700.
3862 + , 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0/ 3701.
3863 C 3702.
3864 C GLOBAL OCEAN LAND DESERT HAZE TR1 TR2 TR3 TR4 3703.
3865 C 1 2 3 4 5 6 7 8 9 3704.
3866 C 3705.
3867 DATA FGOLDH/ 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0 3706.
3868 + , 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0/ 3707.
3869 C 3708.
3870 DATA LASTVC/-123456/, KFORCE/-123456789/ 3709.
3871 C 3710.
3872 C 3711.
3873 DATA TAUMIN/1.0E-04/, TLGRAD/ 1.0/, EOCTRA/1.0/, ZOCSRA/1.0/ 3712.
3874 DATA FRACSL/1.0E-02/, TKCICE/258./, ESNTRA/1.0/, ZSNSRA/1.0/ 3713.
3875 DATA RATQSL/1.0 /, FLONO3/ 0.0/, EICTRA/1.0/, ZICSRA/1.0/ 3714.
3876 DATA FOGTSL/0.0 /, ECLTRA/1.00/, EDSTRA/1.0/, ZDSSRA/1.0/ 3715.
3877 DATA PTLISO/2.5E+00/, ZCLSRA/1.00/, EVGTRA/1.0/, ZVGSRA/1.0/ 3716.
3878 C 3717.
3879 DATA FMARCL/0.50/, FCLDTR/1.0/, NTRACE/0/, IDPROG/0/ 3718.
3880 DATA WETTRA/1.00/, FCLDSR/1.0/, ITR(1)/0/, ID2TRD/0/ 3719.
3881 DATA WETSRA/1.00/, FALGAE/1.0/, ITR(2)/0/, ID3SRD/0/ 3720.
3882 DATA DMOICE/10.0/, FRAYLE/1.0/, ITR(3)/0/, ID4VEG/0/ 3721.
3883 DATA DMLICE/10.0/, LICETK/ 0/, ITR(4)/0/, ID5FOR/0/ 3722.
3884 C 3723.
3885 DATA NV/ 8/ 3724.
3886 DATA IMGAS1/1/, KEEPRH/0/, KGASSR/0/, LAYRAD/ 3/ 3725.
3887 DATA IMGAS2/3/, KEEPAL/0/, KAERSR/0/, NL/12/ 3726.
3888 DATA ILGAS1/2/, ISOSCT/0/, KFRACC/0/, NLP/13/ 3727.
3889 DATA ILGAS2/9/, IHGSCT/0/, MARCLD/0/, JMLAT/24/ 3728.
3890 DATA KWVCON/1/, LAPGAS/1/, NORMS0/1/, IMLON/36/ 3729.
3891 C 3730.
3892 DATA JYEAR/1958/, JLAT/18/, S0/1367.0/ 3731.
3893 DATA JDAY/ 0/, ILON/18/, COSZ/0.5000/ 3732.
3894 C 3733.
3895 DATA POCEAN/0.700/, TGO/288.15/, AGESN/1.00/, WMAG/2.00/ 3734.
3896 DATA PEARTH/0.100/, TGE/288.15/, SNOWE/0.30/, WEARTH/0.00/ 3735.
3897 DATA POICE/0.100/, TGOI/288.15/, SNOWOI/0.10/, ZOICE/10.0/ 3736.
3898 DATA PLICE/0.100/, TGLI/288.15/, SNOWLI/0.20/, FRACCC/0.00/ 3737.
3899 DATA TSL/288.15/ 3738.
3900 C 3739.
3901 DATA PLB/ 3740.
3902 + 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 3741.
3903 + 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 3742.
3904 + 1.E-05, 27*0.00/ 3743.
3905 C 3744.
3906 DATA HLB/ 3745.
3907 + 1.E-10,1.0,2.0,3.0,6.0,11.0,20.0,32.0,47.0,51.0,71.0 3746.
3908 + ,84.852,99.99,27*99.999/ 3747.
3909 C 3748.
3910 DATA TLB/40*250./ 3749.
3911 DATA TLT/40*250./ 3750.
3912 DATA TLM/40*250./ 3751.
3913 C 3752.
3914 DATA U0GAS/360*0./ 3753.
3915 DATA ULGAS/360*0./ 3754.
3916 C 3755.
3917 DATA TRACER/160*0./ 3756.
3918 DATA CLDTAU/ 40*0./ 3757.
3919 C 3758.
3920 DATA SHL/40*0./ 3759.
3921 DATA RHL/40*0./ 3760.
3922 C 3761.
3923 DATA PVT/8*0.125,3*0.0/ 3762.
3924 C 3763.
3925 DATA SRBXAL/30*0./ 3764.
3926 DATA BXA/153*0./ 3765.
3927 C 3766.
3928 DATA LUXGAS/1/ 3767.
3929 DATA KALVIS/0/ 3768.
3930 DATA MEANAL/0/ 3769.
3931 C 3770.
3932 C-----------------------------------------------------------------------3771.
3933 C AEROSOL RADIATIVE PROPERTIES,COMPOSITION,TYPE & VERTICAL DISTRIBUTION3772.
3934 C-----------------------------------------------------------------------3773.
3935 C 3774.
3936 C BLOCKD INITIALIZED DEFAULT DATA 3775.
3937 C 3776.
3938 C 3785.
3939 DIMENSION QACID1(25),QACID2(25),QSLFT1(25),QSLFT2(25) 3786.
3940 T ,QBSLT1(25),QBSLT2(25),QSSALT(25),QDUST1(25) 3787.
3941 T ,QDUST2(25),QCARB1(25),QCARB2(25) 3788.
3942 T ,SACID1(25),SACID2(25),SSLFT1(25),SSLFT2(25) 3789.
3943 T ,SBSLT1(25),SBSLT2(25),SSSALT(25),SDUST1(25) 3790.
3944 T ,SDUST2(25),SCARB1(25),SCARB2(25) 3791.
3945 T ,CACID1(25),CACID2(25),CSLFT1(25),CSLFT2(25) 3792.
3946 T ,CBSLT1(25),CBSLT2(25),CSSALT(25),CDUST1(25) 3793.
3947 T ,CDUST2(25),CCARB1(25),CCARB2(25) 3794.
3948 T ,QWATER(25),QICE25(25),SWATER(25),SICE25(25) 3795.
3949 T ,CWATER(25),CICE25(25) 3796.
3950 C 3797.
3951 S ,XACID1(6),XACID2(6),XSLFT1(6),XSLFT2(6),XBSLT1(6),XBSLT2(6)3798.
3952 S ,XSSALT(6),XDUST1(6),XDUST2(6),XCARB1(6),XCARB2(6) 3799.
3953 S ,YACID1(6),YACID2(6),YSLFT1(6),YSLFT2(6),YBSLT1(6),YBSLT2(6)3800.
3954 S ,YSSALT(6),YDUST1(6),YDUST2(6),YCARB1(6),YCARB2(6) 3801.
3955 S ,ZACID1(6),ZACID2(6),ZSLFT1(6),ZSLFT2(6),ZBSLT1(6),ZBSLT2(6)3802.
3956 S ,ZSSALT(6),ZDUST1(6),ZDUST2(6),ZCARB1(6),ZCARB2(6) 3803.
3957 S ,XWATER(6),XICE25(6),YWATER(6),YICE25(6),ZWATER(6),ZICE25(6)3804.
3958 C 3805.
3959 EQUIVALENCE (TRAQEX(1, 1),QACID1(1)),(TRAQEX(1, 2),QACID2(1)) 3806.
3960 1 ,(TRAQEX(1, 3),QSLFT1(1)),(TRAQEX(1, 4),QSLFT2(1)) 3807.
3961 2 ,(TRAQEX(1, 5),QBSLT1(1)),(TRAQEX(1, 6),QBSLT2(1)) 3808.
3962 3 ,(TRAQEX(1, 7),QSSALT(1)),(TRAQEX(1, 8),QDUST1(1)) 3809.
3963 4 ,(TRAQEX(1, 9),QDUST2(1)),(TRAQEX(1,10),QCARB1(1)) 3810.
3964 5 ,(TRAQEX(1,11),QCARB2(1)) 3811.
3965 C 3812.
3966 EQUIVALENCE (TRAQSC(1, 1),SACID1(1)),(TRAQSC(1, 2),SACID2(1)) 3813.
3967 1 ,(TRAQSC(1, 3),SSLFT1(1)),(TRAQSC(1, 4),SSLFT2(1)) 3814.
3968 2 ,(TRAQSC(1, 5),SBSLT1(1)),(TRAQSC(1, 6),SBSLT2(1)) 3815.
3969 3 ,(TRAQSC(1, 7),SSSALT(1)),(TRAQSC(1, 8),SDUST1(1)) 3816.
3970 4 ,(TRAQSC(1, 9),SDUST2(1)),(TRAQSC(1,10),SCARB1(1)) 3817.
3971 5 ,(TRAQSC(1,11),SCARB2(1)) 3818.
3972 C 3819.
3973 EQUIVALENCE (TRACOS(1, 1),CACID1(1)),(TRACOS(1, 2),CACID2(1)) 3820.
3974 1 ,(TRACOS(1, 3),CSLFT1(1)),(TRACOS(1, 4),CSLFT2(1)) 3821.
3975 2 ,(TRACOS(1, 5),CBSLT1(1)),(TRACOS(1, 6),CBSLT2(1)) 3822.
3976 3 ,(TRACOS(1, 7),CSSALT(1)),(TRACOS(1, 8),CDUST1(1)) 3823.
3977 4 ,(TRACOS(1, 9),CDUST2(1)),(TRACOS(1,10),CCARB1(1)) 3824.
3978 5 ,(TRACOS(1,11),CCARB2(1)) 3825.
3979 C 3826.
3980 EQUIVALENCE (TRCQEX(1, 1),QWATER(1)),(TRCQEX(1, 2),QICE25(1)) 3827.
3981 EQUIVALENCE (TRCQSC(1, 1),SWATER(1)),(TRCQSC(1, 2),SICE25(1)) 3828.
3982 EQUIVALENCE (TRCCOS(1, 1),CWATER(1)),(TRCCOS(1, 2),CICE25(1)) 3829.
3983 3830.
3984 C 3831.
3985 EQUIVALENCE (SRAQEX(1, 1),XACID1(1)),(SRAQEX(1, 2),XACID2(1)) 3832.
3986 1 ,(SRAQEX(1, 3),XSLFT1(1)),(SRAQEX(1, 4),XSLFT2(1)) 3833.
3987 2 ,(SRAQEX(1, 5),XBSLT1(1)),(SRAQEX(1, 6),XBSLT2(1)) 3834.
3988 3 ,(SRAQEX(1, 7),XSSALT(1)),(SRAQEX(1, 8),XDUST1(1)) 3835.
3989 4 ,(SRAQEX(1, 9),XDUST2(1)),(SRAQEX(1,10),XCARB1(1)) 3836.
3990 5 ,(SRAQEX(1,11),XCARB2(1)) 3837.
3991 C 3838.
3992 EQUIVALENCE (SRAQSC(1, 1),YACID1(1)),(SRAQSC(1, 2),YACID2(1)) 3839.
3993 1 ,(SRAQSC(1, 3),YSLFT1(1)),(SRAQSC(1, 4),YSLFT2(1)) 3840.
3994 2 ,(SRAQSC(1, 5),YBSLT1(1)),(SRAQSC(1, 6),YBSLT2(1)) 3841.
3995 3 ,(SRAQSC(1, 7),YSSALT(1)),(SRAQSC(1, 8),YDUST1(1)) 3842.
3996 4 ,(SRAQSC(1, 9),YDUST2(1)),(SRAQSC(1,10),YCARB1(1)) 3843.
3997 5 ,(SRAQSC(1,11),YCARB2(1)) 3844.
3998 C 3845.
3999 EQUIVALENCE (SRACOS(1, 1),ZACID1(1)),(SRACOS(1, 2),ZACID2(1)) 3846.
4000 1 ,(SRACOS(1, 3),ZSLFT1(1)),(SRACOS(1, 4),ZSLFT2(1)) 3847.
4001 2 ,(SRACOS(1, 5),ZBSLT1(1)),(SRACOS(1, 6),ZBSLT2(1)) 3848.
4002 3 ,(SRACOS(1, 7),ZSSALT(1)),(SRACOS(1, 8),ZDUST1(1)) 3849.
4003 4 ,(SRACOS(1, 9),ZDUST2(1)),(SRACOS(1,10),ZCARB1(1)) 3850.
4004 5 ,(SRACOS(1,11),ZCARB2(1)) 3851.
4005 C 3852.
4006 EQUIVALENCE (SRCQEX(1, 1),XWATER(1)),(SRCQEX(1, 2),XICE25(1)) 3853.
4007 EQUIVALENCE (SRCQSC(1, 1),YWATER(1)),(SRCQSC(1, 2),YICE25(1)) 3854.
4008 EQUIVALENCE (SRCCOS(1, 1),ZWATER(1)),(SRCCOS(1, 2),ZICE25(1)) 3855.
4009 3856.
4010 C 3857.
4011 DATA NGOLDH/5/,NAERO/11/ 3858.
4012 C 3859.
4013 C-----------------------------------------------------------------------3860.
4014 C COMPOSITION & VERTICAL DISTRIBUTION FOR 5 SPECIFIED AEROSOL TYPES3861.
4015 C-----------------------------------------------------------------------3862.
4016 C TYPE 3863.
4017 C 1 STRATOSPHERIC GLOBAL AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3864.
4018 C 2 TROPOSPHERIC OCEAN AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3865.
4019 C 3 TROPOSPHERIC LAND AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3866.
4020 C 4 TROPOSPHERIC DESERT AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3867.
4021 C 5 TROPOSPHERIC HAZE AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3868.
4022 C 3869.
4023 C 1 2 3 4 5 6 7 8 9 10 11 3870.
4024 C ACID1 OCT82 SLFT1 SLFT2 BSLT1 BSLT2 SSALT DUST1 DUST2 MAY82 CARB23871.
4025 DATA AGOLDH/ 3872.
4026 1 .012, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3873.
4027 2 .0, .0, .018, .033, .012, .023, .011, .0, .0, .0, .0,3874.
4028 3 .0, .0, .031, .057, .021, .042, .0, .0, .0, .0, .018,3875.
4029 4 .0, .0, .0, .0, .0, .0, .0, .300, .300, .0, .0,3876.
4030 5 .0, .250, .0, .0, .0, .0, .0, .300, .0, .0, .0/3877.
4031 DATA BGOLDH/ 3878.
4032 1 20.0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3879.
4033 2 .0, .0, 4.00, 0.00, 4.00, 1.00, 0.00, .0, .0, .0, .0,3880.
4034 3 .0, .0, 4.00, 0.00, 4.00, 0.00, .0, .0, .0, .0, 0.00,3881.
4035 4 .0, .0, .0, .0, .0, .0, .0, 3.50, 0.00, .0, .0,3882.
4036 5 .0, 0.00, .0, .0, .0, .0, .0, 3.50, .0, .0, .0/3883.
4037 DATA CGOLDH/ 3884.
4038 1 3.00, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3885.
4039 2 .0, .0, 3.00, 1.00, 3.00, 0.5, 1.00, .0, .0, .0, .0,3886.
4040 3 .0, .0, 3.00, 1.00, 3.00, 1.00, .0, .0, .0, .0, 1.00,3887.
4041 4 .0, .0, .0, .0, .0, .0, .0, 1.00, 1.00, .0, .0,3888.
4042 5 .0, 1.00, .0, .0, .0, .0, .0, 1.00, .0, .0, .0/3889.
4043 C 3890.
4044 C-----------------------------------------------------------------------3891.
4045 C THERMAL RADIATION 25 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB3892.
4046 C-----------------------------------------------------------------------3893.
4047 DATA QACID1/ 3894.
4048 + 0.04052,0.05895,0.08506,0.06673,0.05160,0.04437,0.03864, 3895.
4049 + 0.02719,0.01668,0.01146,0.00705,0.03286,0.02449,0.03017, 3896.
4050 + 0.03198,0.02891,0.02634,0.02366,0.02300,0.02271,0.02159, 3897.
4051 + 0.08516,0.08825,0.08982,0.09284/ 3898.
4052 DATA SACID1/ 3899.
4053 + 0.00095,0.00361,0.00273,0.00226,0.00150,0.00141,0.00131, 3900.
4054 + 0.00090,0.00049,0.00029,0.00014,0.00072,0.00049,0.00031, 3901.
4055 + 0.00023,0.00023,0.00022,0.00020,0.00019,0.00018,0.00018, 3902.
4056 + 0.00183,0.00201,0.00205,0.00207/ 3903.
4057 DATA CACID1/ 3904.
4058 + 0.11030,0.17256,0.17138,0.19696,0.19510,0.18945,0.18874, 3905.
4059 + 0.18795,0.18313,0.17814,0.17075,0.10583,0.09756,0.08388, 3906.
4060 + 0.07246,0.07266,0.07099,0.06873,0.06754,0.06661,0.06674, 3907.
4061 + 0.11197,0.11068,0.10998,0.10852/ 3908.
4062 C 3909.
4063 DATA QACID2/ 3910.
4064 + 0.05764,0.15189,0.06264,0.04527,0.03973,0.03646,0.03375, 3911.
4065 + 0.02163,0.01337,0.00979,0.00724,0.04076,0.03631,0.04273, 3912.
4066 + 0.04072,0.03752,0.03290,0.03012,0.02968,0.02914,0.02763, 3913.
4067 + 0.10731,0.12510,0.12901,0.13232/ 3914.
4068 DATA SACID2/ 3915.
4069 + 0.00367,0.00752,0.00264,0.00172,0.00188,0.00221,0.00225, 3916.
4070 + 0.00134,0.00066,0.00034,0.00012,0.00237,0.00121,0.00084, 3917.
4071 + 0.00080,0.00081,0.00074,0.00069,0.00067,0.00065,0.00064, 3918.
4072 + 0.00674,0.00807,0.00825,0.00837/ 3919.
4073 DATA CACID2/ 3920.
4074 + 0.05720,0.11171,0.11850,0.11443,0.12325,0.13171,0.13500, 3921.
4075 + 0.13575,0.13419,0.12666,0.10961,0.05186,0.04026,0.03219, 3922.
4076 + 0.03060,0.03105,0.03041,0.02959,0.02911,0.02884,0.02901, 3923.
4077 + 0.07145,0.07168,0.07134,0.07096/ 3924.
4078 C 3925.
4079 DATA QSLFT1/ 3926.
4080 + 0.15555,0.16333,0.16406,0.16396,0.16070,0.14074,0.11920, 3927.
4081 + 0.09140,0.07341,0.06645,0.05871,0.15301,0.13456,0.15809, 3928.
4082 + 0.16264,0.14805,0.12798,0.10588,0.09960,0.09604,0.08844, 3929.
4083 + 0.35895,0.27430,0.26964,0.27183/ 3930.
4084 DATA SSLFT1/ 3931.
4085 + 0.13162,0.13152,0.11642,0.12932,0.10550,0.08323,0.07081, 3932.
4086 + 0.05079,0.03287,0.02458,0.01871,0.12787,0.11183,0.09490, 3933.
4087 + 0.08739,0.08716,0.08022,0.07182,0.06899,0.06700,0.06496, 3934.
4088 + 0.13067,0.12933,0.12878,0.12808/ 3935.
4089 DATA CSLFT1/ 3936.
4090 + 0.52508,0.48102,0.59654,0.66259,0.66566,0.70224,0.71546, 3937.
4091 + 0.69308,0.62819,0.55963,0.45811,0.52840,0.54500,0.51620, 3938.
4092 + 0.50685,0.52475,0.54985,0.58351,0.59484,0.60203,0.61652, 3939.
4093 + 0.45926,0.47060,0.47243,0.47178/ 3940.
4094 C 3941.
4095 DATA QSLFT2/ 3942.
4096 + 0.44109,0.37065,0.38095,0.40554,0.37738,0.32564,0.27970, 3943.
4097 + 0.21687,0.17752,0.16154,0.14952,0.43239,0.38517,0.39512, 3944.
4098 + 0.39098,0.36978,0.32960,0.28406,0.27042,0.26204,0.24771, 3945.
4099 + 0.63665,0.59084,0.58844,0.59078/ 3946.
4100 DATA SSLFT2/ 3947.
4101 + 0.37818,0.31549,0.29505,0.33810,0.28074,0.22692,0.19562, 3948.
4102 + 0.14289,0.09653,0.07449,0.06008,0.36685,0.33089,0.28296, 3949.
4103 + 0.26185,0.26286,0.24369,0.22019,0.21220,0.20647,0.20093, 3950.
4104 + 0.31870,0.30963,0.30762,0.30507/ 3951.
4105 DATA CSLFT2/ 3952.
4106 + 0.54586,0.50074,0.62826,0.69007,0.69596,0.73443,0.74600, 3953.
4107 + 0.71846,0.64430,0.57291,0.47311,0.54977,0.56612,0.53939, 3954.
4108 + 0.53105,0.54799,0.57221,0.60426,0.61497,0.62179,0.63518, 3955.
4109 + 0.51454,0.52095,0.52268,0.52316/ 3956.
4110 C 3957.
4111 DATA QBSLT1/ 3958.
4112 + 0.19787,0.15206,0.14808,0.15505,0.14132,0.12508,0.10931, 3959.
4113 + 0.07946,0.05659,0.04675,0.03801,0.20081,0.15823,0.15732, 3960.
4114 + 0.15377,0.14273,0.13163,0.12005,0.11684,0.11523,0.11121, 3961.
4115 + 0.36601,0.39099,0.39240,0.39274/ 3962.
4116 DATA SBSLT1/ 3963.
4117 + 0.09892,0.12369,0.09780,0.11017,0.08914,0.08577,0.07794, 3964.
4118 + 0.05688,0.03912,0.03069,0.02440,0.09492,0.08277,0.05817, 3965.
4119 + 0.04773,0.04970,0.04568,0.04058,0.03865,0.03717,0.03641, 3966.
4120 + 0.07710,0.08232,0.08235,0.08163/ 3967.
4121 DATA CBSLT1/ 3968.
4122 + 0.54090,0.49369,0.59375,0.67539,0.69444,0.71623,0.71674, 3969.
4123 + 0.69425,0.63125,0.57379,0.48766,0.54072,0.57272,0.57215, 3970.
4124 + 0.57655,0.59243,0.60616,0.62323,0.62911,0.63253,0.63934, 3971.
4125 + 0.51632,0.50380,0.50414,0.50666/ 3972.
4126 C 3973.
4127 DATA QBSLT2/ 3974.
4128 + 0.49004,0.35700,0.34009,0.38146,0.35476,0.32874,0.29258, 3975.
4129 + 0.21726,0.16067,0.13571,0.11451,0.48169,0.40550,0.37263, 3976.
4130 + 0.35312,0.33842,0.31466,0.28850,0.28051,0.27574,0.26813, 3977.
4131 + 0.59495,0.63654,0.63850,0.63742/ 3978.
4132 DATA SBSLT2/ 3979.
4133 + 0.26833,0.30862,0.25309,0.29334,0.24644,0.24238,0.22164, 3980.
4134 + 0.16459,0.11742,0.09480,0.07809,0.26006,0.23936,0.17265, 3981.
4135 + 0.14418,0.15103,0.13960,0.12488,0.11925,0.11488,0.11275, 3982.
4136 + 0.19766,0.20963,0.20969,0.20807/ 3983.
4137 DATA CBSLT2/ 3984.
4138 + 0.57850,0.51330,0.62334,0.70306,0.72063,0.74166,0.74111, 3985.
4139 + 0.71466,0.64442,0.58410,0.49911,0.58174,0.60690,0.60535, 3986.
4140 + 0.60954,0.62353,0.63716,0.65423,0.66019,0.66381,0.67030, 3987.
4141 + 0.58670,0.57707,0.57759,0.58014/ 3988.
4142 C 3989.
4143 DATA QSSALT/ 3990.
4144 + 0.27651,0.36950,0.40122,0.39669,0.34286,0.33458,0.29978, 3991.
4145 + 0.26075,0.26470,0.26660,0.28507,0.27114,0.23752,0.18761, 3992.
4146 + 0.16890,0.17532,0.17705,0.17827,0.17801,0.17743,0.17914, 3993.
4147 + 0.34241,0.33620,0.33607,0.33681/ 3994.
4148 DATA SSSALT/ 3995.
4149 + 0.27651,0.36950,0.40121,0.39659,0.34226,0.33245,0.29555, 3996.
4150 + 0.22360,0.16290,0.13425,0.11177,0.27114,0.23751,0.18755, 3997.
4151 + 0.16883,0.17526,0.17700,0.17823,0.17797,0.17739,0.17911, 3998.
4152 + 0.34241,0.33620,0.33607,0.33681/ 3999.
4153 DATA CSSALT/ 4000.
4154 + 0.66858,0.50298,0.60372,0.65282,0.66694,0.67041,0.66666, 4001.
4155 + 0.62258,0.52248,0.44732,0.32878,0.66866,0.66680,0.66404, 4002.
4156 + 0.66252,0.66281,0.66265,0.66244,0.66232,0.66223,0.66226, 4003.
4157 + 0.67338,0.67406,0.67410,0.67408/ 4004.
4158 C 4005.
4159 DATA QDUST1/ 4006.
4160 + 0.60958,0.65996,0.59890,0.73030,0.64827,0.55835,0.48157, 4007.
4161 + 0.34847,0.23144,0.18097,0.13460,0.59012,0.47533,0.39938, 4008.
4162 + 0.36575,0.35808,0.33834,0.31587,0.30849,0.30369,0.29821, 4009.
4163 + 0.91360,1.14613,1.16193,1.16619/ 4010.
4164 DATA SDUST1/ 4011.
4165 + 0.32015,0.60541,0.49800,0.59591,0.46651,0.39745,0.34242, 4012.
4166 + 0.23468,0.13039,0.08473,0.04350,0.29084,0.23940,0.16410, 4013.
4167 + 0.13070,0.13267,0.12095,0.10691,0.10167,0.09788,0.09578, 4014.
4168 + 0.39128,0.54469,0.55555,0.55942/ 4015.
4169 DATA CDUST1/ 4016.
4170 + 0.50425,0.49645,0.57736,0.63615,0.63373,0.66224,0.67205, 4017.
4171 + 0.67034,0.65137,0.61767,0.53600,0.49640,0.47921,0.43825, 4018.
4172 + 0.40760,0.41364,0.41120,0.40706,0.40418,0.40149,0.40315, 4019.
4173 + 0.47280,0.39308,0.38801,0.38670/ 4020.
4174 C 4021.
4175 DATA QDUST2/ 4022.
4176 + 0.95483,0.71515,0.77676,0.91847,0.93699,0.89565,0.82979, 4023.
4177 + 0.74871,0.70959,0.69272,0.68748,0.94632,0.90846,0.85600, 4024.
4178 + 0.83350,0.83544,0.82317,0.80807,0.80270,0.79879,0.79577, 4025.
4179 + 1.02427,1.12417,1.13054,1.13169/ 4026.
4180 DATA SDUST2/ 4027.
4181 + 0.49885,0.58157,0.55165,0.64038,0.59140,0.55222,0.50136, 4028.
4182 + 0.42019,0.36087,0.33502,0.31667,0.49026,0.47989,0.42207, 4029.
4183 + 0.39751,0.40487,0.39774,0.38819,0.38426,0.38107,0.38027, 4030.
4184 + 0.49780,0.59147,0.59817,0.60013/ 4031.
4185 DATA CDUST2/ 4032.
4186 + 0.74352,0.54594,0.68229,0.72513,0.73598,0.75710,0.75041, 4033.
4187 + 0.70723,0.65024,0.61702,0.58021,0.74556,0.74741,0.75647, 4034.
4188 + 0.76384,0.76647,0.77599,0.78746,0.79136,0.79400,0.79700, 4035.
4189 + 0.71874,0.62817,0.62224,0.62062/ 4036.
4190 C 4037.
4191 DATA QCARB1/ 4038.
4192 + 0.44718,0.51882,0.26055,0.20526,0.19295,0.18655,0.17520, 4039.
4193 + 0.11120,0.06749,0.04893,0.03537,0.32912,0.25261,0.24973, 4040.
4194 + 0.23947,0.22883,0.20424,0.18781,0.18400,0.18032,0.17370, 4041.
4195 + 0.57200,0.64430,0.65267,0.65790/ 4042.
4196 DATA SCARB1/ 4043.
4197 + 0.17857,0.12659,0.06506,0.05088,0.05317,0.05712,0.05562, 4044.
4198 + 0.03310,0.01705,0.01009,0.00493,0.13908,0.08683,0.06332, 4045.
4199 + 0.06114,0.06260,0.05755,0.05319,0.05155,0.05032,0.04981, 4046.
4200 + 0.19594,0.21003,0.20967,0.20853/ 4047.
4201 DATA CCARB1/ 4048.
4202 + 0.40490,0.48729,0.43960,0.40824,0.46236,0.51422,0.53366, 4049.
4203 + 0.53211,0.51283,0.46211,0.32882,0.40923,0.35984,0.30817, 4050.
4204 + 0.30468,0.31306,0.31215,0.30857,0.30555,0.30388,0.30644, 4051.
4205 + 0.43102,0.40748,0.40436,0.40208/ 4052.
4206 C 4053.
4207 DATA QCARB2/ 4054.
4208 + 0.09591,0.22971,0.21603,0.21745,0.17928,0.17061,0.15202, 4055.
4209 + 0.10846,0.06721,0.04817,0.03076,0.09456,0.08428,0.07093, 4056.
4210 + 0.06589,0.06737,0.06766,0.06782,0.06771,0.06754,0.06792, 4057.
4211 + 0.12455,0.12130,0.12121,0.12155/ 4058.
4212 DATA SCARB2/ 4059.
4213 + 0.00748,0.06133,0.05031,0.04978,0.03714,0.03448,0.03065, 4060.
4214 + 0.02099,0.01137,0.00688,0.00291,0.00728,0.00544,0.00350, 4061.
4215 + 0.00276,0.00291,0.00290,0.00288,0.00285,0.00282,0.00286, 4062.
4216 + 0.01420,0.01327,0.01324,0.01332/ 4063.
4217 DATA CCARB2/ 4064.
4218 + 0.14117,0.25269,0.27090,0.30506,0.29845,0.28974,0.28880, 4065.
4219 + 0.28843,0.28603,0.28395,0.29112,0.14128,0.12741,0.11121, 4066.
4220 + 0.09892,0.09935,0.09786,0.09604,0.09517,0.09448,0.09466, 4067.
4221 + 0.18297,0.17686,0.17658,0.17696/ 4068.
4222 C 4069.
4223 DATA QWATER/ 4070.
4224 + 0.82334,0.89509,1.13254,1.20762,1.24075,1.18580,1.07585, 4071.
4225 + 0.95283,0.89542,0.86914,0.85864,0.87834,0.94021,1.03878, 4072.
4226 + 1.07876,1.06927,1.06987,1.07153,1.07327,1.07505,1.07280, 4073.
4227 + 1.20709,1.20194,1.20383,1.20978/ 4074.
4228 DATA SWATER/ 4075.
4229 + 0.34695,0.68566,0.86748,0.89010,0.83121,0.75556,0.65338, 4076.
4230 + 0.51441,0.40925,0.36469,0.31873,0.39396,0.39368,0.43707, 4077.
4231 + 0.45625,0.44997,0.45039,0.45146,0.45251,0.45357,0.45227, 4078.
4232 + 0.85537,0.85478,0.85718,0.86370/ 4079.
4233 DATA CWATER/ 4080.
4234 + 0.91848,0.65450,0.79206,0.82335,0.83709,0.84869,0.84338, 4081.
4235 + 0.77907,0.68419,0.62521,0.54076,0.91355,0.89224,0.85667, 4082.
4236 + 0.84557,0.85029,0.85229,0.85399,0.85411,0.85389,0.85524, 4083.
4237 + 0.91095,0.91472,0.91488,0.91467/ 4084.
4238 C 4085.
4239 DATA QICE25/ 4086.
4240 + 1.15210,0.81551,0.98885,1.10325,1.17652,1.14217,1.07777, 4087.
4241 + 1.08252,1.14496,1.16939,1.22006,1.16194,1.16781,1.19342, 4088.
4242 + 1.20279,1.19736,1.19435,1.19146,1.19097,1.19095,1.18924, 4089.
4243 + 1.19321,1.21794,1.21959,1.21942/ 4090.
4244 DATA SICE25/ 4091.
4245 + 0.57392,0.45452,0.57278,0.68806,0.74580,0.69171,0.64662, 4092.
4246 + 0.62884,0.64120,0.64892,0.66105,0.59403,0.60241,0.67853, 4093.
4247 + 0.70399,0.68299,0.66547,0.64731,0.64301,0.64122,0.63321, 4094.
4248 + 0.71867,0.77122,0.77524,0.77622/ 4095.
4249 DATA CICE25/ 4096.
4250 + 0.93634,0.72920,0.86084,0.88431,0.87489,0.88472,0.86613, 4097.
4251 + 0.82078,0.79850,0.79041,0.78539,0.93377,0.91036,0.85751, 4098.
4252 + 0.84228,0.85220,0.86089,0.87036,0.87263,0.87355,0.87810, 4099.
4253 + 0.94697,0.94840,0.94812,0.94714/ 4100.
4254 C 4101.
4255 C-----------------------------------------------------------------------4102.
4256 C SOLAR RADIATION 6 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB4103.
4257 C-----------------------------------------------------------------------4104.
4258 C 4105.
4259 DATA XACID1/ 0.05776,0.10033,0.19099,0.36614,0.55931,1.04703/ 4106.
4260 DATA YACID1/ 0.01880,0.09956,0.19090,0.36613,0.55931,1.04703/ 4107.
4261 DATA ZACID1/ 0.36054,0.51871,0.57276,0.62068,0.65273,0.68988/ 4108.
4262 C 4109.
4263 DATA XACID2/0.13360,0.33875,0.51498,0.68359,0.79939,0.94494/ 4110.
4264 DATA YACID2/0.07420,0.33691,0.51483,0.68358,0.79939,0.94494/ 4111.
4265 C$ DATA ZACID2/0.40248,0.62259,0.68524,0.71328,0.71195,0.72894/ 4112.
4266 DATA ZACID2/0.39821,0.54835,0.60846,0.63637,0.63503,0.65221/ 4112.1
4267 C 4113.
4268 DATA XSLFT1/ 0.31035,0.44757,0.54238,0.66756,0.78260,1.04454/ 4114.
4269 DATA YSLFT1/ 0.24589,0.44490,0.54224,0.66755,0.78260,1.04454/ 4115.
4270 DATA ZSLFT1/ 0.70591,0.67557,0.66832,0.66438,0.66199,0.66008/ 4116.
4271 C 4117.
4272 DATA XSLFT2/ 0.60959,0.74888,0.81124,0.87560,0.92632,1.00936/ 4118.
4273 DATA YSLFT2/ 0.50477,0.74262,0.81090,0.87556,0.92631,1.00935/ 4119.
4274 DATA ZSLFT2/ 0.74067,0.70281,0.69748,0.69922,0.70070,0.70754/ 4120.
4275 C 4121.
4276 DATA XBSLT1/ 0.30419,0.46195,0.54908,0.66403,0.77732,1.02644/ 4122.
4277 DATA YBSLT1/ 0.28732,0.44765,0.53358,0.64786,0.76063,1.00769/ 4123.
4278 DATA ZBSLT1/ 0.67768,0.66588,0.66785,0.66932,0.66671,0.66818/ 4124.
4279 C 4125.
4280 DATA XBSLT2/ 0.62145,0.76377,0.81783,0.87743,0.92782,1.00765/ 4126.
4281 DATA YBSLT2/ 0.58466,0.73120,0.78367,0.84258,0.89259,0.96944/ 4127.
4282 DATA ZBSLT2/ 0.70368,0.69767,0.70313,0.70847,0.70983,0.71935/ 4128.
4283 C 4129.
4284 DATA XSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00414/ 4130.
4285 DATA YSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00413/ 4131.
4286 DATA ZSSALT/ 0.67233,0.68272,0.68718,0.69084,0.69334,0.69627/ 4132.
4287 C 4133.
4288 DATA XDUST1/ 1.17571,1.20282,1.13894,1.08190,1.04572,0.99864/ 4134.
4289 DATA YDUST1/ 1.04642,1.12320,1.04442,0.97057,0.93288,0.78720/ 4135.
4290 DATA ZDUST1/ 0.72235,0.68164,0.69516,0.72361,0.74315,0.80409/ 4136.
4291 C 4137.
4292 DATA XDUST2/ 1.09335,1.12888,1.09512,1.05217,1.02411,1.00081/ 4138.
4293 DATA YDUST2/ 0.83740,0.93590,0.88162,0.81721,0.78602,0.68767/ 4139.
4294 DATA ZDUST2/ 0.78776,0.76447,0.77511,0.79364,0.80840,0.85594/ 4140.
4295 C 4141.
4296 DATA XCARB1/0.74444,1.11851,1.14599,1.09902,1.05179,1.00292/ 4142.
4297 DATA YCARB1/0.53412,1.11290,1.14544,1.09899,1.05179,1.00292/ 4143.
4298 C$ DATA ZCARB1/0.75767,0.74553,0.72950,0.71977,0.71968,0.74073/ 4144.
4299 DATA ZCARB1/0.71248,0.66984,0.65284,0.64292,0.64282,0.66426/ 4144.1
4300 C 4145.
4301 DATA XCARB2/ 0.54418,0.82500,0.91922,0.97919,1.00345,0.99476/ 4146.
4302 DATA YCARB2/ 0.19636,0.34820,0.40558,0.44719,0.46860,0.48132/ 4147.
4303 DATA ZCARB2/ 0.45878,0.59691,0.65112,0.70444,0.74341,0.79820/ 4148.
4304 C 4149.
4305 DATA XWATER/ 1.10372,1.05381,1.03792,1.02265,1.01285,0.99989/ 4150.
4306 DATA YWATER/ 0.84758,1.03190,1.02896,1.02226,1.01282,0.99988/ 4151.
4307 DATA ZWATER/ 0.87621,0.84587,0.84884,0.85323,0.85888,0.86321/ 4152.
4308 C 4153.
4309 DATA XICE25/ 1.05394,1.02884,1.02030,1.01257,1.00706,0.99981/ 4154.
4310 DATA YICE25/ 0.75677,0.96035,1.00797,1.01184,1.00702,0.99981/ 4155.
4311 DATA ZICE25/ 0.92708,0.88645,0.87975,0.87906,0.87391,0.87623/ 4156.
4312 C 4157.
4313 C-----------------------------------------------------------------------4158.
4314 C THERMAL RADIATION 25 K-INTERVAL MERGED CLOUD & SURFACE ALBEDO DATA 4159.
4315 C-----------------------------------------------------------------------4160.
4316 DATA AGSIDV/ 4161.
4317 S 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4162.
4318 S 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4163.
4319 S 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4164.
4320 S 0.01757,0.02022,0.02059,0.02082, 4165.
4321 I 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4166.
4322 I 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4167.
4323 I 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4168.
4324 I 0.01757,0.02022,0.02059,0.02082, 4169.
4325 D 0.04500,0.10414,0.06739,0.08448,0.08516,0.06283,0.05230, 4170.
4326 D 0.03382,0.01901,0.01542,0.01178,0.05142,0.04835,0.05505, 4171.
4327 D 0.05600,0.05310,0.04603,0.03731,0.03472,0.03328,0.03000, 4172.
4328 D 0.16159,0.17592,0.17812,0.17927, 4173.
4329 V 25*0.0/ 4174.
4330 DATA AOCEAN/ 4175.
4331 + 0.04000,0.05965,0.06124,0.08339,0.09235,0.09510,0.09908, 4176.
4332 + 0.11117,0.12263,0.12577,0.12931,0.04700,0.06894,0.08970, 4177.
4333 + 0.09574,0.09565,0.09619,0.09672,0.09703,0.09723,0.09700, 4178.
4334 + 0.04645,0.04487,0.04482,0.04493/ 4179.
4335 C 4180.
4336 DATA CLDALB/ 4181.
4337 + 0.01332,0.08190,0.07036,0.05082,0.04486,0.04673,0.04770, 4182.
4338 + 0.05130,0.05240,0.05251,0.05259,0.01558,0.01763,0.02410, 4183.
4339 + 0.02571,0.02514,0.02448,0.02366,0.02347,0.02340,0.02294, 4184.
4340 + 0.04566,0.04499,0.04518,0.04544, 4185.
4341 + 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4186.
4342 + 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4187.
4343 + 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4188.
4344 + 0.01757,0.02022,0.02059,0.02082/ 4189.
4345 C 4190.
4346 DATA ASNALB/0.600,0.350,13*0.0/ 4191.
4347 C&& DATA ASNALB/0.550,0.300,13*0.0/
4348 C 4192.
4349 C&& DATA AOIALB/0.550,0.300,13*0.0/ 4193.
4350 DATA AOIALB/0.600,0.350,13*0.0/
4351 C 4194.
4352 DATA ALIALB/0.600,0.350,13*0.0/ 4195.
4353 C 4196.
4354 C-----------------------------------------------------------------------4197.
4355 C TRACE GAS VERTICAL DISTRIBUTION & 1958 MEAN CONCENTRATION 4198.
4356 C-----------------------------------------------------------------------4199.
4357 C 4200.
4358 DATA CMANO2/ 4201.
4359 1 8.66E-06,5.15E-06,2.85E-06,1.50E-06,9.89E-07,6.91E-07,7.17E-07, 4202.
4360 2 8.96E-07,3.67E-06,4.85E-06,5.82E-06,6.72E-06,7.77E-06,8.63E-06, 4203.
4361 3 8.77E-06,8.14E-06,6.91E-06,5.45E-06,4.00E-06,2.67E-06,1.60E-06, 4204.
4362 4 8.36E-07,3.81E-07,1.58E-07,6.35E-08,2.57E-08,1.03E-08,4.18E-09, 4205.
4363 5 1.66E-09,6.57E-10,2.58E-10,1.02E-10,4.11E-11,1.71E-11,7.73E-12, 4206.
4364 6 9.07E-12,4.63E-12,2.66E-12,1.73E-12,1.28E-12,1.02E-12,1.00E-30/ 4207.
4365 C 4208.
4366 C 4209.
4367 C GAS NUMBER 1 2 3 4 5 6 7 8 9 4210.
4368 C H2O CO2 O3 O2 NO2 N2O CH4 CCL3F1 CCL2F2 4211.
4369 C DATA FULGAS/1.0, 1.0,1.0, 1.0,1.0, 1.0, 1.0, 1.0, 1.0/4212.
4370 c DATA PPMV58/0.0,315.0,0.0,210000.,0.0,0.295,1.400,8.00E-6,25.0E-6/4213.
4371 DATA PPMV58/0.0, 0.0,0.0,210000.,0.0,4*0.0/
4372 C$ DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0, 15.0, 10.0, 12.0, 12.0/4214.
4373 DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0,915.0,910.0, 12.0, 12.0/4215.
4374 DATA ZH/ 8.0, 8.0,8.0, 8.0,8.0, 10.0, 30.0, 3.0, 3.0/4216.
4375 C 4217.
4376 C-----------------------------------------------------------------------4218.
4377 C TRACE GAS ABSORPTION COEFFICIENTS FOR F11 & F12 4219.
4378 C-----------------------------------------------------------------------4220.
4379 C 4221.
4380 DIMENSION F11PCM(25),F12PCM(25) 4222.
4381 EQUIVALENCE (TRACEG(1,1),F11PCM(1)),(TRACEG(1,2),F12PCM(1)) 4223.
4382 C 4224.
4383 C 4225.
4384 DATA F11PCM/ 4226.
4385 + 13.6000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 4227.
4386 + 0.0000, 0.0000, 0.0000, 0.0000,11.9504, 2.5138, 0.5054, 4228.
4387 + 0.1086, 0.0308, 0.0178, 0.0054, 0.0000, 0.0000, 0.0000, 4229.
4388 + 2.5220, 1.1731, 0.8627, 0.7445/ 4230.
4389 C 4231.
4390 DATA F12PCM/ 4232.
4391 + 5.4900, 1.3339, 0.7739, 0.1304, 0.0286, 0.0051, 0.0000, 4233.
4392 + 0.0000, 0.0000, 0.0000, 0.0000, 9.0745, 2.3577, 0.4135, 4234.
4393 + 0.0575, 0.0000, 0.2507, 0.6215, 0.7262, 0.7972, 0.9150, 4235.
4394 + 13.1663, 1.1564, 0.0388, 0.0082/ 4236.
4395 C 4236.11
4396 C ------------------------------------------------------------------4236.12
4397 C DECEMBER 4, 1991 UPDATE PROVIDES FOR THE FOLLOWING IMPROVEMENTS:4236.13
4398 C ------------------------------------------------------------------4236.14
4399 C IF(NEWASZ.GT.0) ALL AEROSOL SOLAR ZENITH ANGLE DEPENDENCE IMPROVED4236.15
4400 C IF(NEWAQA.GT.0) ALL AERSOL THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.16
4401 C (TRACER AEROSOLS ALREADY USE Q-ABSORPTION IN XRAD83XX) 4236.17
4402 C IF(NEWCQA.GT.0) ALL CLOUDS THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.18
4403 C ------------------------------------------------------------------4236.21
4404 C 4236.22
4405 EQUIVALENCE (ISPARE(1),NEWASZ) 4236.23
4406 EQUIVALENCE (ISPARE(2),NEWAQA) 4236.24
4407 EQUIVALENCE (ISPARE(3),NEWCQA) 4236.25
4408 C 4236.26
4409 DATA NEWASZ/0/, NEWAQA/0/, NEWCQA/0/ 4236.27
4410 C 4236.28
4411 END 4237.
4412 SUBROUTINE PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 4238.
4413 C 4239.
4414 C ------------------------------------------------------------------4240.
4415 C ------------- MCCLATCHY (1972) ATMOSPHERE DATA -----------4241.
4416 C ------------------------------------------------------------------4242.
4417 C 4243.
4418 C INPUT DATA 4244.
4419 C------------------ 4245.
4420 C NATM=0 GIVES ABREVIATED DATA FOR STANDARD ATMOSPHER4246.
4421 C (INPUT: P OR H) (RETURNS: H OR P & D,T)4247.
4422 C 4248.
4423 C NATM=1 GIVES ATMOSPHERE DATA FOR TROPICAL LATITUDES4249.
4424 C NATM=2 GIVES ATMOSPHERE DATA FOR MIDLATITUDE SUMMER4250.
4425 C NATM=3 GIVES ATMOSPHERE DATA FOR MIDLATITUDE WINTER4251.
4426 C NATM=4 GIVES ATMOSPHERE DATA FOR SUBARCTIC SUMMER 4252.
4427 C NATM=5 GIVES ATMOSPHERE DATA FOR SUBARCTIC WINTER 4253.
4428 C NATM=6 GIVES ATMOSPHERE DATA FOR STANDARD ATMOSPHER4254.
4429 C 4255.
4430 C NPHD=1 RETURNS H,D,T,O,Q,S DATA FOR GIVEN PRESSURE P4256.
4431 C NPHD=2 RETURNS P,D,T,O,Q,S DATA FOR GIVEN HEIGHT H4257.
4432 C NPHD=3 RETURNS P,H,T,O,Q,S DATA FOR GIVEN DENSITY D4258.
4433 C 4259.
4434 C OUTPUT DATA 4260.
4435 C------------------ 4261.
4436 C P = PRESSURE IN MILLIBARS 4262.
4437 C H = HEIGHT IN KILOMETERS 4263.
4438 C D = DENSITY IN GRAMS/METER**3 4264.
4439 C T = TEMPERATURE (ABSOLUTE) 4265.
4440 C O = OZONE MIXING RATIO (GRAMS OZONE)/(GRAMS AIR) 4266.
4441 C Q = SPECIFIC HUMIDITY (GRAMS WATER VAPOR)/(GRAMS AIR)4267.
4442 C S = SATURATION RATIO (GRAMS WATER VAPOR)/(GRAMS AIR) 4268.
4443 C OCM = OZONE (CM-STP) ABOVE GIVEN HEIGHT 4269.
4444 C WCM = WATER VAPOR (CM-STP) ABOVE GIVEN HEIGHT 4270.
4445 C 4271.
4446 C REMARKS 4272.
4447 C------------------ 4273.
4448 C INPUT P,H,D PARAMETERS ARE NOT ALTERED 4274.
4449 C P,D INTERPOLATION IS EXPONENTIAL WITH HEIGHT 4275.
4450 C NO EXTRAPOLATION IS MADE OUTSIDE 0-100 KM INTERVAL 4276.
4451 C S IS NOT COMPUTED ABOVE 40 KM (FORMULA NOT ACCURATE)4277.
4452 C 4278.
4453 C R = Q/S GIVES RELATIVE HUMIDITY 4279.
4454 C W = Q/(1-Q) GIVES WATER VAPOR MIXING RATIO 4280.
4455 C N = D*2.079E 16 GIVES NUMBER DENSITY PER CM**3 4281.
4456 C 4282.
4457 C 4283.
4458 C 4284.
4459 C 4285.
4460 C 4286.
4461 DIMENSION PRS1(33),PRS2(33),PRS3(33),PRS4(33),PRS5(33),PRS6(33)4287.
4462 1 ,DNS1(33),DNS2(33),DNS3(33),DNS4(33),DNS5(33),DNS6(33)4288.
4463 2 ,TMP1(33),TMP2(33),TMP3(33),TMP4(33),TMP5(33),TMP6(33)4289.
4464 3 ,WVP1(33),WVP2(33),WVP3(33),WVP4(33),WVP5(33),WVP6(33)4290.
4465 4 ,OZO1(33),OZO2(33),OZO3(33),OZO4(33),OZO5(33),OZO6(33)4291.
4466 DIMENSION PRES(33,6),DENS(33,6),TEMP(33,6),WVAP(33,6),OZON(33,6)4292.
4467 C 4293.
4468 EQUIVALENCE 4294.
4469 + (PRES(1,1),PRS1(1)),(DENS(1,1),DNS1(1)),(TEMP(1,1),TMP1(1)) 4295.
4470 + ,(PRES(1,2),PRS2(1)),(DENS(1,2),DNS2(1)),(TEMP(1,2),TMP2(1)) 4296.
4471 + ,(PRES(1,3),PRS3(1)),(DENS(1,3),DNS3(1)),(TEMP(1,3),TMP3(1)) 4297.
4472 + ,(PRES(1,4),PRS4(1)),(DENS(1,4),DNS4(1)),(TEMP(1,4),TMP4(1)) 4298.
4473 + ,(PRES(1,5),PRS5(1)),(DENS(1,5),DNS5(1)),(TEMP(1,5),TMP5(1)) 4299.
4474 + ,(PRES(1,6),PRS6(1)),(DENS(1,6),DNS6(1)),(TEMP(1,6),TMP6(1)) 4300.
4475 EQUIVALENCE (WVAP(1,1),WVP1(1)),(OZON(1,1),OZO1(1)) 4301.
4476 EQUIVALENCE (WVAP(1,2),WVP2(1)),(OZON(1,2),OZO2(1)) 4302.
4477 EQUIVALENCE (WVAP(1,3),WVP3(1)),(OZON(1,3),OZO3(1)) 4303.
4478 EQUIVALENCE (WVAP(1,4),WVP4(1)),(OZON(1,4),OZO4(1)) 4304.
4479 EQUIVALENCE (WVAP(1,5),WVP5(1)),(OZON(1,5),OZO5(1)) 4305.
4480 EQUIVALENCE (WVAP(1,6),WVP6(1)),(OZON(1,6),OZO6(1)) 4306.
4481 C 4307.
4482 C 4308.
4483 DIMENSION HTKM(33) 4309.
4484 DATA HTKM/1.0E-09, 1., 2., 3., 4., 5., 6., 7., 8., 9.,10.,11. 4310.
4485 1 ,12.,13.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24. 4311.
4486 2 ,25.,30.,35.,40.,45.,50.,70.,99.9/ 4312.
4487 C 4313.
4488 C 4314.
4489 C---------------------------------------------------------------------- 4315.
4490 C0000 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4316.
4491 C---------------------------------------------------------------------- 4317.
4492 C 4318.
4493 DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 4319.
4494 DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 4320.
4495 + ,3.7338E-03/ 4321.
4496 DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/4322.
4497 DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 4323.
4498 DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 4324.
4499 DATA HPCON/34.16319/ 4325.
4500 C 4326.
4501 C 4327.
4502 C-----------------------------------------------------------------------4328.
4503 C1111 TROPICAL LATITUDES MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4329.
4504 C-----------------------------------------------------------------------4330.
4505 C 4331.
4506 DATA PRS1/ 1.013E 03,9.040E 02,8.050E 02,7.150E 02,6.330E 02,4332.
4507 1 5.590E 02,4.920E 02,4.320E 02,3.780E 02,3.290E 02,2.860E 02,4333.
4508 2 2.470E 02,2.130E 02,1.820E 02,1.560E 02,1.320E 02,1.110E 02,4334.
4509 3 9.370E 01,7.890E 01,6.660E 01,5.650E 01,4.800E 01,4.090E 01,4335.
4510 4 3.500E 01,3.000E 01,2.570E 01,1.220E 01,6.000E 00,3.050E 00,4336.
4511 5 1.590E 00,8.540E-01,5.790E-02,3.000E-04/ 4337.
4512 DATA DNS1/ 1.167E 03,1.064E 03,9.689E 02,8.756E 02,7.951E 02,4338.
4513 1 7.199E 02,6.501E 02,5.855E 02,5.258E 02,4.708E 02,4.202E 02,4339.
4514 2 3.740E 02,3.316E 02,2.929E 02,2.578E 02,2.260E 02,1.972E 02,4340.
4515 3 1.676E 02,1.382E 02,1.145E 02,9.515E 01,7.938E 01,6.645E 01,4341.
4516 4 5.618E 01,4.763E 01,4.045E 01,1.831E 01,8.600E 00,4.181E 00,4342.
4517 5 2.097E 00,1.101E 00,9.210E-02,5.000E-04/ 4343.
4518 DATA TMP1/ 300.0,294.0,288.0,284.0,277.0,270.0,264.0,257.0,250.0,4344.
4519 1244.0,237.0,230.0,224.0,217.0,210.0,204.0,197.0,195.0,199.0,203.0,4345.
4520 2207.0,211.0,215.0,217.0,219.0,221.0,232.0,243.0,254.0,265.0,270.0,4346.
4521 3 219.0,210.0/ 4347.
4522 DATA WVP1/1.9E 01,1.3E 01,9.3E 00,4.7E 00,2.2E 00,1.5E 00,8.5E-01,4348.
4523 1 4.7E-01,2.5E-01,1.2E-01,5.0E-02,1.7E-02,6.0E-03,1.8E-03,1.0E-03,4349.
4524 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4350.
4525 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4351.
4526 4 1.4E-07,1.0E-09/ 4352.
4527 DATA OZO1/5.6E-05,5.6E-05,5.4E-05,5.1E-05,4.7E-05,4.5E-05,4.3E-05,4353.
4528 1 4.1E-05,3.9E-05,3.9E-05,3.9E-05,4.1E-05,4.3E-05,4.5E-05,4.5E-05,4354.
4529 2 4.7E-05,4.7E-05,6.9E-05,9.0E-05,1.4E-04,1.9E-04,2.4E-04,2.8E-04,4355.
4530 3 3.2E-04,3.4E-04,3.4E-04,2.4E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4356.
4531 4 8.6E-08,4.3E-11/ 4357.
4532 C 4358.
4533 C-----------------------------------------------------------------------4359.
4534 C2222 MIDLATITUDE SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4360.
4535 C-----------------------------------------------------------------------4361.
4536 C 4362.
4537 DATA PRS2/ 1.013E 03,9.020E 02,8.020E 02,7.100E 02,6.280E 02,4363.
4538 1 5.540E 02,4.870E 02,4.260E 02,3.720E 02,3.240E 02,2.810E 02,4364.
4539 2 2.430E 02,2.090E 02,1.790E 02,1.530E 02,1.300E 02,1.110E 02,4365.
4540 3 9.500E 01,8.120E 01,6.950E 01,5.950E 01,5.100E 01,4.370E 01,4366.
4541 4 3.760E 01,3.220E 01,2.770E 01,1.320E 01,6.520E 00,3.330E 00,4367.
4542 5 1.760E 00,9.510E-01,6.710E-02,3.000E-04/ 4368.
4543 DATA DNS2/ 1.191E 03,1.080E 03,9.757E 02,8.846E 02,7.998E 02,4369.
4544 1 7.211E 02,6.487E 02,5.830E 02,5.225E 02,4.669E 02,4.159E 02,4370.
4545 2 3.693E 02,3.269E 02,2.882E 02,2.464E 02,2.104E 02,1.797E 02,4371.
4546 3 1.535E 02,1.305E 02,1.110E 02,9.453E 01,8.056E 01,6.872E 01,4372.
4547 4 5.867E 01,5.014E 01,4.288E 01,1.322E 01,6.519E 00,3.330E 00,4373.
4548 5 1.757E 00,9.512E-01,6.706E-02,5.000E-04/ 4374.
4549 DATA TMP2/ 294.0,290.0,285.0,279.0,273.0,267.0,261.0,255.0,248.0,4375.
4550 1242.0,235.0,229.0,222.0,216.0,216.0,216.0,216.0,216.0,216.0,217.0,4376.
4551 2218.0,219.0,220.0,222.0,223.0,224.0,234.0,245.0,258.0,270.0,276.0,4377.
4552 3 218.0,210.0/ 4378.
4553 DATA WVP2/1.4E 01,9.3E 00,5.9E 00,3.3E 00,1.9E 00,1.0E 00,6.1E-01,4379.
4554 1 3.7E-01,2.1E-01,1.2E-01,6.4E-02,2.2E-02,6.0E-03,1.8E-03,1.0E-03,4380.
4555 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4381.
4556 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4382.
4557 4 1.4E-07,1.0E-09/ 4383.
4558 DATA OZO2/6.0E-05,6.0E-05,6.0E-05,6.2E-05,6.4E-05,6.6E-05,6.9E-05,4384.
4559 1 7.5E-05,7.9E-05,8.6E-05,9.0E-05,1.1E-04,1.2E-04,1.5E-04,1.8E-04,4385.
4560 2 1.9E-04,2.1E-04,2.4E-04,2.8E-04,3.2E-04,3.4E-04,3.6E-04,3.6E-04,4386.
4561 3 3.4E-04,3.2E-04,3.0E-04,2.0E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4387.
4562 4 8.6E-08,4.3E-11/ 4388.
4563 C 4389.
4564 C-----------------------------------------------------------------------4390.
4565 C3333 MIDLATITUDE WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4391.
4566 C-----------------------------------------------------------------------4392.
4567 C 4393.
4568 DATA PRS3/ 1.018E 03,8.973E 02,7.897E 02,6.938E 02,6.081E 02,4394.
4569 1 5.313E 02,4.627E 02,4.016E 02,3.473E 02,2.992E 02,2.568E 02,4395.
4570 2 2.199E 02,1.882E 02,1.610E 02,1.378E 02,1.178E 02,1.007E 02,4396.
4571 3 8.610E 01,7.350E 01,6.280E 01,5.370E 01,4.580E 01,3.910E 01,4397.
4572 4 3.340E 01,2.860E 01,2.430E 01,1.110E 01,5.180E 00,2.530E 00,4398.
4573 5 1.290E 00,6.820E-01,4.670E-02,3.000E-04/ 4399.
4574 DATA DNS3/ 1.301E 03,1.162E 03,1.037E 03,9.230E 02,8.282E 02,4400.
4575 1 7.411E 02,6.614E 02,5.886E 02,5.222E 02,4.619E 02,4.072E 02,4401.
4576 2 3.496E 02,2.999E 02,2.572E 02,2.206E 02,1.890E 02,1.620E 02,4402.
4577 3 1.388E 02,1.188E 02,1.017E 02,8.690E 01,7.421E 01,6.338E 01,4403.
4578 4 5.415E 01,4.624E 01,3.950E 01,1.783E 01,7.924E 00,3.625E 00,4404.
4579 5 1.741E 00,8.954E-01,7.051E-02,5.000E-04/ 4405.
4580 DATA TMP3/ 272.2,268.7,265.2,261.7,255.7,249.7,243.7,237.7,231.7,4406.
4581 1225.7,219.7,219.2,218.7,218.2,217.7,217.2,216.7,216.2,215.7,215.2,4407.
4582 2215.2,215.2,215.2,215.2,215.2,215.2,217.4,227.8,243.2,258.5,265.7,4408.
4583 3 230.7,210.2/ 4409.
4584 DATA WVP3/3.5E 00,2.5E 00,1.8E 00,1.2E 00,6.6E-01,3.8E-01,2.1E-01,4410.
4585 1 8.5E-02,3.5E-02,1.6E-02,7.5E-03,6.9E-03,6.0E-03,1.8E-03,1.0E-03,4411.
4586 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4412.
4587 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4413.
4588 4 1.4E-07,1.0E-09/ 4414.
4589 DATA OZO3/6.0E-05,5.4E-05,4.9E-05,4.9E-05,4.9E-05,5.8E-05,6.4E-05,4415.
4590 1 7.7E-05,9.0E-05,1.2E-04,1.6E-04,2.1E-04,2.6E-04,3.0E-04,3.2E-04,4416.
4591 2 3.4E-04,3.6E-04,3.9E-04,4.1E-04,4.3E-04,4.5E-04,4.3E-04,4.3E-04,4417.
4592 3 3.9E-04,3.6E-04,3.4E-04,1.9E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4418.
4593 4 8.6E-08,4.3E-11/ 4419.
4594 C 4420.
4595 C-----------------------------------------------------------------------4421.
4596 C4444 SUBARCTIC SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4422.
4597 C-----------------------------------------------------------------------4423.
4598 C 4424.
4599 DATA PRS4/ 1.010E 03,8.960E 02,7.929E 02,7.000E 02,6.160E 02,4425.
4600 1 5.410E 02,4.730E 02,4.130E 02,3.590E 02,3.107E 02,2.677E 02,4426.
4601 2 2.300E 02,1.977E 02,1.700E 02,1.460E 02,1.250E 02,1.080E 02,4427.
4602 3 9.280E 01,7.980E 01,6.860E 01,5.890E 01,5.070E 01,4.360E 01,4428.
4603 4 3.750E 01,3.227E 01,2.780E 01,1.340E 01,6.610E 00,3.400E 00,4429.
4604 5 1.810E 00,9.870E-01,7.070E-02,3.000E-04/ 4430.
4605 DATA DNS4/ 1.220E 03,1.110E 03,9.971E 02,8.985E 02,8.077E 02,4431.
4606 1 7.244E 02,6.519E 02,5.849E 02,5.231E 02,4.663E 02,4.142E 02,4432.
4607 2 3.559E 02,3.059E 02,2.630E 02,2.260E 02,1.943E 02,1.671E 02,4433.
4608 3 1.436E 02,1.235E 02,1.062E 02,9.128E 01,7.849E 01,6.750E 01,4434.
4609 4 5.805E 01,4.963E 01,4.247E 01,1.338E 01,6.614E 00,3.404E 00,4435.
4610 5 1.817E 00,9.868E-01,7.071E-02,5.000E-04/ 4436.
4611 DATA TMP4/ 287.0,282.0,276.0,271.0,266.0,260.0,253.0,246.0,239.0,4437.
4612 1232.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,4438.
4613 2225.0,225.0,225.0,225.0,226.0,228.0,235.0,247.0,262.0,274.0,277.0,4439.
4614 3 216.0,210.0/ 4440.
4615 DATA WVP4/9.1E 00,6.0E 00,4.2E 00,2.7E 00,1.7E 00,1.0E 00,5.4E-01,4441.
4616 1 2.9E-01,1.3E-02,4.2E-02,1.5E-02,9.4E-03,6.0E-03,1.8E-03,1.0E-03,4442.
4617 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4443.
4618 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4444.
4619 4 1.4E-07,1.0E-09/ 4445.
4620 DATA OZO4/4.9E-05,5.4E-05,5.6E-05,5.8E-05,6.0E-05,6.4E-05,7.1E-05,4446.
4621 1 7.5E-05,7.9E-05,1.1E-04,1.3E-04,1.8E-04,2.1E-04,2.6E-04,2.8E-04,4447.
4622 2 3.2E-04,3.4E-04,3.9E-04,4.1E-04,4.1E-04,3.9E-04,3.6E-04,3.2E-04,4448.
4623 3 3.0E-04,2.8E-04,2.6E-04,1.4E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4449.
4624 4 8.6E-08,4.3E-11/ 4450.
4625 C 4451.
4626 C-----------------------------------------------------------------------4452.
4627 C5555 SUBARCTIC WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4453.
4628 C-----------------------------------------------------------------------4454.
4629 C 4455.
4630 DATA PRS5/ 1.013E 03,8.878E 02,7.775E 02,6.798E 02,5.932E 02,4456.
4631 1 5.158E 02,4.467E 02,3.853E 02,3.308E 02,2.829E 02,2.418E 02,4457.
4632 2 2.067E 02,1.766E 02,1.510E 02,1.291E 02,1.103E 02,9.431E 01,4458.
4633 3 8.058E 01,6.882E 01,5.875E 01,5.014E 01,4.277E 01,3.647E 01,4459.
4634 4 3.109E 01,2.649E 01,2.256E 01,1.020E 01,4.701E 00,2.243E 00,4460.
4635 5 1.113E 00,5.719E-01,4.016E-02,3.000E-04/ 4461.
4636 DATA DNS5/ 1.372E 03,1.193E 03,1.058E 03,9.366E 02,8.339E 02,4462.
4637 1 7.457E 02,6.646E 02,5.904E 02,5.226E 02,4.538E 02,3.879E 02,4463.
4638 2 3.315E 02,2.834E 02,2.422E 02,2.071E 02,1.770E 02,1.517E 02,4464.
4639 3 1.300E 02,1.113E 02,9.529E 01,8.155E 01,6.976E 01,5.966E 01,4465.
4640 4 5.100E 01,4.358E 01,3.722E 01,1.645E 01,7.368E 00,3.330E 00,4466.
4641 5 1.569E 00,7.682E-01,5.695E-02,5.000E-04/ 4467.
4642 DATA TMP5/ 257.1,259.1,255.9,252.7,247.7,240.9,234.1,227.3,220.6,4468.
4643 1217.2,217.2,217.2,217.2,217.2,217.2,217.2,216.6,216.0,215.4,214.8,4469.
4644 2214.1,213.6,213.0,212.4,211.8,211.2,216.0,222.2,234.7,247.0,259.3,4470.
4645 3 245.7,210.0/ 4471.
4646 DATA WVP5/1.2E 00,1.2E 00,9.4E-01,6.8E-01,4.1E-01,2.0E-01,9.8E-02,4472.
4647 1 5.4E-02,1.1E-02,8.4E-03,5.5E-03,3.8E-03,2.6E-03,1.8E-03,1.0E-03,4473.
4648 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4474.
4649 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4475.
4650 4 1.4E-07,1.0E-09/ 4476.
4651 DATA OZO5/4.1E-05,4.1E-05,4.1E-05,4.3E-05,4.5E-05,4.7E-05,4.9E-05,4477.
4652 1 7.1E-05,9.0E-05,1.6E-04,2.4E-04,3.2E-04,4.3E-04,4.7E-04,4.9E-04,4478.
4653 2 5.6E-04,6.2E-04,6.2E-04,6.2E-04,6.0E-04,5.6E-04,5.1E-04,4.7E-04,4479.
4654 3 4.3E-04,3.6E-04,3.2E-04,1.5E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4480.
4655 4 8.6E-08,4.3E-11/ 4481.
4656 C 4482.
4657 C---------------------------------------------------------------------- 4483.
4658 C6666 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4484.
4659 C---------------------------------------------------------------------- 4485.
4660 C 4486.
4661 DATA PRS6/ 1.01325E+03,8.987E+02,7.950E+02,7.011E+02,6.164E+02,4487.
4662 1 5.402E+02,4.718E+02,4.106E+02,3.560E+02,3.074E+02,2.644E+02,4488.
4663 2 2.263E+02,1.933E+02,1.651E+02,1.410E+02,1.204E+02,1.029E+02,4489.
4664 3 8.787E+01,7.505E+01,6.410E+01,5.475E+01,4.678E+01,4.000E+01,4490.
4665 4 3.422E+01,2.931E+01,2.511E+01,1.172E+01,5.589E+00,2.775E+00,4491.
4666 5 1.431E+00,7.594E-01,4.634E-02,2.384E-04/ 4492.
4667 DATA DNS6/ 1.225E+03,1.112E+03,1.006E+03,9.091E+02,8.191E+02,4493.
4668 1 7.361E+02,6.597E+02,5.895E+02,5.252E+02,4.663E+02,4.127E+02,4494.
4669 2 3.639E+02,3.108E+02,2.655E+02,2.268E+02,1.937E+02,1.654E+02,4495.
4670 3 1.413E+02,1.207E+02,1.031E+02,8.803E+01,7.487E+01,6.373E+01,4496.
4671 4 5.428E+01,4.627E+01,3.947E+01,1.801E+01,8.214E+00,3.851E+00,4497.
4672 5 1.881E+00,9.775E-01,7.424E-02,4.445E-04/ 4498.
4673 DATA TMP6/ 4499.
4674 1 288.150,281.650,275.150,268.650,262.150,255.650,249.150, 4500.
4675 2 242.650,236.150,229.650,223.150,216.650,216.650,216.650, 4501.
4676 3 216.650,216.650,216.650,216.650,216.650,216.650,216.650, 4502.
4677 4 217.650,218.650,219.650,220.650,221.650,226.650,237.050, 4503.
4678 5 251.050,265.050,270.650,217.450,186.870/ 4504.
4679 DATA WVP6/ 1.083E+01,6.323E+00,3.612E+00,2.015E+00,1.095E+00,4505.
4680 1 5.786E-01,2.965E-01,1.469E-01,7.021E-02,3.226E-02,1.419E-02,4506.
4681 2 5.956E-03,5.002E-03,4.186E-03,3.490E-03,2.896E-03,2.388E-03,4507.
4682 3 1.954E-03,1.583E-03,1.267E-03,9.967E-04,8.557E-04,7.104E-04,4508.
4683 4 5.600E-04,4.037E-04,2.406E-04,5.404E-05,2.464E-05,1.155E-05,4509.
4684 5 5.644E-06,2.932E-06,2.227E-07,1.334E-09/ 4510.
4685 DATA OZO6/ 7.526E-05,3.781E-05,6.203E-05,3.417E-05,5.694E-05,4511.
4686 1 3.759E-05,5.970E-05,4.841E-05,7.102E-05,6.784E-05,9.237E-05,4512.
4687 2 9.768E-05,1.251E-04,1.399E-04,1.715E-04,1.946E-04,2.300E-04,4513.
4688 3 2.585E-04,2.943E-04,3.224E-04,3.519E-04,3.714E-04,3.868E-04,4514.
4689 4 3.904E-04,3.872E-04,3.728E-04,2.344E-04,9.932E-05,3.677E-05,4515.
4690 5 1.227E-05,4.324E-06,5.294E-08,1.262E-10/ 4516.
4691 C 4517.
4692 C 4518.
4693 IF(NATM.GT.0) GO TO 200 4519.
4694 O=1.E-10 4520.
4695 Q=1.E-10 4521.
4696 S=1.E-10 4522.
4697 OCM=1.E-10 4523.
4698 WCM=1.E-10 4524.
4699 IF(NPHD.LT.2) GO TO 150 4525.
4700 DO 110 N=2,8 4526.
4701 IF(H.LT.SHLB(N)) GO TO 120 4527.
4702 110 CONTINUE 4528.
4703 N=9 4529.
4704 120 N=N-1 4530.
4705 IF(ABS(SDLB(N)).LT.1.E-04) GO TO 130 4531.
4706 P=SPLB(N)*(1.+SDLB(N)/STLB(N)*(H-SHLB(N)))**(-HPCON/SDLB(N)) 4532.
4707 GO TO 140 4533.
4708 130 P=SPLB(N)*EXP(-HPCON/STLB(N)*(H-SHLB(N))) 4534.
4709 140 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4535.
4710 D=P/T*28.9644E 05/8.31432E 03 4536.
4711 RETURN 4537.
4712 C 4538.
4713 150 CONTINUE 4539.
4714 DO 160 N=2,8 4540.
4715 160 IF(P.GT.SPLB(N)) GO TO 170 4541.
4716 N=9 4542.
4717 170 N=N-1 4543.
4718 IF(ABS(SDLB(N)).LT.1.E-04) GO TO 180 4544.
4719 H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 4545.
4720 GO TO 190 4546.
4721 C ALOG
4722 180 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 4547.
4723 C ALOG
4724 190 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4548.
4725 D=P/T*28.9644E 05/8.31432E 03 4549.
4726 RETURN 4550.
4727 C 4551.
4728 200 CONTINUE 4552.
4729 IF(NPHD.EQ.1) GO TO 240 4553.
4730 IF(NPHD.EQ.2) GO TO 220 4554.
4731 XX=D 4555.
4732 XI=DENS(1,NATM) 4556.
4733 IF(D.GT.XI) XX=XI 4557.
4734 IF(D.LT.5.0E-04) GO TO 280 4558.
4735 DO 210 J=2,33 4559.
4736 XJ=DENS(J,NATM) 4560.
4737 IF(XX.GT.XJ) GO TO 260 4561.
4738 210 XI=XJ 4562.
4739 220 XX=H 4563.
4740 XI=HTKM(1) 4564.
4741 IF(H.LT.XI) XX=XI 4565.
4742 IF(H.GT.99.9) GO TO 280 4566.
4743 DO 230 J=2,33 4567.
4744 XJ=HTKM(J) 4568.
4745 IF(XX.LT.XJ) GO TO 260 4569.
4746 230 XI=XJ 4570.
4747 240 XX=P 4571.
4748 XI=PRES(1,NATM) 4572.
4749 IF(P.GT.XI) XX=XI 4573.
4750 IF(P.LT.3.0E-04) GO TO 280 4574.
4751 DO 250 J=2,33 4575.
4752 XJ=PRES(J,NATM) 4576.
4753 IF(XX.GT.XJ) GO TO 260 4577.
4754 250 XI=XJ 4578.
4755 260 DELTA=(XX-XI)/(XJ-XI) 4579.
4756 I=J-1 4580.
4757 C ALOG
4758 IF(NPHD.NE.2) H=HTKM(I)+(HTKM(J)-HTKM(I))*LOG(XX/XI)/LOG(XJ/XI) 4581.
4759 C ALOG
4760 PI=PRES(I,NATM) 4582.
4761 PJ=PRES(J,NATM) 4583.
4762 DI=DENS(I,NATM) 4584.
4763 DJ=DENS(J,NATM) 4585.
4764 IF(NPHD.NE.1) P=PI+DELTA*(PJ-PI) 4586.
4765 IF(NPHD.NE.3) D=DI+DELTA*(DJ-DI) 4587.
4766 T=TEMP(I,NATM)+DELTA*(TEMP(J,NATM)-TEMP(I,NATM)) 4588.
4767 O=OZON(I,NATM)/DI+DELTA*(OZON(J,NATM)/DJ-OZON(I,NATM)/DI) 4589.
4768 Q=WVAP(I,NATM)/DI+DELTA*(WVAP(J,NATM)/DJ-WVAP(I,NATM)/DI) 4590.
4769 ES=10.**(9.4051-2353./T) 4591.
4770 IF(P.LT.PI) PI=P 4592.
4771 S=1.E+06 4593.
4772 RS=(PI-ES+0.622*ES)/(0.622*ES) 4594.
4773 IF(RS.GT.1.E-06) S=1./RS 4595.
4774 OI=O 4596.
4775 QI=Q 4597.
4776 OCM=0. 4598.
4777 WCM=0. 4599.
4778 DO 270 K=J,33 4600.
4779 PJ=PRES(K,NATM) 4601.
4780 DJ=DENS(K,NATM) 4602.
4781 OJ=OZON(K,NATM)/DJ 4603.
4782 QJ=WVAP(K,NATM)/DJ 4604.
4783 DP=PI-PJ 4605.
4784 OCM=OCM+0.5*(OI+OJ)*DP 4606.
4785 WCM=WCM+0.5*(QI+QJ)*DP 4607.
4786 OI=OJ 4608.
4787 QI=QJ 4609.
4788 270 PI=PJ 4610.
4789 WCM=WCM/0.980*22420.7/18.0 4611.
4790 OCM=OCM/0.980*22420.7/48.0 4612.
4791 RETURN 4613.
4792 280 T=210.0 4614.
4793 IF(NATM.EQ.6) T=186.87 4615.
4794 O=1.E-10 4616.
4795 Q=1.E-10 4617.
4796 S=1.E-10 4618.
4797 OCM=1.E-10 4619.
4798 WCM=1.E-10 4620.
4799 IF(NPHD.NE.1) P=1.E-05 4621.
4800 IF(NPHD.NE.2) H=99.99 4622.
4801 IF(NPHD.NE.3) D=2.E-05 4623.
4802 RETURN 4624.
4803 END 4625.
4804 FUNCTION PFOFTK(WAVNA,WAVNB,TK) 4626.
4805 C ------------------------------------------------------------------4627.
4806 C 4628.
4807 C INPUT DATA 4629.
4808 C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4630.
4809 C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4631.
4810 C 4632.
4811 C TK ABSOLUTE TEMPERATURE IN DEGREES KELVIN 4633.
4812 C 4634.
4813 C OUTPUT DATA 4635.
4814 C PFOFTK PLANCK FLUX (W/M**2) 4636.
4815 C 4637.
4816 C 4638.
4817 C REMARKS 4639.
4818 C PLANCK INTENSITY (W/M**2/STER) IS GIVEN BY PFOFTK/PI4640.
4819 C 4641.
4820 C ------------------------------------------------------------------4642.
4821 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4643.
4822 DIMENSION BN(21),BD(21) 4644.
4823 DATA BN/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,5.D0,-691.D0,7.D0 4645.
4824 1,-3617.D0,43867.D0,-174611.D0,854513.D0,-236364091.D0 4646.
4825 2,8553103.D0,-23749461029.D0,8615841276005.D0,-7709321041217.D0 4647.
4826 3,2577687858367.D0,-2631527155305348D 04,2929993913841559D0/ 4648.
4827 DATA BD/1.D0,2.D0,6.D0,30.D0,42.D0,30.D0,66.D0,2730.D0,6.D0 4649.
4828 1,510.D0,798.D0,330.D0,138.D0,2730.D0,6.D0,870.D0,14322.D0 4650.
4829 2,510.D0,6.D0,1919190.D0,6.D0/ 4651.
4830 DATA PI4/97.40909103400244D0/ 4652.
4831 C DATA PI/3.141592653589793D0/ 4653.
4832 DATA HCK/1.43879D0/ 4654.
4833 DATA DGXLIM/1.D-06/ 4655.
4834 PFOFTK=0.D0 4656.
4835 IF(TK.LT.1.D-06) RETURN 4657.
4836 DO 160 II=1,2 4658.
4837 IF(II.EQ.1) X=HCK*WAVNA/TK 4659.
4838 IF(II.EQ.2) X=HCK*WAVNB/TK 4660.
4839 IF(X.GT.2.3D0) GO TO 120 4661.
4840 XX=X*X 4662.
4841 GSUM=1.D0/3.D0-X/8.D0+XX/60.D0 4663.
4842 NB=3 4664.
4843 XNF=XX/2.D0 4665.
4844 DO 100 N=4,38,2 4666.
4845 NB=NB+1 4667.
4846 NNB=NB 4668.
4847 B=BN(NB)/BD(NB) 4669.
4848 XN3=N+3 4670.
4849 XNM=N*(N-1) 4671.
4850 XNF=XNF*(XX/XNM) 4672.
4851 DG=B/XN3*XNF 4673.
4852 GSUM=GSUM+DG 4674.
4853 DGB=DG 4675.
4854 IF(DABS(DG).LT.DGXLIM) GO TO 110 4676.
4855 100 CONTINUE 4677.
4856 110 GX=GSUM*XX*X 4678.
4857 GO TO 150 4679.
4858 120 GSUM=PI4/15.D0 4680.
4859 DO 130 N=1,20 4681.
4860 NNB=N 4682.
4861 XN=N 4683.
4862 XNN=XN*XN 4684.
4863 XNX=XN*X 4685.
4864 IF(XNX.GT.100.D0) GO TO 140 4686.
4865 GTERM=(X*X*(3.D0+XNX)+6.D0*(1.D0+XNX)/XNN)/XNN 4687.
4866 DG=GTERM*DEXP(-XNX) 4688.
4867 GSUM=GSUM-DG 4689.
4868 DGB=DG 4690.
4869 IF(DG.LT.DGXLIM) GO TO 140 4691.
4870 130 CONTINUE 4692.
4871 140 GX=GSUM 4693.
4872 150 CONTINUE 4694.
4873 IF(II.EQ.1) GXA=GX 4695.
4874 IF(II.EQ.2) GXB=GX 4696.
4875 160 CONTINUE 4697.
4876 PNORM=15.D0/PI4 4698.
4877 PFOFTK=DABS(GXB-GXA)*PNORM 4699.
4878 PFOFTK=PFOFTK*5.6692D-08*TK**4 4700.
4879 RETURN 4701.
4880 END 4702.
4881 FUNCTION TKOFPF(WAVNA,WAVNB,FLUXAB) 4703.
4882 C ------------------------------------------------------------------4704.
4883 C 4705.
4884 C INPUT DATA 4706.
4885 C------------------ 4707.
4886 C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4708.
4887 C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4709.
4888 C FLUXAB PLANCK FLUX (W/M**2) IN INTERVAL 4710.
4889 C (WAVNA,WAVNB) 4711.
4890 C 4712.
4891 C OUTPUT DATA 4713.
4892 C------------------ 4714.
4893 C TK BRIGHTNESS TEMPERATURE IN DEGREES KELVIN4715.
4894 C 4716.
4895 C 4717.
4896 C REMARKS 4718.
4897 C------------------ 4719.
4898 C TKOFPF IS INVERSE FUNCTION OF PFOFTK(WAVNA,WAVNB,TK)4720.
4899 C THE OUTPUT OF TKOFPF SATISFIES THE IDENTITY 4721.
4900 C FLUXAB=PFOFTK(WAVNA,WAVNB,TK) 4722.
4901 C (UNITS FOR FLUXAB AND PFOFTK MUST BE IDENTICAL) 4723.
4902 C 4724.
4903 C ------------------------------------------------------------------4725.
4904 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4726.
4905 LOGICAL LOGFIT 4727.
4906 DATA DELFIT/1.D-06/ 4728.
4907 DATA NMAX/20/ 4729.
4908 C IF(FLUXAB.LE.0.D0) RETURN 4730.
4909 LOGFIT=.FALSE. 4731.
4910 NFIT=0 4732.
4911 PF=FLUXAB 4733.
4912 XA=0.D0 4734.
4913 YA=0.D0 4735.
4914 XB=250.D0 4736.
4915 YB=PFOFTK(WAVNA,WAVNB,XB) 4737.
4916 XX=PF*XB/YB 4738.
4917 YY=PFOFTK(WAVNA,WAVNB,XX) 4739.
4918 IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4740.
4919 IF((YY/PF).LT.0.5D0) GO TO 150 4741.
4920 IF((YY/PF).GT.2.0D0) GO TO 170 4742.
4921 IF(XX.GT.XB) GO TO 110 4743.
4922 XC=XB 4744.
4923 YC=YB 4745.
4924 XB=XX 4746.
4925 YB=YY 4747.
4926 GO TO 120 4748.
4927 110 XC=XX 4749.
4928 YC=YY 4750.
4929 120 XBA=XB-XA 4751.
4930 XCA=XC-XA 4752.
4931 XBC=XB-XC 4753.
4932 YBA=YB-YA 4754.
4933 YCA=YC-YA 4755.
4934 YBC=YB-YC 4756.
4935 NFIT=NFIT+1 4757.
4936 IF(NFIT.GT.NMAX) GO TO 200 4758.
4937 YXBA=YBA/XBA 4759.
4938 YXCA=YCA/XCA 4760.
4939 C=(YXBA-YXCA)/XBC 4761.
4940 B=YXBA-(XB+XA)*C 4762.
4941 A=YA-XA*(B+XA*C) 4763.
4942 ROOT=DSQRT(B*B+4.D0*C*(PF-A)) 4764.
4943 XX=0.5D0*(ROOT-B)/C 4765.
4944 IF(XX.LT.XA.OR.XX.GT.XC) XX=-0.5D0*(ROOT+B)/C 4766.
4945 YY=PFOFTK(WAVNA,WAVNB,XX) 4767.
4946 IF(LOGFIT) YY=DLOG(YY) 4768.
4947 IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4769.
4948 IF(XX.GT.XB) GO TO 130 4770.
4949 XC=XB 4771.
4950 YC=YB 4772.
4951 GO TO 140 4773.
4952 130 XA=XB 4774.
4953 YA=YB 4775.
4954 140 XB=XX 4776.
4955 YB=YY 4777.
4956 GO TO 120 4778.
4957 150 XA=XX 4779.
4958 YA=YY 4780.
4959 160 XC=XB 4781.
4960 YC=YB 4782.
4961 XB=XB/2.D0 4783.
4962 YB=PFOFTK(WAVNA,WAVNB,XB) 4784.
4963 IF(YB.LT.YA) GO TO 190 4785.
4964 IF(YB.GT.PF) GO TO 160 4786.
4965 XA=XB 4787.
4966 YA=YB 4788.
4967 GO TO 190 4789.
4968 170 XC=XX 4790.
4969 YC=YY 4791.
4970 180 XA=XB 4792.
4971 YA=YB 4793.
4972 XB=XB*2.D0 4794.
4973 YB=PFOFTK(WAVNA,WAVNB,XB) 4795.
4974 IF(YB.GT.YC) GO TO 190 4796.
4975 IF(YB.LT.PF) GO TO 180 4797.
4976 XC=XB 4798.
4977 YC=YB 4799.
4978 190 XB=XA+(PF-YA)*(XC-XA)/(YC-YA) 4800.
4979 YB=PFOFTK(WAVNA,WAVNB,XB) 4801.
4980 XX=XB 4802.
4981 IF(DABS(YB-PF).LT.DELFIT) GO TO 200 4803.
4982 PF=DLOG(PF) 4804.
4983 YA=DLOG(YA) 4805.
4984 YB=DLOG(YB) 4806.
4985 YC=DLOG(YC) 4807.
4986 LOGFIT=.TRUE. 4808.
4987 GO TO 120 4809.
4988 200 TKOFPF=XX 4810.
4989 RETURN 4811.
4990 END 4812.
4991 SUBROUTINE WRITER(INDEX,KPAGE) 4813.
4992
4993 #include "B83XX.COM"
4994
4995 DIMENSION SRAOC(15),SRAEA(15),SRAOI(15),SRALI(15),SRASN(15) 4875.
4996 C 4876.
4997 DIMENSION SRBALB(6),SRXALB(6) 4877.
4998 EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 4878.
4999 C 4879.
5000 +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 4880.
5001 +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 4881.
5002 C 4882.
5003 EQUIVALENCE (ASNALB(1),ASNVIS),(ASNALB(2),ASNNIR) 4883.
5004 EQUIVALENCE (AOIALB(1),AOIVIS),(AOIALB(2),AOINIR) 4884.
5005 EQUIVALENCE (ALIALB(1),ALIVIS),(ALIALB(2),ALINIR) 4885.
5006 C 4886.
5007 EQUIVALENCE 4887.
5008 + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 4888.
5009 +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 4889.
5010 +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 4890.
5011 +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 4891.
5012 +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 4892.
5013 +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 4893.
5014 C 4894.
5015 EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 4895.
5016 EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 4896.
5017 C 4897.
5018 EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 4898.
5019 EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 4899.
5020 C 4900.
5021 EQUIVALENCE (PVT( 1),DESRT),(PVT( 2),TNDRA),(PVT( 3),GRASS) 4901.
5022 + ,(PVT( 4),SHRUB),(PVT( 5),TREES),(PVT( 6),DECID) 4902.
5023 + ,(PVT( 7),EVERG),(PVT( 8),RAINF),(PVT( 9),ROCKS) 4903.
5024 + ,(PVT(10),CROPS),(PVT(11),ALGAE) 4904.
5025 C 4905.
5026 EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 4906.
5027 + ,(FRC(4), FCLO),(FRC(5), FCOV) 4907.
5028 C 4908.
5029 C 4909.
5030 CHARACTER*8 FTYPE 4910.
5031 DIMENSION BGFLUX(25),BGFRAC(25),TAUSUM(25) 4911.
5032 DIMENSION SUM0(15),SUM1(40),SUM2(40),SUM3(40),FTYPE(5),AUXGAS(4) 4912.
5033 DATA FTYPE/'DOWNWARD',' UPWARD','UPWD NET','COOLRATE','FRACTION'/4913.
5034 DATA AUXGAS/1H0,1HL,1HX,1HX/ 4914.
5035 DATA P0/1013.25/ 4915.
5036 C 4916.
5037 INDJ=MOD(INDEX,10) 4917.
5038 IF(INDJ.LT.1) INDJ=10 4918.
5039 INDI=1 4919.
5040 IF(INDEX.LT.11) INDI=INDJ 4920.
5041 DO 9999 INDX=INDI,INDJ 4921.
5042 C 4922.
5043 IF(INDEX.EQ.0) GO TO 10 4923.
5044 GO TO (100,200,300,400,500,600,700,800,900,1000),INDX 4924.
5045 C 4925.
5046 C------------- 4926.
5047 10 CONTINUE 4927.
5048 C------------- 4928.
5049 C 4929.
5050 NPAGE=1 4930.
5051 WRITE(6,6001) NPAGE 4931.
5052 6001 FORMAT(1I1,'(1) RADCOM M/R: (CONTROL/INPUT PARAMETERS)' 4932.
5053 + ,' DEFAULT VALUES & MODIFICATIONS'/) 4933.
5054 WRITE(6,6002) 4934.
5055 6002 FORMAT(20X,'PARAMETER/VALUE',5X,'COMMENTS RE PARAMETER DEFAULT' 4935.
5056 + ,' VALUE AND PARAMETER RANGE AND EFFECT'/10X,'AEROSOLS') 4936.
5057 WRITE(6,6003) 4937.
5058 6003 FORMAT(20X,'FGOLDH(1) = 1.0',5X,'STRATOSPHERIC AEROSOL, GLOBAL' 4938.
5059 + ,' BACKGROUND - TAU(.55) = 0.005' 4939.
5060 + /20X,'FGOLDH(2) = 1.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4940.
5061 + ,' BACKGROUND: TAU(.55) = 0.125' 4941.
5062 + /20X,'FGOLDH(3) = 0.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4942.
5063 + ,' BACKGROUND: TAU(.55) = 0.125 (FOR FGOLDH(3)=1.0' 4943.
5064 + /) 4944.
5065 GO TO 9999 4945.
5066 C 4946.
5067 C------------- 4947.
5068 100 CONTINUE 4948.
5069 C------------- 4949.
5070 C 4950.
5071 C 4951.
5072 NPAGE=1 4952.
5073 IF(INDEX.LT.11) NPAGE=KPAGE 4953.
5074 WRITE(6,6101) NPAGE,LASTVC,KFORCE 4954.
5075 WRITE(6,6102) 4955.
5076 IDPROG=ID5(1) 4956.
5077 ID2TRD=ID5(2) 4957.
5078 ID3SRD=ID5(3) 4958.
5079 ID4VEG=ID5(4) 4959.
5080 ID5FOR=ID5(5) 4960.
5081 FACTOR=P0/(PLB(1)-PLB(2))*1.25 4961.
5082 PPMCO2=ULGAS(1,2)*FACTOR 4962.
5083 PPMO2 =ULGAS(1,4)*FACTOR 4963.
5084 PPMN2O=ULGAS(1,6)*FACTOR 4964.
5085 PPMCH4=ULGAS(1,7)*FACTOR 4965.
5086 PPMF11=ULGAS(1,8)*FACTOR 4966.
5087 PPMF12=ULGAS(1,9)*FACTOR 4967.
5088 WRITE(6,6103) (FULGAS(I),I=1,9),(FGOLDH(I),I=1,5) 4968.
5089 IF(KGASSR.GT.0.OR.KAERSR.GT.0) 4969.
5090 +WRITE(6,6104) (FULGAS(I+9),I=1,9),(FGOLDH(I+9),I=1,5) 4970.
5091 !
5092 ! === Chien Wang 121797
5093 !
5094 #if ( defined CPL_CHEM )
5095 WRITE(6,6105) PPMCO2,PPMO3,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12
5096 #else
5097 WRITE(6,6105) PPMCO2,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12 4971.
5098 #endif
5099 + ,(FGOLDH(I),I=6,9),NV 4972.
5100 WRITE(6,6106) TAUMIN,TLGRAD,EOCTRA,ZOCSRA,FMARCL,FCLDTR,NTRACE 4973.
5101 + ,IDPROG,IMGAS1,KEEPRH,KGASSR,LAYRAD 4974.
5102 WRITE(6,6107) FRACSL,TKCICE,ESNTRA,ZSNSRA,WETTRA,FCLDSR,ITR(1) 4975.
5103 + ,ID2TRD,IMGAS2,KEEPAL,KAERSR,NL 4976.
5104 WRITE(6,6108) RATQSL,FLONO3,EICTRA,ZICSRA,WETSRA,FALGAE,ITR(2) 4977.
5105 + ,ID3SRD,ILGAS1,ISOSCT,KFRACC,NLP 4978.
5106 WRITE(6,6109) FOGTSL,ECLTRA,EDSTRA,ZDSSRA,DMOICE,FRAYLE,ITR(3) 4979.
5107 + ,ID4VEG,ILGAS2,IHGSCT,MARCLD,JMLAT 4980.
5108 WRITE(6,6110) PTLISO,ZCLSRA,EVGTRA,ZVGSRA,DMLICE,LICETK,ITR(4) 4981.
5109 + ,ID5FOR,KWVCON,LAPGAS,NORMS0,IMLON 4982.
5110 C 4983.
5111 6101 FORMAT(1I1,'(1) RADCOM 1/F: (CONTROL/INPUT PARAMETERS)' 4984.
5112 + ,' (GAS/AEROSOL REFERENCE AMOUNT SCALE FACTORS,' 4985.
5113 + ,' DEFAULTS & OPTIONS IN FORCE) LASTVC=',I7 4986.
5114 + /1X,113('-'),' KFORCE=',I10) 4987.
5115 6102 FORMAT(4X,'GAS: ','H2O',5X,'CO2',7X,'O3',6X,'O2',5X,'NO2' 4988.
5116 + ,5X,'N2O',5X,'CH4',6X,'CCL3F1',3X,'CCL2F2' 4989.
5117 + ,3X,'AERSOL: GLOBAL OCEAN LAND DESERT HAZE') 4990.
5118 6103 FORMAT(1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4991.
5119 + ,3X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4992.
5120 6104 FORMAT(1H+,T84,'T' 4993.
5121 + /1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4994.
5122 + ,' S',1X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4995.
5123 !
5124 ! === Chien Wang 121797
5125 !
5126 #if ( defined CPL_CHEM )
5127 6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,f8.4,F8.0,8X,F8.4,F8.4,1X,F8.7
5128 #else
5129 6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,9X,F8.0,8X,F8.4,F8.4,1X,F8.7 4996.
5130 #endif
5131 + ,1X,F8.7,3X,'TRACER=',1P,E7.1,1P,2E9.2,1P,E8.1,' NV=',I2) 4997.
5132 6106 FORMAT(1X,'TAUMIN=',1P,E7.1,1X,'TLGRAD=',0P,F4.1,' EOCTRA=',F3.1 4998.
5133 + ,1X,'ZOCSRA=', F3.1,1X,'FMARCL=', F4.2,1X,'FCLDTR=',F3.1 4999.
5134 + ,1X,'NTRACE=', I2,3X,'IDPROG=', I4,1X,'IMGAS1=', I1 5000.
5135 + ,1X,'KEEPRH=', I1,1X,'KGASSR=', I1,1X,'LAYRAD=', I2) 5001.
5136 6107 FORMAT(1X,'FRACSL=',1P,E7.1,1X,'TKCICE=',0P,F4.0,' ESNTRA=',F3.1 5002.
5137 + ,1X,'ZSNSRA=', F3.1,1X,'WETTRA=', F4.2,1X,'FCLDSR=',F3.1 5003.
5138 + ,1X,'ITR(1)=', I2,3X,'ID2TRD=', I4,1X,'IMGAS2=', I1 5004.
5139 + ,1X,'KEEPAL=', I1,1X,'KAERSR=', I1,1X,' NL=', I2) 5005.
5140 6108 FORMAT(1X,'RATQSL=', F4.2,4X,'FLONO3=', F4.1,1X,'EICTRA=',F3.1 5006.
5141 + ,1X,'ZICSRA=', F3.1,1X,'WETSRA=', F4.2,1X,'FALGAE=',F3.1 5007.
5142 + ,1X,'ITR(2)=', I2,3X,'ID3SRD=', I4,1X,'ILGAS1=', I1 5008.
5143 + ,1X,'ISOSCT=', I1,1X,'KFRACC=', I1,1X,' NLP=', I2) 5009.
5144 6109 FORMAT(1X,'FOGTSL=', F4.2,4X,'ECLTRA=', F4.2,1X,'EDSTRA=',F3.1 5010.
5145 + ,1X,'ZDSSRA=', F3.1,1X,'DMOICE=', F4.1,1X,'FRAYLE=',F3.1 5011.
5146 + ,1X,'ITR(3)=', I2,3X,'ID4VEG=', I4,1X,'ILGAS2=', I1 5012.
5147 + ,1X,'IHGSCT=', I1,1X,'MARCLD=', I1,1X,' JMLAT=', I2) 5013.
5148 6110 FORMAT(1X,'PTLISO=',1PE7.1,1X,'ZCLSRA=',0PF4.2,1X,'EVGTRA=',F3.1 5014.
5149 + ,1X,'ZVGSRA=', F3.1,1X,'DMLICE=', F4.1,1X,'LICETK=', I3 5015.
5150 + ,1X,'ITR(4)=', I2,3X,'ID5FOR=', I4,1X,'KWVCON=', I1 5016.
5151 + ,1X,'LAPGAS=', I1,1X,'NORMS0=', I1,1X,'IMLON=', I3) 5017.
5152 GO TO 9999 5018.
5153 C 5019.
5154 C------------- 5020.
5155 200 CONTINUE 5021.
5156 C------------- 5022.
5157 C 5023.
5158 NPAGE=0 5024.
5159 IF(INDEX.LT.11) NPAGE=KPAGE 5025.
5160 WRITE(6,6201) NPAGE,AUXGAS(LUXGAS+1),S0,COSZ 5026.
5161 DO 202 K=1,9 5027.
5162 DO 201 L=1,NL 5028.
5163 IF(LUXGAS.EQ.0) UXGAS(L,K)=U0GAS(L,K) 5029.
5164 201 IF(LUXGAS.EQ.1) UXGAS(L,K)=ULGAS(L,K) 5030.
5165 202 CONTINUE 5031.
5166 IF(LUXGAS.LT.2) GO TO 205 5032.
5167 LGS=(LUXGAS-2)*9 5033.
5168 DO 203 L=1,NL 5034.
5169 UXGAS(L,1)=U0GAS(L,1)*FULGAS(1+LGS) 5035.
5170 UXGAS(L,3)=U0GAS(L,3)*FULGAS(3+LGS) 5036.
5171 203 UXGAS(L,5)=U0GAS(L,5)*FULGAS(5+LGS) 5037.
5172 C 5038.
5173 DO 204 L=1,NL 5039.
5174 UXGAS(L,2)=U0GAS(L,2)*FULGAS(2+LGS) 5040.
5175 UXGAS(L,4)=U0GAS(L,4)*FULGAS(4+LGS) 5041.
5176 UXGAS(L,6)=U0GAS(L,6)*FULGAS(6+LGS) 5042.
5177 UXGAS(L,7)=U0GAS(L,7)*FULGAS(7+LGS) 5043.
5178 UXGAS(L,8)=U0GAS(L,8)*FULGAS(8+LGS) 5044.
5179 204 UXGAS(L,9)=U0GAS(L,9)*FULGAS(9+LGS) 5045.
5180 205 CONTINUE 5046.
5181 DO 206 N=1,NL 5047.
5182 L=NLP-N 5048.
5183 WRITE(6,6202) L,PLB(L),HLB(L),TLB(L),TLT(L),TLM(L) 5049.
5184 + ,(UXGAS(L,K),K=1,9),CLDTAU(L),SHL(L),RHL(L) 5050.
5185 206 CONTINUE 5051.
5186 DO 207 I=1,15 5052.
5187 207 SUM0(I)=0. 5053.
5188 DO 210 L=1,NL 5054.
5189 DO 208 I=1,9 5055.
5190 208 SUM0(I)=SUM0(I)+ULGAS(L,I) 5056.
5191 DO 209 I=1,4 5057.
5192 209 SUM0(11+I)=SUM0(11+I)+TRACER(L,I) 5058.
5193 210 SUM0(10)=SUM0(10)+CLDTAU(L) 5059.
5194 DO 212 J=1,NGOLDH 5060.
5195 TAU55=0. 5061.
5196 DO 211 I=1,NAERO 5062.
5197 211 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5063.
5198 212 SUM0(11)=SUM0(11)+TAU55 5064.
5199 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5065.
5200 TGMEAN=SQRT(TGMEAN) 5066.
5201 TGMEAN=SQRT(TGMEAN) 5067.
5202 WRITE(6,6203) SUM0(11),(SUM0(I),I=1,10) 5068.
5203 C WRITE(6,6204) POCEAN, TGO, AGESN, ZOICE,LASTVC, DESRT, DECID 5069.
5204 C + ,SRAOC(1),SRAEA(1),SRAOI(1),SRALI(1),SRASN(1) 5070.
5205 C + ,SRDALB(1),SRXALB(1) 5071.
5206 C WRITE(6,6205) PEARTH, TGE, SNOWE,WEARTH, PSIG0, TNDRA, EVERG 5072.
5207 C WRITE(6,6206) POICE, TGOI,SNOWOI,FRACCC, ALGAE, GRASS, RAINF 5073.
5208 C WRITE(6,6207) PLICE, TGLI,SNOWLI, JYEAR,TRACR1, SHRUB, ROCKS 5074.
5209 C WRITE(6,6208) MEANAL,TGMEAN,EXSNEA, JDAY,TRACR2, TREES, CROPS 5075.
5210 C WRITE(6,6209) KALVIS, TSL,EXSNOI, JLAT,TRACR3, FCHI, FCLO 5076.
5211 C WRITE(6,6210) LUXGAS, WMAG,EXSNLI, ILON,TRACR4, FCMI, FCOV 5077.
5212 C 5078.
5213 WRITE(6,6204) POCEAN,TGO,AGESN,WMAG,SUM0(12),JYEAR,BSNVIS,BSNNIR 5079.
5214 + ,LASTVC 5080.
5215 WRITE(6,6205) PEARTH,TGE,SNOWE,WEARTH,SUM0(13),JDAY,XSNVIS,XSNNIR 5081.
5216 WRITE(6,6206) POICE,TGOI,SNOWOI,ZOICE,SUM0(14),JLAT 5082.
5217 + ,(SRBALB(I),I=1,6) 5083.
5218 WRITE(6,6207) PLICE,TGLI,SNOWLI,FRC(5),SUM0(15),ILON 5084.
5219 + ,(SRXALB(I),I=1,6) 5085.
5220 WRITE(6,6208) TGMEAN,LUXGAS,PSUM,TSL,MEANAL,KALVIS,(PVT(I),I=1,11)5086.
5221 WRITE(6,6209) (BXA(I),I=1,19) 5087.
5222 6201 FORMAT(1I1,'(2) RADCOM G/L: (INPUT DATA)' 5088.
5223 + ,T41,' ABSORBER AMOUNT PER LAYER:' 5089.
5224 + ,' U',1A1,'GAS(L,K) IN CM**3(STP)/CM**2' 5090.
5225 + ,T109,'S0=',F8.3,3X,'COSZ=',F6.4/1X,132('-') 5091.
5226 + /' LN PLB HLB TLB TLT TLM ' 5092.
5227 + ,'H2O CO2 O3 O2 NO2 N2O CH4' 5093.
5228 + ,' CCL3F1 CCL2F2 CLDTAU SHL RHL ') 5094.
5229 6202 FORMAT(1X,I2,F9.3,F6.2,3F7.2,F9.3,F8.3,1X,F6.5,F8.0,1P,1E9.2 5095.
5230 + ,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,1F7.2,1X,F7.6,1X,F5.4) 5096.
5231 6203 FORMAT( 1X,'$SUM AERSOL=',F5.3,7X,'$COLUMN AMOUNT',F9.3 5097.
5232 + ,F8.3,1X,F6.5,F8.0,1P,1E9.2,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,F7.2) 5098.
5233 6204 FORMAT(/1X,'POCEAN=',F6.4,' TGO=' ,F6.2,1X,' AGESN=',F6.3 5099.
5234 + , 1X,' WMAG=',F6.3,' TRACER 1=',F5.3,' JYEAR=',I4 5100.
5235 + , 3X,'BSNVIS=',F6.4,' BSNNIR=' ,F6.4,7X,'LASTVC=',I7) 5101.
5236 6205 FORMAT( ' PEARTH=',F6.4,' TGE=',F6.2,' SNOWE=',F6.3 5102.
5237 + , ' WEARTH=',F6.3,' $SUMS: 2=',F5.3 5103.
5238 + , ' JDAY=',I4 ,2X,' XSNVIS=',F6.4,' XSNNIR=',F6.4 5104.
5239 + , 8X,'NIRALB VISALB') 5105.
5240 6206 FORMAT( ' POICE=',F6.4,' TGOI=',F6.2,' SNOWOI=',F6.3 5106.
5241 + , ' ZOICE=',F6.3,' 3=',F5.3 5107.
5242 + , ' JLAT=',I4, 2X,' SRBALB=',F6.4 5108.
5243 + ,4F7.4,F7.4) 5109.
5244 6207 FORMAT( ' PLICE=',F6.4,' TGLI=',F6.2,' SNOWLI=',F6.3 5110.
5245 + , ' FRC(5)=',F6.3,' 4=',F5.3 5111.
5246 + , ' ILON=',I4, 2X,' SRXALB=',F6.4 5112.
5247 + ,4F7.4,F7.4) 5113.
5248 6208 FORMAT( 1X,13('-'),'$TGMEAN=',F6.2,14X,' LUXGAS=',I1,5X 5114.
5249 + ,1X,'DESERT TUNDRA GRASSL SHRUBS TREES DECIDF' 5115.
5250 + ,' EVERGF',' RAINF',' ROCKS',' CROPS',' ALGAE' 5116.
5251 + / ' $PSUM=',F6.4,' TSL=',F6.2,' MEANAL=',I1 5117.
5252 + ,5X,' KALVIS=',I1,T54,'PVT=',F6.4,10F7.4) 5118.
5253 6209 FORMAT(' BOCVIS BOCNIR XOCVIS XOCNIR|BEAVIS BEANIR XEAVIS XEANIR' 5119.
5254 + ,'|BOIVIS BOINIR XOIVIS XOINIR|BLIVIS BLINIR XLIVIS XLINIR' 5120.
5255 + ,'|EXPSNE|EXPSNO|EXPSNL'/1X,F6.4,18F7.4) 5121.
5256 GO TO 9999 5122.
5257 C 5123.
5258 C------------- 5124.
5259 300 CONTINUE 5125.
5260 C------------- 5126.
5261 C 5127.
5262 NPAGE=0 5128.
5263 IF(INDEX.LT.11) NPAGE=KPAGE 5129.
5264 IF(NL.GT.13) NPAGE=1 5130.
5265 L=NLP 5131.
5266 STNFLB=SRNFLB(L)-TRNFLB(L) 5132.
5267 WRITE(6,6301) NPAGE,NORMS0 5133.
5268 WRITE(6,6302) L,PLB(L),HLB(L),TLB(L) 5134.
5269 + ,TRDFLB(L),TRUFLB(L),TRNFLB(L) 5135.
5270 + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),STNFLB 5136.
5271 DO 301 N=1,NL 5137.
5272 L=NLP-N 5138.
5273 CRHRF=8.4167/(PLB(L)-PLB(L+1)) 5139.
5274 STNFLB=SRNFLB(L)-TRNFLB(L) 5140.
5275 STFHR =SRFHRL(L)-TRFCRL(L) 5141.
5276 TRDCR =TRFCRL(L)*CRHRF 5142.
5277 SRDHR =SRFHRL(L)*CRHRF 5143.
5278 STDHR=STFHR*CRHRF 5144.
5279 SRALB =SRUFLB(L)/(SRDFLB(L)+1.E-10) 5145.
5280 SRXVIS=SRXATM(1) 5146.
5281 SRXNIR=SRXATM(2) 5147.
5282 WRITE(6,6303) L,PLB(L),HLB(L),TLB(L),TLT(L) 5148.
5283 + ,TRDFLB(L),TRUFLB(L),TRNFLB(L),TRFCRL(L) 5149.
5284 + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),SRFHRL(L) 5150.
5285 + ,STNFLB,STFHR,STDHR,TRDCR,SRDHR,SRALB 5151.
5286 301 CONTINUE 5152.
5287 C 5153.
5288 WRITE(6,6304) BTEMPW,TRUFTW,SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR 5154.
5289 + ,PLANIR 5155.
5290 WRITE(6,6305) TRDFGW,TRUFGW,SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR 5156.
5291 + ,ALBNIR 5157.
5292 WRITE(6,6306) SRXVIS,SRXNIR,SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR 5158.
5293 + ,SRANIR 5159.
5294 WRITE(6,6307) TRDFSL,TRUFSL,TRSLCR,TRSLTS,TRSLTG,TRSLWV,TRSLBS 5160.
5295 + ,SRSLHR 5161.
5296 C 5162.
5297 WRITE(6,6308) (FSRNFG(I),I=1,4),LTOPCL,JLAT,JYEAR 5163.
5298 WRITE(6,6309) (FTRUFG(I),I=1,4),LBOTCL,ILON,JDAY 5164.
5299 WRITE(6,6310) (DTRUFG(I),I=1,4),TTRUFG,COSZ 5165.
5300 C 5166.
5301 6301 FORMAT(1I1,'(3) RADCOM M/S: (OUTPUT DATA)' 5167.
5302 + ,T37,'THERMAL FLUXES (W/M**2)',4X,'SOLAR FLUXES (W/M**2)' 5168.
5303 + ,1X,'NORMS0=',I1,' ENERGY INPUT HEAT/COOL DEG/DAY ALB' 5169.
5304 + ,'DO'/1X,31('-'),2X,9('---'),2X,10('---'),1X,'$',7('-') 5170.
5305 + ,'$',5('-'),1X,'$',5('-'),'$',5('-'),'$',5('-'),1X,'$----' 5171.
5306 + /' LN PLB HLB TLB TLT ' 5172.
5307 + ,' TRDFLB TRUFLB TRNFLB TRFCRL SRDFLB SRUFLB SRNFLB' 5173.
5308 + ,' SRFHRL STNFLB STFHR STDHR TRDCR SRDHR SRALB') 5174.
5309 6302 FORMAT(1X,I2,F9.3,F6.2,1X,F6.2,8X,3F7.2,8X,3F8.2,7X,F8.2) 5175.
5310 6303 FORMAT(1X,I2,F9.3,F6.2,2F7.2,1X,3F7.2,F7.2,1X,3F8.2,F7.2,1X,F7.2 5176.
5311 + ,1X,F6.2,1X,3F6.2,1X,F5.4) 5177.
5312 6304 FORMAT(/1X,'AT ATM TOP: ',' BTEMPW=',F6.2,1X,' TRUFTW=',F6.3 5178.
5313 + , 2X,' SRIVIS=',F6.2,' SROVIS=',F6.2, ' PLAVIS=',F6.4 5179.
5314 + , 2X,' SRINIR=',F6.2,' SRONIR=',F6.2, ' PLANIR=',F6.4) 5180.
5315 6305 FORMAT( 1X,'AT GROUND : ',' TRDFGW=',F6.3,1X,' TRUFGW=',F6.3 5181.
5316 + , 2X,' SRDVIS=',F6.2,' SRUVIS=',F6.2, ' ALBVIS=',F6.4 5182.
5317 + , 2X,' SRDNIR=',F6.2,' SRUNIR=',F6.2, ' ALBNIR=',F6.4) 5183.
5318 6306 FORMAT( 1X,'ATMOSPHERE: ',' SRXVIS=',F6.4,1X,' SRXNIR=',F6.4 5184.
5319 + , 2X,' SRTVIS=',F6.4,' SRRVIS=',F6.4, ' SRAVIS=',F6.4 5185.
5320 + , 2X,' SRTNIR=',F6.4,' SRRNIR=',F6.4, ' SRANIR=',F6.4) 5186.
5321 6307 FORMAT( 1X,'SURF LAYER: ',' TRDRSL=',F6.2,1X,' TRUFSL=',F6.2 5187.
5322 + , 2X,' TRSLCR=',F6.4,'+TRSLTS=',F6.4, '-TRSLTG=',F6.4 5188.
5323 + , 2X,' TRSLWV=',F6.4,' TRSLBS=',F6.3, ' SRSLHR=',F6.4) 5189.
5324 6308 FORMAT(/1X,'FSRNFG(I)=> FRAC SRNFLB(1) EACH SURFTYPE' 5190.
5325 + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5191.
5326 + ,F7.4,1X,' LTOPCL=',I2,' JLAT=',I2,' JYEAR',I4) 5192.
5327 6309 FORMAT( 1X,'FTRUFG(I)=> FRAC TRUFLB(1) EACH SURFTYPE' 5193.
5328 + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5194.
5329 + ,F7.4,1X,' LBOTCL=',I2,' ILON=',I2,' JDAY=',I4) 5195.
5330 6310 FORMAT( 1X,'DTRUFG(I)=> DERIV TRUFLB(1) EACH SURFTYPE' 5196.
5331 + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5197.
5332 + ,F7.4, '=>TTRUFG=',F6.4,' COSZ=',F6.4) 5198.
5333 GO TO 9999 5199.
5334 C 5200.
5335 C------------- 5201.
5336 400 CONTINUE 5202.
5337 C------------- 5203.
5338 GO TO 9999 5204.
5339 C 5205.
5340 C------------- 5206.
5341 500 CONTINUE 5207.
5342 C------------- 5208.
5343 C 5209.
5344 NPAGE=1 5210.
5345 IF(INDEX.LT.11) NPAGE=KPAGE 5211.
5346 SIGMA=5.6697D-08 5212.
5347 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5213.
5348 TGMEAN=SQRT(TGMEAN) 5214.
5349 TGMEAN=SQRT(TGMEAN) 5215.
5350 SIGT4=SIGMA*TGMEAN**4 5216.
5351 ITG=TGMEAN 5217.
5352 WTG=TGMEAN-ITG 5218.
5353 ITG=ITG-IT0 5219.
5354 SUMK=0.0 5220.
5355 DO 501 K=1,NKTR 5221.
5356 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5222.
5357 BGFRAC(K)=BGFLUX(K)/SIGT4 5223.
5358 SUMK=SUMK+BGFLUX(K) 5224.
5359 ITG=ITG+ITNEXT 5225.
5360 501 CONTINUE 5226.
5361 WRITE(6,6501) NPAGE 5227.
5362 WRITE(6,6502) (K,K=1,11) 5228.
5363 DO 502 N=1,NL 5229.
5364 L=NLP-N 5230.
5365 LI=L 5231.
5366 LL=NL*10+L 5232.
5367 WRITE(6,6503) L,PL(L),DPL(L),TLM(L),(TAULAP(I),I=LI,LL,NL) 5233.
5368 502 CONTINUE 5234.
5369 LK=0 5235.
5370 DO 504 K=1,NKTR 5236.
5371 TAUSUM(K)=0. 5237.
5372 DO 503 L=1,NL 5238.
5373 LK=LK+1 5239.
5374 503 TAUSUM(K)=TAUSUM(K)+TAULAP(LK) 5240.
5375 504 CONTINUE 5241.
5376 WRITE(6,6504) (TAUSUM(K),K=1,11) 5242.
5377 WRITE(6,6505) 5243.
5378 WRITE(6,6506) SUMK,(BGFLUX(K),K=1,11) 5244.
5379 WRITE(6,6507) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5245.
5380 NPAGE=0 5246.
5381 IF(NL.GT.13) NPAGE=1 5247.
5382 WRITE(6,6508) NPAGE 5248.
5383 WRITE(6,6509) (K,K=12,25) 5249.
5384 DO 505 N=1,NL 5250.
5385 L=NLP-N 5251.
5386 LI=NL*11+L 5252.
5387 LL=NL*24+L 5253.
5388 WRITE(6,6510) L,(TAULAP(I),I=LI,LL,NL) 5254.
5389 505 CONTINUE 5255.
5390 WRITE(6,6511) (TAUSUM(K),K=12,NKTR) 5256.
5391 WRITE(6,6512) (BGFLUX(K),K=12,NKTR) 5257.
5392 WRITE(6,6513) (BGFRAC(K),K=12,NKTR) 5258.
5393 C 5259.
5394 6501 FORMAT(1I1,'(5) TAULAP TABLE FOR THERMAL RADIATION: INCLUDES' 5260.
5395 + ,' WEAK OVERLAPPING GAS ABSORPTION BY' 5261.
5396 + ,' H2O, CO2, O3, N2O, CH4',T117,'LIST: TAULAP(LK)'/ 5262.
5397 + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5263.
5398 + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5264.
5399 + ,/T30,8('-'),3X,93('-')) 5265.
5400 6502 FORMAT(' LN PL DPL TLM K=' 5266.
5401 + ,I4,5X,'K=',I4,I10,5I9,3I10) 5267.
5402 6503 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5268.
5403 6504 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5269.
5404 6505 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5270.
5405 6506 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5271.
5406 6507 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5272.
5407 + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5273.
5408 6508 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5274.
5409 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5275.
5410 + /4X,92('-'),3X,34('-')) 5276.
5411 6509 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5277.
5412 6510 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5278.
5413 6511 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5279.
5414 6512 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5280.
5415 6513 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5281.
5416 GO TO 9999 5282.
5417 C 5283.
5418 C------------- 5284.
5419 600 CONTINUE 5285.
5420 C------------- 5286.
5421 C 5287.
5422 NPAGE=1 5288.
5423 IF(INDEX.LT.11) NPAGE=KPAGE 5289.
5424 SIGMA=5.6697D-08 5290.
5425 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5291.
5426 TGMEAN=SQRT(TGMEAN) 5292.
5427 TGMEAN=SQRT(TGMEAN) 5293.
5428 SIGT4=SIGMA*TGMEAN**4 5294.
5429 ITG=TGMEAN 5295.
5430 WTG=TGMEAN-ITG 5296.
5431 ITG=ITG-IT0 5297.
5432 SUMK=0.0 5298.
5433 DO 601 K=1,NKTR 5299.
5434 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5300.
5435 BGFRAC(K)=BGFLUX(K)/SIGT4 5301.
5436 SUMK=SUMK+BGFLUX(K) 5302.
5437 ITG=ITG+ITNEXT 5303.
5438 601 CONTINUE 5304.
5439 WRITE(6,6601) NPAGE 5305.
5440 WRITE(6,6602) (K,K=1,11) 5306.
5441 DO 602 N=1,NL 5307.
5442 L=NLP-N 5308.
5443 LI=L 5309.
5444 LL=NL*10+L 5310.
5445 WRITE(6,6603) L,PL(L),DPL(L),TLM(L),(TAUN(I),I=LI,LL,NL) 5311.
5446 602 CONTINUE 5312.
5447 LK=0 5313.
5448 DO 604 K=1,NKTR 5314.
5449 TAUSUM(K)=TAUSL(K) 5315.
5450 DO 603 L=1,NL 5316.
5451 LK=LK+1 5317.
5452 603 TAUSUM(K)=TAUSUM(K)+TAUN(LK) 5318.
5453 604 CONTINUE 5319.
5454 WRITE(6,6604) (TAUSL(K),K=1,11) 5320.
5455 WRITE(6,6605) (TAUSUM(K),K=1,11) 5321.
5456 WRITE(6,6606) SUMK,(BGFLUX(K),K=1,11) 5322.
5457 WRITE(6,6607) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5323.
5458 NPAGE=0 5324.
5459 IF(NL.GT.13) NPAGE=1 5325.
5460 WRITE(6,6608) NPAGE 5326.
5461 WRITE(6,6609) (K,K=12,25) 5327.
5462 DO 605 N=1,NL 5328.
5463 L=NLP-N 5329.
5464 LI=NL*11+L 5330.
5465 LL=NL*24+L 5331.
5466 WRITE(6,6610) L,(TAUN(I),I=LI,LL,NL) 5332.
5467 605 CONTINUE 5333.
5468 WRITE(6,6611) ( TAUSL(K),K=12,NKTR) 5334.
5469 WRITE(6,6612) (TAUSUM(K),K=12,NKTR) 5335.
5470 WRITE(6,6613) (BGFLUX(K),K=12,NKTR) 5336.
5471 WRITE(6,6614) (BGFRAC(K),K=12,NKTR) 5337.
5472 C 5338.
5473 6601 FORMAT(1I1,'(6) TAU TABLE FOR THERMAL RADIATION: INCLUDES ANY' 5339.
5474 + ,' SPECIFIED OVERLAP, CLOUD & AEROSOL ABSORPTION' 5340.
5475 + ,T117,'TAUN(LK),TAUSL(L)'/ 5341.
5476 + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5342.
5477 + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5343.
5478 + ,/T30,8('-'),3X,93('-')) 5344.
5479 6602 FORMAT(' LN PL DPL TLM K=' 5345.
5480 + ,I4,5X,'K=',I4,I10,5I9,3I10) 5346.
5481 6603 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5347.
5482 6604 FORMAT(/13X,'SURFACE LAYER=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5348.
5483 6605 FORMAT(/13X,'COLUMN AMOUNT=',F10.3,F11.3,F10.3,5F9.3,3F10.3) 5349.
5484 6606 FORMAT(/1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5350.
5485 6607 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5351.
5486 + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5352.
5487 6608 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5353.
5488 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5354.
5489 + /4X,92('-'),3X,34('-')) 5355.
5490 6609 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5356.
5491 6610 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5357.
5492 6611 FORMAT(/1X,'SL',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5358.
5493 6612 FORMAT(/1X,'CA',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5359.
5494 6613 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5360.
5495 6614 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5361.
5496 GO TO 9999 5362.
5497 C 5363.
5498 C------------- 5364.
5499 700 CONTINUE 5365.
5500 C------------- 5366.
5501 C 5367.
5502 NPAGE=1 5368.
5503 IF(INDEX.LT.11) NPAGE=KPAGE 5369.
5504 SIGMA=5.6697D-08 5370.
5505 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5371.
5506 TGMEAN=SQRT(TGMEAN) 5372.
5507 TGMEAN=SQRT(TGMEAN) 5373.
5508 SIGT4=SIGMA*TGMEAN**4 5374.
5509 ITG=TGMEAN 5375.
5510 WTG=TGMEAN-ITG 5376.
5511 ITG=ITG-IT0 5377.
5512 SUMK=0.0 5378.
5513 DO 701 K=1,NKTR 5379.
5514 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5380.
5515 BGFRAC(K)=BGFLUX(K)/SIGT4 5381.
5516 SUMK=SUMK+BGFLUX(K) 5382.
5517 ITG=ITG+ITNEXT 5383.
5518 701 CONTINUE 5384.
5519 WRITE(6,6701) NPAGE 5385.
5520 WRITE(6,6702) (K,K=1,11) 5386.
5521 DO 702 N=1,NL 5387.
5522 L=NLP-N 5388.
5523 WRITE(6,6703) L,PL(L),DPL(L),TLM(L),(TRAEXT(L,K),K=1,11) 5389.
5524 702 CONTINUE 5390.
5525 DO 704 K=1,NKTR 5391.
5526 TAUSUM(K)=0. 5392.
5527 DO 703 L=1,NL 5393.
5528 703 TAUSUM(K)=TAUSUM(K)+TRAEXT(L,K) 5394.
5529 704 CONTINUE 5395.
5530 WRITE(6,6704) (TAUSUM(K),K=1,11) 5396.
5531 WRITE(6,6705) 5397.
5532 WRITE(6,6706) SUMK,(BGFLUX(K),K=1,11) 5398.
5533 WRITE(6,6707) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5399.
5534 NPAGE=0 5400.
5535 IF(NL.GT.13) NPAGE=1 5401.
5536 WRITE(6,6708) NPAGE 5402.
5537 WRITE(6,6709) (K,K=12,25) 5403.
5538 DO 705 N=1,NL 5404.
5539 L=NLP-N 5405.
5540 WRITE(6,6710) L,(TRAEXT(L,K),K=12,NKTR) 5406.
5541 705 CONTINUE 5407.
5542 WRITE(6,6711) (TAUSUM(K),K=12,NKTR) 5408.
5543 WRITE(6,6712) (BGFLUX(K),K=12,NKTR) 5409.
5544 WRITE(6,6713) (BGFRAC(K),K=12,NKTR) 5410.
5545 C 5411.
5546 6701 FORMAT(1I1,'(7) AEROSOL TAU TABLE FOR THERMAL RADIATION:' 5412.
5547 + ,' CLOUD & AEROSOL ABSORPTION' 5413.
5548 + ,T116,'LIST: TRAEXT(L,K)'/ 5414.
5549 + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5415.
5550 + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5416.
5551 + ,/T30,8('-'),3X,93('-')) 5417.
5552 6702 FORMAT(' LN PL DPL TLM K=' 5418.
5553 + ,I4,5X,'K=',I4,I10,5I9,3I10) 5419.
5554 6703 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5420.
5555 6704 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5421.
5556 6705 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5422.
5557 6706 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5423.
5558 6707 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5424.
5559 + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5425.
5560 6708 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5426.
5561 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5427.
5562 + /4X,92('-'),3X,34('-')) 5428.
5563 6709 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5429.
5564 6710 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5430.
5565 6711 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5431.
5566 6712 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5432.
5567 6713 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5433.
5568 GO TO 9999 5434.
5569 C 5435.
5570 C------------- 5436.
5571 800 CONTINUE 5437.
5572 C------------- 5438.
5573 C 5439.
5574 NPAGE=1 5440.
5575 IF(INDEX.LT.11) NPAGE=KPAGE 5441.
5576 WRITE(6,6801) NPAGE 5442.
5577 DO 802 K=1,NKSR 5443.
5578 SUM1(K)=0. 5444.
5579 SUM2(K)=0. 5445.
5580 SUM3(K)=0. 5446.
5581 DO 801 L=1,NL 5447.
5582 SUM1(K)=SUM1(K)+EXTAER(L,K) 5448.
5583 SUM2(K)=SUM2(K)+SCTAER(L,K) 5449.
5584 SUM3(K)=SUM3(K)+SCTAER(L,K)*COSAER(L,K) 5450.
5585 801 PI0AER(L,K)=SCTAER(L,K)/(EXTAER(L,K)+1.E-10) 5451.
5586 SUM3(K)=SUM3(K)/(SUM2(K)+1.E-10) 5452.
5587 SUM0(K)=SUM2(K)/(SUM1(K)+1.E-10) 5453.
5588 802 CONTINUE 5454.
5589 WRITE(6,6802) (K,K=1,6),(K,K=1,6) 5455.
5590 DO 803 N=1,NL 5456.
5591 L=NLP-N 5457.
5592 WRITE(6,6803) L,PLB(L),HLB(L) 5458.
5593 + ,(EXTAER(L,J),J=1,6),(SCTAER(L,J),J=1,6) 5459.
5594 803 CONTINUE 5460.
5595 WRITE(6,6804) (SUM1(K),K=1,NKSR),(SUM2(K),K=1,NKSR) 5461.
5596 NPAGE=0 5462.
5597 IF(NL.GT.13) NPAGE=1 5463.
5598 WRITE(6,6805) NPAGE 5464.
5599 WRITE(6,6806) (K,K=1,6),(K,K=1,6) 5465.
5600 DO 804 N=1,NL 5466.
5601 L=NLP-N 5467.
5602 WRITE(6,6807) L,PL(L),DPL(L) 5468.
5603 + ,(COSAER(L,J),J=1,6),(PI0AER(L,J),J=1,6) 5469.
5604 804 CONTINUE 5470.
5605 WRITE(6,6808) (SUM3(K),K=1,NKSR),(SUM0(K),K=1,NKSR) 5471.
5606 WRITE(6,6809) (SRBALB(K),K=1,NKSR) 5472.
5607 WRITE(6,6810) (SRXALB(K),K=1,NKSR) 5473.
5608 WRITE(6,6811) 5474.
5609 SUM=0. 5475.
5610 DO 806 J=1,5 5476.
5611 TAU55=0. 5477.
5612 DO 805 I=1,NAERO 5478.
5613 805 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5479.
5614 WRITE(6,6812) J,FGOLDH(J),TAU55 5480.
5615 806 SUM=SUM+TAU55 5481.
5616 WRITE(6,6813) SUM 5482.
5617 C 5483.
5618 6801 FORMAT(1I1,'(8) AEROSOL INPUT FOR SOLAR RADIATION:' 5484.
5619 + ,' AEROSOL RADIATIVE PROPERTIES' 5485.
5620 + ,T81,'LIST: EXTAER(L,K),SCTAER(L,K),COSAER(L,K),PIZERO(L,K)'5486.
5621 + //T42,'TAU -- EXTINCTION',T99,'TAU -- SCATTERING' 5487.
5622 + ,/T24,53('-'),4X,53('-')) 5488.
5623 6802 FORMAT(' LN PLB HLB K=',I3,5I9,7X,'K=',I3,5I9) 5489.
5624 6803 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5490.
5625 6804 FORMAT(/1X,T7,'COLUMN AMOUNT=',2X,6F9.6,3X,6F9.6) 5491.
5626 6805 FORMAT(1I1/T48,'COSBAR',T105,'PIZERO' 5492.
5627 + ,/T24,53('-'),4X,53('-')) 5493.
5628 6806 FORMAT(' LN PL DPL K=',I3,5I9,7X,'K=',I3,5I9) 5494.
5629 6807 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5495.
5630 6808 FORMAT(/1X,T7,'COLUMN MEAN=',2X,6F9.6,3X,6F9.6) 5496.
5631 6809 FORMAT(/1X,T7,'ALBEDO RSURFB=',2X,6F9.6,3X,6F9.6) 5497.
5632 6810 FORMAT( 1X,T7,'ALBEDO RSURFX=',2X,6F9.6,3X,6F9.6) 5498.
5633 GO TO 9999 5499.
5634 6811 FORMAT(///T44,'AEROSOL COMPOSITION AND TYPE MIX:' 5500.
5635 + ,T81,'FACTOR',6X,'VALUE',T107,'TAU(0.55)'/) 5501.
5636 6812 FORMAT(T81,'FGOLDH(',I1,') =',1P,E9.2,5X,0P,F7.4) 5502.
5637 6813 FORMAT(/T81,'SUM COLUMN TAU(0.55) =',F10.4) 5503.
5638 C 5504.
5639 C------------- 5505.
5640 900 CONTINUE 5506.
5641 C------------- 5507.
5642 C 5508.
5643 SIGMA=5.6697D-08 5509.
5644 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5510.
5645 TGMEAN=SQRT(TGMEAN) 5511.
5646 TGMEAN=SQRT(TGMEAN) 5512.
5647 SIGT4=SIGMA*TGMEAN**4 5513.
5648 ITG=TGMEAN 5514.
5649 WTG=TGMEAN-ITG 5515.
5650 ITG=ITG-IT0 5516.
5651 DO 901 K=1,NKTR 5517.
5652 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5518.
5653 BGFRAC(K)=BGFLUX(K)/SIGT4 5519.
5654 ITG=ITG+ITNEXT 5520.
5655 901 CONTINUE 5521.
5656 DO 910 NW=1,5 5522.
5657 DO 903 K=1,NKTR 5523.
5658 DO 902 L=1,NLP 5524.
5659 IF(NW.EQ.1) WFLB(L,K)=DFLB(L,K) 5525.
5660 IF(NW.EQ.2) WFLB(L,K)=UFLB(L,K) 5526.
5661 IF(NW.EQ.3) WFLB(L,K)=UFLB(L,K)-DFLB(L,K) 5527.
5662 IF(NW.GT.3.AND.L.GT.NL) GO TO 902 5528.
5663 IF(NW.EQ.4) WFLB(L,K)=WFLB(L+1,K)-WFLB(L,K) 5529.
5664 IF(NW.EQ.5.AND.ABS(TRFCRL(L)).LT.1.E-10) WFLB(L,K)=1.E-30 5530.
5665 IF(NW.EQ.5) WFLB(L,K)=WFLB(L,K)/(ABS(TRFCRL(L))+1.E-10) 5531.
5666 902 CONTINUE 5532.
5667 IF(NW.EQ.1) WFSL(K)=DFSL(K) 5533.
5668 IF(NW.EQ.2) WFSL(K)=UFSL(K) 5534.
5669 IF(NW.EQ.3) WFSL(K)=UFSL(K)-DFSL(K) 5535.
5670 IF(NW.EQ.4) WFSL(K)=WFSL(K)-UFLB(1,K)+DFLB(1,K) 5536.
5671 IF(NW.EQ.5.AND.ABS(TRSLCR).LT.1.E-10) WFSL(K)=1.E-30 5537.
5672 IF(NW.EQ.5) WFSL(K)=WFSL(K)/(ABS(TRSLCR)+1.E-10) 5538.
5673 903 CONTINUE 5539.
5674 DO 907 L=1,NLP 5540.
5675 IF(L.GT.NL.AND.NW.GT.3) GO TO 907 5541.
5676 ASUM1=0. 5542.
5677 BSUM1=0. 5543.
5678 CSUM1=0. 5544.
5679 DSUM1=0. 5545.
5680 ESUM1=0. 5546.
5681 FSUM1=0. 5547.
5682 SUM=0. 5548.
5683 DO 904 K=2,11 5549.
5684 ASUM1=ASUM1+ WFSL(K) 5550.
5685 BSUM1=BSUM1+ BGFEMT(K) 5551.
5686 CSUM1=CSUM1+BGFLUX(K) 5552.
5687 DSUM1=DSUM1+BGFRAC(K) 5553.
5688 ESUM1=ESUM1+TRCALB(K) 5554.
5689 FSUM1=FSUM1+ TRGALB(K) 5555.
5690 904 SUM=SUM+WFLB(L,K) 5556.
5691 SUM1(L)=SUM 5557.
5692 ASUM2=0. 5558.
5693 BSUM2=0. 5559.
5694 CSUM2=0. 5560.
5695 DSUM2=0. 5561.
5696 ESUM2=0. 5562.
5697 FSUM2=0. 5563.
5698 SUM=0. 5564.
5699 DO 905 K=12,21 5565.
5700 ASUM2=ASUM2+ WFSL(K) 5566.
5701 BSUM2=BSUM2+ BGFEMT(K) 5567.
5702 CSUM2=CSUM2+BGFLUX(K) 5568.
5703 DSUM2=DSUM2+BGFRAC(K) 5569.
5704 ESUM2=ESUM2+TRCALB(K) 5570.
5705 FSUM2=FSUM2+ TRGALB(K) 5571.
5706 905 SUM=SUM+WFLB(L,K) 5572.
5707 SUM2(L)=SUM 5573.
5708 ASUM3=0. 5574.
5709 BSUM3=0. 5575.
5710 CSUM3=0. 5576.
5711 DSUM3=0. 5577.
5712 ESUM3=0. 5578.
5713 FSUM3=0. 5579.
5714 SUM=0. 5580.
5715 DO 906 K=22,NKTR 5581.
5716 ASUM3=ASUM3+ WFSL(K) 5582.
5717 BSUM3=BSUM3+ BGFEMT(K) 5583.
5718 CSUM3=CSUM3+BGFLUX(K) 5584.
5719 DSUM3=DSUM3+BGFRAC(K) 5585.
5720 ESUM3=ESUM3+TRCALB(K) 5586.
5721 FSUM3=FSUM3+ TRGALB(K) 5587.
5722 906 SUM=SUM+WFLB(L,K) 5588.
5723 SUM3(L)=SUM 5589.
5724 907 CONTINUE 5590.
5725 C 5591.
5726 NPAGE=1 5592.
5727 WRITE(6,6901) NPAGE,NW,FTYPE(NW) 5593.
5728 WRITE(6,6902) (K,K=1,11) 5594.
5729 DO 908 N=1,NLP 5595.
5730 L=NLP+1-N 5596.
5731 IF(L.GT.NL.AND.NW.GT.3) GO TO 908 5597.
5732 SUML=SUM1(L)+SUM2(L)+SUM3(L)+WFLB(L,1) 5598.
5733 WRITE(6,6903) L,SUML,SUM1(L),SUM2(L),SUM3(L),(WFLB(L,K),K=1,11) 5599.
5734 908 CONTINUE 5600.
5735 SUMA=ASUM1+ASUM2+ASUM3+ WFSL(1) 5601.
5736 SUMB=BSUM1+BSUM2+BSUM3+ BGFEMT(1) 5602.
5737 SUMC=CSUM1+CSUM2+CSUM3+BGFLUX(1) 5603.
5738 SUMD=DSUM1+DSUM2+DSUM3+BGFRAC(1) 5604.
5739 SUME=ESUM1+ESUM2+ESUM3+TRCALB(1) 5605.
5740 SUMF=FSUM1+FSUM2+FSUM3+TRGALB(1) 5606.
5741 WRITE(6,6904) SUMA,ASUM1,ASUM2,ASUM3,( WFSL(K),K=1,11) 5607.
5742 WRITE(6,6905) SUMB,BSUM1,BSUM2,BSUM3,( BGFEMT(K),K=1,11) 5608.
5743 WRITE(6,6906) SUMC,CSUM1,CSUM2,CSUM3,(BGFLUX(K),K=1,11) 5609.
5744 WRITE(6,6907) SUMD,DSUM1,DSUM2,DSUM3,(BGFRAC(K),K=1,11) 5610.
5745 WRITE(6,6908) SUME,ESUM1,ESUM2,ESUM3,(TRCALB(K),K=1,11) 5611.
5746 WRITE(6,6909) SUMF,FSUM1,FSUM2,FSUM3,(TRGALB(K),K=1,11) 5612.
5747 NPAGE=0 5613.
5748 IF(NL.GT.13) NPAGE=1 5614.
5749 WRITE(6,6910) NPAGE 5615.
5750 WRITE(6,6911) (K,K=12,25) 5616.
5751 DO 909 N=1,NLP 5617.
5752 L=NLP+1-N 5618.
5753 IF(L.GT.NL.AND.NW.GT.3) GO TO 909 5619.
5754 WRITE(6,6912) L,(WFLB(L,K),K=12,NKTR) 5620.
5755 909 CONTINUE 5621.
5756 WRITE(6,6913) ( WFSL(K),K=12,NKTR) 5622.
5757 WRITE(6,6914) ( BGFEMT(K),K=12,NKTR) 5623.
5758 WRITE(6,6915) (BGFLUX(K),K=12,NKTR) 5624.
5759 WRITE(6,6916) (BGFRAC(K),K=12,NKTR) 5625.
5760 WRITE(6,6917) (TRCALB(K),K=12,NKTR) 5626.
5761 WRITE(6,6918) ( TRGALB(K),K=12,NKTR) 5627.
5762 910 CONTINUE 5628.
5763 C 5629.
5764 6901 FORMAT(1I1,'(9.',I1,') THERMAL RADIATION: K-DISTRIBUTION' 5630.
5765 + ,' BREAKDOWN FOR ',1A8,' FLUX'/ 5631.
5766 + /T8,'SUM PRINCIPAL REGION SUM',4X 5632.
5767 + ,'WINDOW',T66,'WATER VAPOR: PRINCIPAL ABSORBER REGION' 5633.
5768 + ,/T7,'-----',2X,20('-'),4X,6('-'),3X,87('-')) 5634.
5769 6902 FORMAT(1X,'LN TOTAL H2O CO2 O3 K=' 5635.
5770 + ,I2,5X,'K=',I2,9I9) 5636.
5771 6903 FORMAT( 1X,I2,F8.2,1X,3F7.2,F10.3,10F9.3) 5637.
5772 6904 FORMAT(/' SL',F8.2,1X,3F7.2,F10.3,10F9.3) 5638.
5773 6905 FORMAT(/' BG',F8.2,1X,3F7.2,F10.3,10F9.3) 5639.
5774 6906 FORMAT( ' PF',F8.2,1X,3F7.2,F10.3,10F9.3) 5640.
5775 6907 FORMAT( ' FR',F8.4,1X,3F7.4,F10.5,10F9.5) 5641.
5776 6908 FORMAT(/' AC',F8.2,1X,3F7.2,F10.3,10F9.3) 5642.
5777 6909 FORMAT( ' AG',F8.2,1X,3F7.2,F10.3,10F9.3) 5643.
5778 6910 FORMAT(1I1/T26,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5644.
5779 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5645.
5780 + /5X,89('-'),5X,34('-')) 5646.
5781 6911 FORMAT(1X,'LN K=',I4,9I9,7X,'K=',I3,3I9) 5647.
5782 6912 FORMAT( 1X,I2,1X,10F9.3,3X,4F9.3) 5648.
5783 6913 FORMAT(/' SL',1X,10F9.3,3X,4F9.3) 5649.
5784 6914 FORMAT(/' BG',1X,10F9.3,3X,4F9.3) 5650.
5785 6915 FORMAT( ' PF',1X,10F9.3,3X,4F9.3) 5651.
5786 6916 FORMAT( ' FR',1X,10F9.5,3X,4F9.5) 5652.
5787 6917 FORMAT(/' AC',1X,10F9.3,3X,4F9.3) 5653.
5788 6918 FORMAT( ' AG',1X,10F9.3,3X,4F9.3) 5654.
5789 RETURN 5655.
5790 C 5656.
5791 C------------- 5657.
5792 1000 CONTINUE 5658.
5793 C------------- 5659.
5794 C 5660.
5795 NPAGE=1 5661.
5796 IF(INDEX.LT.11) NPAGE=KPAGE 5662.
5797 WRITE(6,7001) NPAGE 5663.
5798 7001 FORMAT(1I1,'(10) BLOCK DATA AEROSOL PROPERTY SPECIFICATION:') 5664.
5799 9999 CONTINUE 5665.
5800 RETURN 5666.
5801 END 5667.
5802 SUBROUTINE SOLARZ(NG,KWRITE) 5668.
5803 #include "B83XX.COM" 5669.
5804 DIMENSION SRDATA(187),ZRDATA(187) 5730.
5805 EQUIVALENCE (SRDFLB(1),SRDATA(1)) 5731.
5806 c DOUBLE PRECISION XMU(50),WT(50) 5732.
5807 dimension XMU(50),WT(50)
5808 DATA NSRD/187/ 5733.
5809 DIMENSION NOFLUX(7) 5734.
5810 DATA NOFLUX/164,167,168,169,170,171,174/ 5735.
5811 C 5736.
5812 C------------------------------------- 5737.
5813 CALL GAUSST(NG,0.D0,1.D0,XMU,WT) 5738.
5814 C------------------------------------- 5739.
5815 DO 100 J=1,NG 5740.
5816 100 WT(J)=WT(J)*2.D0*XMU(J) 5741.
5817 C 5742.
5818 DO 110 I=1,NSRD 5743.
5819 110 ZRDATA(I)=0. 5744.
5820 C 5745.
5821 NORM=NORMS0 5746.
5822 ZCOS=COSZ 5747.
5823 C 5748.
5824 DO 130 J=1,NG 5749.
5825 COSZ=XMU(J) 5750.
5826 NORMS0=1 5751.
5827 C--------------- 5752.
5828 CALL SOLAR 5753.
5829 C--------------- 5754.
5830 DO 120 I=1,NSRD 5755.
5831 120 ZRDATA(I)=ZRDATA(I)+SRDATA(I)*WT(J) 5756.
5832 KPAGE=J-(J/2)*2 5757.
5833 IF(KWRITE.GT.1) CALL WRITER(3,KPAGE) 5758.
5834 130 CONTINUE 5759.
5835 C 5760.
5836 DO 150 I=1,NSRD 5761.
5837 FACTOR=0.25 5762.
5838 DO 140 K=1,7 5763.
5839 IF(I.EQ.NOFLUX(K)) FACTOR=1. 5764.
5840 140 CONTINUE 5765.
5841 IF(I.GT.176) FACTOR=1. 5766.
5842 150 SRDATA(I)=ZRDATA(I)*FACTOR 5767.
5843 COSZ=NG 5768.
5844 IF(NG.GT.9) COSZ=.1*NG 5769.
5845 COSZ=COSZ+NG/1000. 5770.
5846 KPAGE=1 5771.
5847 C 5772.
5848 NORMS0=100 5773.
5849 C 5774.
5850 IF(KWRITE.GT.0) CALL WRITER(13,KPAGE) 5775.
5851 C 5776.
5852 COSZ=ZCOS 5777.
5853 NORMS0=NORM 5778.
5854 C 5779.
5855 RETURN 5780.
5856 END 5781.
5857 SUBROUTINE GAUSST(NG,X1,X2,XP,WT) 5782.
5858 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 5783.
5859 DIMENSION XP(1),WT(1) 5784.
5860 real*8 pi, ps, dxl
5861 DATA PI,PS,DXL/3.141592653589793D0,1.013211836423378D-01,1.D-16/ 5785.
5862 XMID=(X2+X1)/2.D0 5786.
5863 XDIF=X2-X1 5787.
5864 XHAF=XDIF/2.D0 5788.
5865 DNG=NG 5789.
5866 NN=NG/2 5790.
5867 N2=NN*2 5791.
5868 IF(N2.EQ.NG) GO TO 110 5792.
5869 XP(NN+1)=XMID 5793.
5870 WT(NN+1)=XDIF 5794.
5871 IF(NG.LT.2) RETURN 5795.
5872 PN=1.D0 5796.
5873 N=0 5797.
5874 100 N=N+2 5798.
5875 DN=N 5799.
5876 DM=DN-1.D0 5800.
5877 PN=PN*(DM/DN) 5801.
5878 IF(N.LT.N2) GO TO 100 5802.
5879 WT(NN+1)=XDIF/(DNG*PN)**2 5803.
5880 110 I=0 5804.
5881 C=PI/DSQRT(DNG*(DNG+1.D0)+0.5D0-PS)/105.D0 5805.
5882 120 I=I+1 5806.
5883 DI=I 5807.
5884 Z=PS/(4.D0*DI-1.D0)**2 5808.
5885 ZZ=(105.D0+Z*(210.D0-Z*(2170.D0-Z*(105812.D0-12554474.D0*Z)))) 5809.
5886 X=DCOS(ZZ*C*(DI-0.25D0)) 5810.
5887 130 N=1 5811.
5888 DM=1.D0 5812.
5889 PNI=1.D0 5813.
5890 PNJ=X 5814.
5891 140 N=N+1 5815.
5892 DN=N 5816.
5893 PNK=((DM+DN)*X*PNJ-DM*PNI)/DN 5817.
5894 PNI=PNJ 5818.
5895 PNJ=PNK 5819.
5896 DM=DN 5820.
5897 IF(N.LT.NG) GO TO 140 5821.
5898 DX=PNJ*(1.D0-X*X)/DNG/(PNI-X*PNJ) 5822.
5899 X=X-DX 5823.
5900 IF(DABS(DX).GT.DXL) GO TO 130 5824.
5901 J=NG+1-I 5825.
5902 XP(I)=XMID-XHAF*X 5826.
5903 XP(J)=XMID+XHAF*X 5827.
5904 WT(I)=XDIF*(1.D0-X*X)/(DNG*PNI)**2 5828.
5905 WT(J)=WT(I) 5829.
5906 IF(I.LT.NN) GO TO 120 5830.
5907 RETURN 5831.
5908 END 5832.
5909 SUBROUTINE SETATM 5833.
5910 #include "B83XX.COM" 5834.
5911 DIMENSION NL4(4),PLB4(40,4) 5877.
5912 DATA NL4/12,12,24,35/ 5878.
5913 DATA PLB4/ 5879.
5914 1 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 5880.
5915 1 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 5881.
5916 1 1.E-05, 27*0., 5882.
5917 C 5883.
5918 2 984.0000, 934.0000, 854.0000, 720.0000, 550.0000, 390.0000, 5884.
5919 2 255.0000, 150.0000, 70.0000, 10.0000, 5.0000, 2.0000, 5885.
5920 2 1.E-05, 27*0., 5886.
5921 C 5887.
5922 3 1013.2500, 988.8846, 956.9068, 910.2775, 820.4963, 683.6775, 5888.
5923 3 521.6665, 356.3138, 209.4467, 102.9552, 47.7944, 22.1797, 5889.
5924 3 10.29439, 4.77932, 2.21785, 1.01932, 0.46761, 0.21156, 5890.
5925 3 0.092671, 0.047500, 0.021885, 0.010000, 0.005000, 0.002000, 5891.
5926 3 1.00E-05, 15*0.0, 5892.
5927 C 5893.
5928 4 1013.2500,1000.0000, 950.0000, 900.0000, 850.0000, 800.0000, 5894.
5929 4 750.0000, 700.0000, 650.0000, 600.0000, 550.0000, 500.0000, 5895.
5930 4 450.0000, 400.0000, 350.0000, 300.0000, 250.0000, 200.0000, 5896.
5931 4 150.0000, 100.0000, 50.0000, 20.0000, 10.0000, 5.0000, 5897.
5932 4 2.0000, 1.0000, 0.5000, 0.2000, 0.1000, 0.0500, 5898.
5933 4 0.0200, 0.0100, 0.0050, 0.0020, 0.0010, 1.E-05, 5899.
5934 4 4*0./ 5900.
5935 C 5901.
5936 LAST=LASTVC 5902.
5937 LMAG=100000 5903.
5938 C ------------------------------------------ 5904.
5939 C NLAY: ATMOSPHERIC LAYERING SPECIFICATION 5905.
5940 C ------------------------------------------ 5906.
5941 NLAY=LAST/LMAG 5907.
5942 LAST=LAST-LMAG*NLAY 5908.
5943 LMAG=LMAG/10 5909.
5944 C 5910.
5945 KSCALE=0 5911.
5946 IF(NLAY.GT.9) KSCALE=1 5912.
5947 IF(NLAY.GT.9) NLAY=NLAY-10 5913.
5948 C 5914.
5949 IF(NLAY.LT.1.OR.NLAY.GT.8) GO TO 20 5915.
5950 GO TO (10,10,10,10,12,14,16,18),NLAY 5916.
5951 10 NL=NL4(NLAY) 5917.
5952 NLP=NL+1 5918.
5953 C (1-4)=(12,12,24,35 PRESSURE SPECIFICATIONS)5919.
5954 C -------------------------------------------5920.
5955 DO 11 N=1,NLP 5921.
5956 11 PLB(N)=PLB4(N,NLAY) 5922.
5957 GO TO 20 5923.
5958 C (5)=(1-D MODEL LAYER SPECIFICATION)5924.
5959 C -----------------------------------5925.
5960 12 NL=18 5926.
5961 DO 13 N=1,NL 5927.
5962 HLB(N)=N-1+2*(N/7) 5928.
5963 IF(N.GT. 8) HLB(N)=4*N-24-N/11-N/12 5929.
5964 13 IF(N.GT.13) HLB(N)=30+(N-14)*5 5930.
5965 HLB( 1)=1.0E-10 5931.
5966 HLB(19)=99.99 5932.
5967 GO TO 20 5933.
5968 C (6)=(LINE-BY-LINE LAYER SPECIFICATION)5934.
5969 C --------------------------------------5935.
5970 14 NL=30 5936.
5971 DO 15 N=1,NL 5937.
5972 HLB(N)=N-1+(N-17)*(N/17) 5938.
5973 15 IF(N.GT.20) HLB(N)=20+(N-20)*5 5939.
5974 HLB( 1)=1.0E-10 5940.
5975 HLB(31)=99.99 5941.
5976 GO TO 20 5942.
5977 C (7)=(MCCLATCHEY LAYER SPECIFICATION)5943.
5978 C ------------------------------------5944.
5979 16 NL=32 5945.
5980 DO 17 N=1,NL 5946.
5981 HLB(N)=N-1 5947.
5982 17 IF(N.GT.25) HLB(N)=25+5*(N-26) 5948.
5983 HLB( 1)=1.0E-10 5949.
5984 HLB(32)=70.00 5950.
5985 HLB(33)=99.99 5951.
5986 GO TO 20 5952.
5987 C (8)=(HI-RES LAYER SPECIFICATION)5953.
5988 C --------------------------------5954.
5989 18 NL=39 5955.
5990 DO 19 N=1,NL 5956.
5991 HLB(N)=N-1 5957.
5992 IF(N.GT.21) HLB(N)=20+(N-21)*2 5958.
5993 IF(N.GT.31) HLB(N)=40+(N-31)*5 5959.
5994 19 IF(N.GT.37) HLB(N)=70+(N-37)*10 5960.
5995 HLB( 1)=1.0E-10 5961.
5996 HLB(40)=99.99 5962.
5997 C 5963.
5998 C ------------------------------------------- 5964.
5999 C NATM: ATMOSPHERIC STRUCTURE SPECIFICATION 5965.
6000 C ------------------------------------------- 5966.
6001 20 NATM=LAST/LMAG 5967.
6002 LAST=LAST-LMAG*NATM 5968.
6003 LMAG=LMAG/10 5969.
6004 C 5970.
6005 IF(KSCALE.NE.1) GO TO 24 5971.
6006 C 5972.
6007 C SIGMA LEVEL RESCALING OF PRESSURES RELATIVE TO PSIG05973.
6008 C ----------------------------------------------------5974.
6009 C 5975.
6010 NLMOD=NL-LAYRAD 5976.
6011 IF(NLAY.GT.4) GO TO 22 5977.
6012 PTOP=PLB(NLMOD+1) 5978.
6013 PBOT=PLB(1) 5979.
6014 DO 21 L=1,NLMOD 5980.
6015 PSIG(L)=(PLB(L)-PTOP)/(PBOT-PTOP) 5981.
6016 21 PLB(L) =PSIG(L)*(PSIG0-PTOP)+PTOP 5982.
6017 PSIG(NLMOD+1)=0. 5983.
6018 GO TO 24 5984.
6019 C 5985.
6020 C SIGMA LEVEL RESCALING OF HEIGHTS RELATIVE TO PSIG05986.
6021 C --------------------------------------------------5987.
6022 22 HTOP=HLB(NLMOD+1) 5988.
6023 HBOT=HLB(1) 5989.
6024 DO 23 L=1,NLMOD 5990.
6025 PSIG(L)=(HLB(L)-HTOP)/(HBOT-HTOP) 5991.
6026 23 HLB(L) =PSIG(L)*(PSIG0-HTOP)+HTOP 5992.
6027 PSIG(NLMOD+1)=0. 5993.
6028 24 CONTINUE 5994.
6029 C 5995.
6030 NLP=NL+1 5996.
6031 NPHD=1+NLAY/5 5997.
6032 N=1 5998.
6033 IF(NPHD.EQ.1) P=PLB(N) 5999.
6034 IF(NPHD.EQ.2) H=HLB(N) 6000.
6035 CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6001.
6036 IF(NPHD.EQ.1) HLB(N)=H 6002.
6037 IF(NPHD.EQ.2) PLB(N)=P 6003.
6038 PB=P 6004.
6039 TB=T 6005.
6040 OB=OCM 6006.
6041 WB=WCM 6007.
6042 DO 25 N=1,NL 6008.
6043 IF(NPHD.EQ.1) P=PLB(N+1) 6009.
6044 IF(NPHD.EQ.2) H=HLB(N+1) 6010.
6045 CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6011.
6046 IF(NPHD.EQ.1) HLB(N+1)=H 6012.
6047 IF(NPHD.EQ.2) PLB(N+1)=P 6013.
6048 TLB(N)=TB 6014.
6049 TLT(N)=T 6015.
6050 TLM(N)=0.5*(T+TB) 6016.
6051 U0GAS(N,1)=WB-WCM 6017.
6052 U0GAS(N,3)=OB-OCM 6018.
6053 SHL(N)=U0GAS(N,1)/(U0GAS(N,1)+1268.75*(PB-P)) 6019.
6054 EQ=0.5*(PB+P)*SHL(N)/(0.662+0.338*SHL(N)) 6020.
6055 C$ EQ=0.5*(PB+P)*SHL(N)/(0.622+0.338*SHL(N)) 6021.
6056 ES=10.0**(9.4051-2353.0/TLM(N)) 6022.
6057 RHL(N)=EQ/ES 6023.
6058 PB=P 6024.
6059 TB=T 6025.
6060 OB=OCM 6026.
6061 25 WB=WCM 6027.
6062 TLB(NLP)=TLT(NL) 6028.
6063 TSL=TLB(1) 6029.
6064 TGO=TLB(1) 6030.
6065 TGE=TLB(1) 6031.
6066 TGOI=TGO-5. 6032.
6067 TGLI=TGE-5. 6033.
6068 C ---------------------------------- 6034.
6069 C NSUR: SURFACE TYPE SPECIFICATION 6035.
6070 C ---------------------------------- 6036.
6071 30 NSUR=LAST/LMAG 6037.
6072 LAST=LAST-LMAG*NSUR 6038.
6073 LMAG=LMAG/10 6039.
6074 C 6040.
6075 IF(NSUR.EQ.0) GO TO 40 6041.
6076 POCEAN=0. 6042.
6077 PEARTH=0. 6043.
6078 POICE =0. 6044.
6079 PLICE =0. 6045.
6080 AGESN =0. 6046.
6081 SNOWE =0. 6047.
6082 SNOWOI=0. 6048.
6083 SNOWLI=0. 6049.
6084 C 6050.
6085 IF(NSUR.EQ.1) POCEAN=1. 6051.
6086 IF(NSUR.EQ.2) PEARTH=1. 6052.
6087 IF(NSUR.EQ.3) POICE =1. 6053.
6088 IF(NSUR.EQ.4) PLICE =1. 6054.
6089 IF(NSUR.EQ.5) PEARTH=1. 6055.
6090 IF(NSUR.EQ.5) SNOWE =1. 6056.
6091 IF(NSUR.GT.5) PLICE =1. 6057.
6092 IF(NSUR.EQ.6) SNOWLI=1. 6058.
6093 IF(NSUR.LT.7) GO TO 40 6059.
6094 BXAVIS=0. 6060.
6095 BXANIR=0. 6061.
6096 IF(NSUR.EQ.7) BXAVIS=1. 6062.
6097 IF(NSUR.GT.7) BXANIR=1. 6063.
6098 IF(NSUR.EQ.9) BXAVIS=1. 6064.
6099 DO 31 I=1,5 6065.
6100 SRBXAL(I,1)=BXANIR 6066.
6101 31 SRBXAL(I,2)=BXANIR 6067.
6102 SRBXAL(6,1)=BXAVIS 6068.
6103 SRBXAL(6,2)=BXAVIS 6069.
6104 IF(KALVIS.GT.0) SRBXAL(4,1)=SRBXAL(6,1) 6070.
6105 IF(KALVIS.GT.0) SRBXAL(4,2)=SRBXAL(6,2) 6071.
6106 C 6072.
6107 C ---------------------------------------- 6073.
6108 C NTRA: TRACER COMPOSITION SPECIFICATION 6074.
6109 C ---------------------------------------- 6075.
6110 40 NTRA=LAST/LMAG 6076.
6111 LAST=LAST-LMAG*NTRA 6077.
6112 LMAG=LMAG/10 6078.
6113 C 6079.
6114 TAUT55=1.0 6080.
6115 NTRACE=1 6081.
6116 IF(NTRA.LT.1) TAUT55=0. 6082.
6117 IF(NTRA.LT.1) NTRACE=0 6083.
6118 ITR(1)=NTRA 6084.
6119 DO 41 L=1,NL 6085.
6120 41 TRACER(L,1)=TAUT55*(PLB(L)-PLB(L+1))/PLB(1) 6086.
6121 C 6087.
6122 C ------------------------------------- 6088.
6123 C NVEG: VEGETATION TYPE SPECIFICATION 6089.
6124 C ------------------------------------- 6090.
6125 50 NVEG=LAST/LMAG 6091.
6126 LAST=LAST-LMAG*NVEG 6092.
6127 LMAG=LMAG/10 6093.
6128 C 6094.
6129 DO 51 K=1,11 6095.
6130 51 PVT(K)=0. 6096.
6131 IF(NVEG.LT.1) GO TO 60 6097.
6132 PVT(NVEG)=1. 6098.
6133 C ------------------------------------- 6099.
6134 C NCLD: CLOUD LAYER,TAU SPECIFICATION 6100.
6135 C ------------------------------------- 6101.
6136 60 NCLD=LAST 6102.
6137 DO 61 L=1,NL 6103.
6138 61 CLDTAU(L)=0. 6104.
6139 IF(NCLD.GT.0) CLDTAU(NCLD)=64./2**NCLD 6105.
6140 RETURN 6106.
6141 END 6107.
6142 SUBROUTINE SETFOR(NFTFOR) 6108.
6143 #include "B83XX.COM" 6109.
6144 C COMMON/TMINOR/FCO2,FN2O,FCH4,FF11,FF12,FVOL,FSUN 6150.
6145 C 6151.
6146 C-----------------------------------------------------------------------6152.
6147 C EXTERNAL FORCING FOR CO2,N2O,CH4,F11,F12,VOLCANIC AER,SOLAR CONST6153.
6148 C STARTING FROM JAN 1,1880 PROJECTED THROUGH DEC 31,2100 6154.
6149 C INPUT FORCING DATA READ IN FROM DISK DATA DSN=CLIM.RUN.FORCING 6155.
6150 C 6156.
6151 C CALL SETFOR TO READ IN AND/OR INITIALIZE DATA AND/OR RESET PARAMS6157.
6152 C 6158.
6153 C IF(NFTFOR.GT.0) FORCING DATA WILL BE READ IN FROM DISKUNIT=NFTFOR6159.
6154 C IF(NFTFOR.EQ.0) NO DATA READ, SELECT CONSTITUENTS FOR EXT FORCING6160.
6155 C IF(NFTFOR.LT.0) NO DATA READ, RESET ONLY SOL CONST REFERENCE VALU6161.
6156 C-----------------------------------------------------------------------6162.
6157 C 6163.
6158 DIMENSION YEAR(221),SCO2(221),SCH4(221),SN2O(221) 6164.
6159 DIMENSION SF11(221),SF12(221),UPPM(221) 6165.
6160 DIMENSION TAUS(12,221),TAUM(2652) 6166.
6161 EQUIVALENCE (TAUS(1,1),TAUM(1)) 6167.
6162 C 6168.
6163 DIMENSION INDEX(9),INFOR(9) 6169.
6164 EQUIVALENCE (INFOR(1),KVOL),(INFOR(2),KCO2),(INFOR(3),KXXX) 6170.
6165 EQUIVALENCE (INFOR(4),KSUN),(INFOR(5),KYYY),(INFOR(6),KN2O) 6171.
6166 EQUIVALENCE (INFOR(7),KCH4),(INFOR(8),KF11),(INFOR(9),KF12) 6172.
6167 C 6173.
6168 DIMENSION DMO(12),JDY(12) 6174.
6169 DATA DMO/31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31./ 6175.
6170 DATA JDY/31,59,90,120,151,181,212,243,278,304,334,365/ 6176.
6171 C 6177.
6172 IF(NFTFOR.LT.0) GO TO 150 6178.
6173 IF(NFTFOR.LT.1) GO TO 110 6179.
6174 C 6180.
6175 REWIND NFTFOR 6181.
6176 READ (NFTFOR) NOUT,NEND,KFS,KCS,(YEAR(L),SCO2(L),SCH4(L),SN2O(L) 6182.
6177 + ,SF11(L),SF12(L),UPPM(L),(TAUS(K,L),K=1,12),L=1,221)6183.
6178 + ,IDATE 6184.
6179 REWIND NFTFOR 6184.5
6180 C 6185.
6181 ID5(5)=IDATE+10*KFS+KCS 6186.
6182 C 6187.
6183 C-----------------------------------------------------------------------6188.
6184 C REFERENCE YEAR IS (1958) WHERE FULGAS(K)=1 FOR CO2,N2O,CH4,F11,F126189.
6185 C MEAN 1958 BACKGROUND CO2=315 N2O=.295 CH4=1.4 F11=8.E-6 F12=25.E-66190.
6186 C GAS PPM IS LINEARLY INTERPOLATED (MEAN ANNUAL PPM OCCURS JDAY=183)6191.
6187 C 6192.
6188 C BACKGROUND TAU STRATAER=0.012 (VOLCANIC CONTRIBUTION IS ADDITIVE)6193.
6189 C 6194.
6190 C KFS=IDENTIFIER FOR F11,F12 ABUNDANCE SCENARIOS 6195.
6191 C KCS=IDENTIFIER FOR CO2 ABUNDANCE SCENARIOS 6196.
6192 C ID5(5)=IDATE+10*KFS+KCS IS THE FORCING DATA SET IDENTIFIER 6197.
6193 C-----------------------------------------------------------------------6198.
6194 C 6199.
6195 RRCO2=PPMV58(2) 6200.
6196 RCH4=PPMV58(7) 6201.
6197 RN2O=PPMV58(6) 6202.
6198 C (F11,F12 EXTERNAL FORCING DATA ARE IN PPM) 6203.
6199 RF11=PPMV58(8)*1000. 6204.
6200 RF12=PPMV58(9)*1000. 6205.
6201 C 6206.
6202 RVOL=AGOLDH(1,1) 6207.
6203 C-----------------------------------------------------------------------6208.
6204 C 6209.
6205 C SELECT CONSTITUENTS FOR WHICH EXTERNAL FORCING WILL BE IMPLEMENTED6210.
6206 C 6211.
6207 C KFORCE IS AN INTEGER UP TO NINE DIGITS LONG, SUCH THAT EACH DIGIT6212.
6208 C IS AN ON/OFF SWITCH FOR IMPLEMENTING EXTERNAL FORCING FOR:6213.
6209 C 6214.
6210 C (1) (2) (4) (6) (7) (8) (9) CODED DIGITS 6215.
6211 C VOL-AER, CO2, SOL-CON, N2O, CH4, F11, F12, RESPECTIVELY. 6216.
6212 C (THE DIGITS (3) & (5)...ARE NOT USED)6217.
6213 C 6218.
6214 C EXAMPLE: 1206789 SELECTS FORCING FOR ALL EXCEPT SOL CONST6219.
6215 C (ORDER OR REPETITION OF DIGITS IS NOT IMPORTANT)6220.
6216 C-----------------------------------------------------------------------6221.
6217 110 KFOR=KFORCE 6222.
6218 KMAG=100000000 6223.
6219 DO 120 K=1,9 6224.
6220 KF=KFOR/KMAG 6225.
6221 INDEX(K)=KF 6226.
6222 KFOR=KFOR-KF*KMAG 6227.
6223 120 KMAG=KMAG/10 6228.
6224 DO 130 K=1,9 6229.
6225 130 INFOR(K)=0 6230.
6226 DO 140 K=1,9 6231.
6227 IF(INDEX(K).EQ.0) GO TO 140 6232.
6228 INFOR(INDEX(K))=1 6233.
6229 140 CONTINUE 6234.
6230 C 6235.
6231 C-----------------------------------------------------------------------6236.
6232 C SELECT REFERENCE SOLAR CONSTANT (S0) AS PASSED IN COMMON/RADCOM/6237.
6233 C-----------------------------------------------------------------------6238.
6234 C 6239.
6235 150 S00=S0 6240.
6236 RETURN 6241.
6237 C 6242.
6238 C----------------- 6243.
6239 ENTRY GETFOR 6244.
6240 C----------------- 6245.
6241 C 6246.
6242 C-----------------------------------------------------------------------6247.
6243 C EXTERNAL FORCING RETURNED FOR CONSTITUENTS PRESELECTED IN SETFOR6248.
6244 C 6249.
6245 C RADCOM INPUT DATA: JYEAR, JDAY 6250.
6246 C 6251.
6247 C RADCOM OUTPUT DATA: FULGAS(K),K=2,6,7,8,9; FGOLDH(1), S06252.
6248 C 6253.
6249 C-----------------------------------------------------------------------6254.
6250 C 6255.
6251 JDM=JDAY 6256.
6252 DO 210 JMONTH=1,12 6257.
6253 IF(JDAY.GT.JDY(JMONTH)) GO TO 210 6258.
6254 GO TO 220 6259.
6255 210 JDM=JDAY-JDY(JMONTH) 6260.
6256 JMONTH=12 6261.
6257 220 MO=JMONTH+(JYEAR-1880)*12 6262.
6258 IF(MO.LT. 1) MO=1 6263.
6259 IF(MO.GT.2651) MO=2651 6264.
6260 C 6265.
6261 FRACYR=(JDAY-183)/365. 6266.
6262 FRACMO=JDM/DMO(JMONTH) 6267.
6263 C 6268.
6264 NY=JYEAR-1880+1 6269.
6265 IF(JDAY.LT.183) NY=NY-1 6270.
6266 IF(JDAY.LT.183) FRACYR=FRACYR+0.5 6271.
6267 IF(NY.LT. 1) NY=1 6272.
6268 IF(NY.GT.220) NY=220 6273.
6269 FCO2=SCO2(NY)+(SCO2(NY+1)-SCO2(NY))*FRACYR 6274.
6270 FCH4=SCH4(NY)+(SCH4(NY+1)-SCH4(NY))*FRACYR 6275.
6271 FN2O=SN2O(NY)+(SN2O(NY+1)-SN2O(NY))*FRACYR 6276.
6272 FF11=SF11(NY)+(SF11(NY+1)-SF11(NY))*FRACYR 6277.
6273 FF12=SF12(NY)+(SF12(NY+1)-SF12(NY))*FRACYR 6278.
6274 FSUN=UPPM(NY)+(UPPM(NY+1)-UPPM(NY))*FRACYR 6279.
6275 FVOL=TAUM(MO)+(TAUM(MO+1)-TAUM(MO))*FRACMO 6280.
6276 C 6281.
6277 C-----------------------------------------------------------------------6282.
6278 C OUTPUT FORCING DATA6283.
6279 C-----------------------------------------------------------------------6284.
6280 C 6285.
6281 IF(KCO2.GT.0) FULGAS(2)=FCO2/RRCO2 6286.
6282 IF(KN2O.GT.0) FULGAS(6)=FN2O/RN2O 6287.
6283 IF(KCH4.GT.0) FULGAS(7)=FCH4/RCH4 6288.
6284 IF(KF11.GT.0) FULGAS(8)=FF11/RF11 6289.
6285 IF(KF12.GT.0) FULGAS(9)=FF12/RF12 6290.
6286 IF(KVOL.GT.0) FGOLDH(1)=(RVOL+FVOL)/RVOL 6291.
6287 IF(KSUN.GT.0) S0=S00+S00*0.03*(FSUN-0.2) 6292.
6288 C 6293.
6289 RETURN 6294.
6290 END 6295.
6291 SUBROUTINE HGAER1(XMU,TAU,G,GG) 6301.
6292 C 6302.
6293 DIMENSION C05T00(51),C06T00(51),C07T00(51),C08T00(51),C09T00(51) 6303.
6294 DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6304.
6295 DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6305.
6296 DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6306.
6297 DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6307.
6298 DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6308.
6299 DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6309.
6300 DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6310.
6301 DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6311.
6302 DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6312.
6303 DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6313.
6304 C 6314.
6305 DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6315.
6306 DIMENSION C09TAU(51,11) 6316.
6307 C 6317.
6308 DIMENSION GTAU(51,11,5) 6318.
6309 C 6319.
6310 EQUIVALENCE (C05TAU(1, 1),C05T00(1)),(C05TAU(1, 2),C05T01(1)) 6320.
6311 EQUIVALENCE (C05TAU(1, 3),C05T02(1)),(C05TAU(1, 4),C05T03(1)) 6321.
6312 EQUIVALENCE (C05TAU(1, 5),C05T04(1)),(C05TAU(1, 6),C05T05(1)) 6322.
6313 EQUIVALENCE (C05TAU(1, 7),C05T06(1)),(C05TAU(1, 8),C05T07(1)) 6323.
6314 EQUIVALENCE (C05TAU(1, 9),C05T08(1)),(C05TAU(1,10),C05T09(1)) 6324.
6315 EQUIVALENCE (C05TAU(1,11),C05T10(1)) 6325.
6316 C 6326.
6317 EQUIVALENCE (C06TAU(1, 1),C06T00(1)),(C06TAU(1, 2),C06T01(1)) 6327.
6318 EQUIVALENCE (C06TAU(1, 3),C06T02(1)),(C06TAU(1, 4),C06T03(1)) 6328.
6319 EQUIVALENCE (C06TAU(1, 5),C06T04(1)),(C06TAU(1, 6),C06T05(1)) 6329.
6320 EQUIVALENCE (C06TAU(1, 7),C06T06(1)),(C06TAU(1, 8),C06T07(1)) 6330.
6321 EQUIVALENCE (C06TAU(1, 9),C06T08(1)),(C06TAU(1,10),C06T09(1)) 6331.
6322 EQUIVALENCE (C06TAU(1,11),C06T10(1)) 6332.
6323 C 6333.
6324 EQUIVALENCE (C07TAU(1, 1),C07T00(1)),(C07TAU(1, 2),C07T01(1)) 6334.
6325 EQUIVALENCE (C07TAU(1, 3),C07T02(1)),(C07TAU(1, 4),C07T03(1)) 6335.
6326 EQUIVALENCE (C07TAU(1, 5),C07T04(1)),(C07TAU(1, 6),C07T05(1)) 6336.
6327 EQUIVALENCE (C07TAU(1, 7),C07T06(1)),(C07TAU(1, 8),C07T07(1)) 6337.
6328 EQUIVALENCE (C07TAU(1, 9),C07T08(1)),(C07TAU(1,10),C07T09(1)) 6338.
6329 EQUIVALENCE (C07TAU(1,11),C07T10(1)) 6339.
6330 C 6340.
6331 EQUIVALENCE (C08TAU(1, 1),C08T00(1)),(C08TAU(1, 2),C08T01(1)) 6341.
6332 EQUIVALENCE (C08TAU(1, 3),C08T02(1)),(C08TAU(1, 4),C08T03(1)) 6342.
6333 EQUIVALENCE (C08TAU(1, 5),C08T04(1)),(C08TAU(1, 6),C08T05(1)) 6343.
6334 EQUIVALENCE (C08TAU(1, 7),C08T06(1)),(C08TAU(1, 8),C08T07(1)) 6344.
6335 EQUIVALENCE (C08TAU(1, 9),C08T08(1)),(C08TAU(1,10),C08T09(1)) 6345.
6336 EQUIVALENCE (C08TAU(1,11),C08T10(1)) 6346.
6337 C 6347.
6338 EQUIVALENCE (C09TAU(1, 1),C09T00(1)),(C09TAU(1, 2),C09T01(1)) 6348.
6339 EQUIVALENCE (C09TAU(1, 3),C09T02(1)),(C09TAU(1, 4),C09T03(1)) 6349.
6340 EQUIVALENCE (C09TAU(1, 5),C09T04(1)),(C09TAU(1, 6),C09T05(1)) 6350.
6341 EQUIVALENCE (C09TAU(1, 7),C09T06(1)),(C09TAU(1, 8),C09T07(1)) 6351.
6342 EQUIVALENCE (C09TAU(1, 9),C09T08(1)),(C09TAU(1,10),C09T09(1)) 6352.
6343 EQUIVALENCE (C09TAU(1,11),C09T10(1)) 6353.
6344 C 6354.
6345 EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6355.
6346 EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6356.
6347 EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6357.
6348 C 6358.
6349 C 6359.
6350 DATA C05T00/0.0, 6360.
6351 1 .0179,.0379,.0574,.0767,.0958,.1147,.1334,.1520,.1703,.1884, 6361.
6352 2 .2062,.2238,.2410,.2580,.2747,.2910,.3070,.3226,.3380,.3530, 6362.
6353 3 .3675,.3819,.3958,.4094,.4227,.4355,.4481,.4603,.4722,.4838, 6363.
6354 4 .4950,.5059,.5166,.5269,.5370,.5468,.5563,.5655,.5745,.5832, 6364.
6355 5 .5917,.5999,.6079,.6157,.6233,.6306,.6378,.6445,.6513,.6578/ 6365.
6356 C 6366.
6357 DATA C05T01/0.0, 6367.
6358 1 .0000,.0226,.0463,.0679,.0885,.1084,.1278,.1469,.1655,.1838, 6368.
6359 2 .2018,.2194,.2367,.2537,.2704,.2866,.3026,.3182,.3335,.3484, 6369.
6360 3 .3630,.3773,.3911,.4047,.4180,.4308,.4433,.4556,.4675,.4791, 6370.
6361 4 .4904,.5014,.5121,.5224,.5326,.5424,.5520,.5613,.5703,.5792, 6371.
6362 5 .5877,.5961,.6041,.6120,.6197,.6271,.6344,.6414,.6483,.6550/ 6372.
6363 C 6373.
6364 DATA C05T02/0.0, 6374.
6365 1 .0000,.0207,.0434,.0649,.0856,.1057,.1252,.1444,.1632,.1816, 6375.
6366 2 .1996,.2173,.2346,.2516,.2683,.2845,.3005,.3161,.3313,.3463, 6376.
6367 3 .3608,.3750,.3889,.4024,.4156,.4284,.4410,.4532,.4651,.4767, 6377.
6368 4 .4880,.4990,.5097,.5201,.5303,.5401,.5497,.5591,.5682,.5771, 6378.
6369 5 .5857,.5941,.6022,.6102,.6179,.6254,.6327,.6398,.6467,.6535/ 6379.
6370 C 6380.
6371 DATA C05T03/0.0, 6381.
6372 1 .0095,.0317,.0517,.0712,.0904,.1095,.1283,.1469,.1651,.1832, 6382.
6373 2 .2009,.2184,.2355,.2523,.2688,.2849,.3008,.3162,.3313,.3461, 6383.
6374 3 .3605,.3747,.3885,.4019,.4151,.4278,.4403,.4525,.4643,.4759, 6384.
6375 4 .4872,.4981,.5089,.5192,.5294,.5392,.5488,.5582,.5673,.5762, 6385.
6376 5 .5848,.5932,.6013,.6093,.6170,.6246,.6319,.6391,.6460,.6528/ 6386.
6377 C 6387.
6378 DATA C05T04/0.0, 6388.
6379 1 .0260,.0472,.0656,.0833,.1008,.1183,.1359,.1534,.1709,.1882, 6389.
6380 2 .2053,.2223,.2389,.2554,.2715,.2873,.3029,.3181,.3330,.3476, 6390.
6381 3 .3619,.3759,.3895,.4028,.4158,.4284,.4408,.4529,.4647,.4762, 6391.
6382 4 .4873,.4982,.5089,.5192,.5293,.5391,.5487,.5580,.5671,.5759, 6392.
6383 5 .5845,.5929,.6010,.6090,.6167,.6243,.6316,.6388,.6457,.6525/ 6393.
6384 C 6394.
6385 DATA C05T05/0.0, 6395.
6386 1 .0428,.0635,.0812,.0978,.1140,.1302,.1465,.1629,.1793,.1958, 6396.
6387 2 .2121,.2284,.2444,.2603,.2760,.2914,.3066,.3214,.3360,.3504, 6397.
6388 3 .3643,.3781,.3915,.4046,.4175,.4299,.4422,.4541,.4657,.4771, 6398.
6389 4 .4882,.4990,.5095,.5197,.5298,.5395,.5490,.5583,.5673,.5761, 6399.
6390 5 .5846,.5930,.6011,.6090,.6167,.6243,.6316,.6387,.6457,.6524/ 6400.
6391 C 6401.
6392 DATA C05T06/0.0, 6402.
6393 1 .0590,.0796,.0969,.1129,.1283,.1435,.1588,.1741,.1896,.2051, 6403.
6394 2 .2206,.2360,.2514,.2667,.2818,.2967,.3114,.3258,.3401,.3541, 6404.
6395 3 .3677,.3812,.3943,.4072,.4198,.4321,.4441,.4559,.4673,.4786, 6405.
6396 4 .4895,.5002,.5106,.5207,.5306,.5403,.5497,.5589,.5678,.5766, 6406.
6397 5 .5850,.5934,.6014,.6093,.6170,.6244,.6317,.6388,.6458,.6525/ 6407.
6398 C 6408.
6399 DATA C05T07/0.0, 6409.
6400 1 .0742,.0948,.1120,.1277,.1427,.1572,.1716,.1861,.2007,.2153, 6410.
6401 2 .2300,.2447,.2594,.2740,.2885,.3028,.3171,.3310,.3448,.3584, 6411.
6402 3 .3717,.3849,.3977,.4103,.4227,.4347,.4465,.4581,.4693,.4804, 6412.
6403 4 .4912,.5017,.5120,.5220,.5318,.5413,.5506,.5597,.5686,.5772, 6413.
6404 5 .5856,.5939,.6019,.6097,.6173,.6247,.6320,.6390,.6459,.6526/ 6414.
6405 C 6415.
6406 DATA C05T08/0.0, 6416.
6407 1 .0885,.1090,.1263,.1418,.1565,.1705,.1844,.1982,.2121,.2260, 6417.
6408 2 .2400,.2540,.2680,.2819,.2958,.3096,.3233,.3368,.3502,.3633, 6418.
6409 3 .3763,.3890,.4015,.4138,.4259,.4377,.4493,.4606,.4717,.4825, 6419.
6410 4 .4931,.5035,.5136,.5235,.5331,.5425,.5517,.5607,.5695,.5780, 6420.
6411 5 .5864,.5945,.6024,.6102,.6177,.6251,.6323,.6393,.6461,.6528/ 6421.
6412 C 6422.
6413 DATA C05T09/0.0, 6423.
6414 1 .1017,.1223,.1395,.1550,.1695,.1833,.1968,.2101,.2234,.2367, 6424.
6415 2 .2501,.2634,.2768,.2902,.3035,.3167,.3299,.3429,.3558,.3686, 6425.
6416 3 .3811,.3935,.4057,.4176,.4295,.4409,.4523,.4634,.4742,.4849, 6426.
6417 4 .4952,.5054,.5154,.5251,.5346,.5439,.5530,.5618,.5705,.5789, 6427.
6418 5 .5871,.5952,.6031,.6107,.6182,.6255,.6326,.6396,.6464,.6530/ 6428.
6419 C 6429.
6420 DATA C05T10/0.0, 6430.
6421 1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6431.
6422 2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6432.
6423 3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6433.
6424 4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6434.
6425 5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6435.
6426 C 6436.
6427 DATA C06T00/0.0, 6437.
6428 1 .0250,.0525,.0792,.1056,.1316,.1572,.1823,.2070,.2311,.2547, 6438.
6429 2 .2776,.3000,.3217,.3427,.3631,.3827,.4019,.4201,.4378,.4550, 6439.
6430 3 .4713,.4872,.5024,.5170,.5312,.5446,.5576,.5701,.5820,.5936, 6440.
6431 4 .6047,.6153,.6257,.6354,.6450,.6541,.6628,.6713,.6794,.6873, 6441.
6432 5 .6948,.7021,.7091,.7159,.7224,.7287,.7348,.7407,.7462,.7516/ 6442.
6433 C 6443.
6434 DATA C06T01/0.0, 6444.
6435 1 .0000,.0339,.0652,.0941,.1216,.1480,.1737,.1987,.2229,.2466, 6445.
6436 2 .2694,.2918,.3134,.3344,.3548,.3744,.3935,.4118,.4295,.4467, 6446.
6437 3 .4632,.4792,.4945,.5092,.5236,.5372,.5504,.5631,.5753,.5871, 6447.
6438 4 .5984,.6093,.6198,.6299,.6396,.6490,.6580,.6667,.6751,.6832, 6448.
6439 5 .6909,.6984,.7056,.7126,.7194,.7259,.7322,.7382,.7441,.7498/ 6449.
6440 C 6450.
6441 DATA C06T02/0.0, 6451.
6442 1 .0000,.0307,.0608,.0893,.1168,.1433,.1690,.1941,.2183,.2420, 6452.
6443 2 .2648,.2871,.3087,.3296,.3500,.3696,.3887,.4070,.4247,.4420, 6453.
6444 3 .4584,.4745,.4898,.5047,.5191,.5328,.5461,.5590,.5713,.5832, 6454.
6445 4 .5947,.6057,.6164,.6266,.6365,.6460,.6552,.6641,.6726,.6808, 6455.
6446 5 .6887,.6964,.7038,.7110,.7178,.7245,.7309,.7371,.7431,.7489/ 6456.
6447 C 6457.
6448 DATA C06T03/0.0, 6458.
6449 1 .0130,.0424,.0692,.0953,.1210,.1462,.1709,.1952,.2188,.2420, 6459.
6450 2 .2645,.2865,.3078,.3285,.3486,.3680,.3870,.4051,.4228,.4399, 6460.
6451 3 .4563,.4723,.4877,.5025,.5169,.5306,.5440,.5569,.5692,.5812, 6461.
6452 4 .5927,.6038,.6146,.6248,.6348,.6444,.6537,.6626,.6712,.6796, 6462.
6453 5 .6876,.6954,.7028,.7101,.7170,.7238,.7303,.7366,.7427,.7486/ 6463.
6454 C 6464.
6455 DATA C06T04/0.0, 6465.
6456 1 .0314,.0594,.0842,.1080,.1315,.1549,.1781,.2012,.2238,.2461, 6466.
6457 2 .2678,.2892,.3099,.3302,.3499,.3690,.3876,.4055,.4230,.4399, 6467.
6458 3 .4561,.4720,.4872,.5019,.5163,.5299,.5432,.5561,.5684,.5804, 6468.
6459 4 .5918,.6029,.6137,.6240,.6340,.6436,.6529,.6619,.6705,.6790, 6469.
6460 5 .6870,.6948,.7023,.7096,.7167,.7235,.7300,.7364,.7425,.7485/ 6470.
6461 C 6471.
6462 DATA C06T05/0.0, 6472.
6463 1 .0503,.0777,.1014,.1237,.1456,.1673,.1889,.2105,.2319,.2531, 6473.
6464 2 .2739,.2944,.3145,.3341,.3533,.3718,.3901,.4076,.4247,.4413, 6474.
6465 3 .4573,.4730,.4880,.5025,.5167,.5302,.5434,.5562,.5684,.5803, 6475.
6466 4 .5917,.6028,.6135,.6238,.6338,.6434,.6527,.6617,.6703,.6787, 6476.
6467 5 .6868,.6946,.7021,.7095,.7165,.7233,.7299,.7363,.7425,.7485/ 6477.
6468 C 6478.
6469 DATA C06T06/0.0, 6479.
6470 1 .0686,.0956,.1188,.1403,.1611,.1814,.2017,.2220,.2421,.2622, 6480.
6471 2 .2820,.3016,.3208,.3397,.3582,.3762,.3939,.4110,.4276,.4439, 6481.
6472 3 .4596,.4749,.4897,.5040,.5180,.5313,.5443,.5569,.5690,.5808, 6482.
6473 4 .5921,.6031,.6138,.6240,.6339,.6435,.6527,.6617,.6703,.6787, 6483.
6474 5 .6868,.6946,.7021,.7094,.7165,.7233,.7300,.7364,.7425,.7485/ 6484.
6475 C 6485.
6476 DATA C06T07/0.0, 6486.
6477 1 .0859,.1128,.1357,.1567,.1767,.1961,.2154,.2345,.2535,.2725, 6487.
6478 2 .2913,.3099,.3283,.3464,.3642,.3816,.3987,.4153,.4315,.4473, 6488.
6479 3 .4626,.4776,.4920,.5061,.5198,.5329,.5457,.5582,.5701,.5818, 6489.
6480 4 .5930,.6038,.6144,.6245,.6344,.6439,.6530,.6620,.6705,.6789, 6490.
6481 5 .6869,.6947,.7022,.7095,.7166,.7234,.7300,.7364,.7426,.7486/ 6491.
6482 C 6492.
6483 DATA C06T08/0.0, 6493.
6484 1 .1022,.1290,.1517,.1723,.1919,.2107,.2291,.2473,.2654,.2834, 6494.
6485 2 .3013,.3191,.3366,.3539,.3710,.3877,.4042,.4202,.4360,.4513, 6495.
6486 3 .4662,.4808,.4950,.5087,.5221,.5350,.5476,.5598,.5715,.5830, 6496.
6487 4 .5941,.6048,.6152,.6252,.6350,.6444,.6535,.6624,.6709,.6792, 6497.
6488 5 .6872,.6949,.7024,.7097,.7167,.7235,.7301,.7365,.7427,.7486/ 6498.
6489 C 6499.
6490 DATA C06T09/0.0, 6500.
6491 1 .1173,.1440,.1666,.1871,.2063,.2246,.2425,.2600,.2773,.2945, 6501.
6492 2 .3116,.3285,.3453,.3619,.3783,.3943,.4102,.4257,.4409,.4558, 6502.
6493 3 .4703,.4845,.4982,.5116,.5248,.5374,.5497,.5617,.5732,.5845, 6503.
6494 4 .5954,.6060,.6163,.6262,.6358,.6451,.6541,.6629,.6713,.6796, 6504.
6495 5 .6875,.6952,.7026,.7099,.7168,.7236,.7302,.7365,.7427,.7487/ 6505.
6496 C 6506.
6497 DATA C06T10/0.0, 6507.
6498 1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6508.
6499 2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6509.
6500 3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6510.
6501 4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6511.
6502 5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6512.
6503 C 6513.
6504 DATA C07T00/0.0, 6514.
6505 1 .0360,.0751,.1129,.1498,.1858,.2209,.2546,.2873,.3183,.3484, 6515.
6506 2 .3767,.4040,.4296,.4540,.4773,.4990,.5199,.5392,.5577,.5753, 6516.
6507 3 .5916,.6073,.6220,.6358,.6492,.6615,.6733,.6845,.6950,.7051, 6517.
6508 4 .7147,.7237,.7324,.7406,.7484,.7559,.7630,.7698,.7762,.7824, 6518.
6509 5 .7883,.7940,.7994,.8046,.8096,.8144,.8190,.8234,.8276,.8317/ 6519.
6510 C 6520.
6511 DATA C07T01/0.0, 6521.
6512 1 .0000,.0500,.0929,.1323,.1696,.2052,.2391,.2719,.3029,.3329, 6522.
6513 2 .3612,.3886,.4144,.4390,.4625,.4845,.5058,.5256,.5445,.5626, 6523.
6514 3 .5795,.5957,.6109,.6253,.6392,.6521,.6644,.6762,.6872,.6979, 6524.
6515 4 .7079,.7174,.7266,.7351,.7434,.7513,.7587,.7659,.7727,.7793, 6525.
6516 5 .7855,.7915,.7971,.8026,.8079,.8129,.8177,.8223,.8268,.8310/ 6526.
6517 C 6527.
6518 DATA C07T02/0.0, 6528.
6519 1 .0000,.0433,.0845,.1233,.1604,.1958,.2296,.2623,.2932,.3232, 6529.
6520 2 .3515,.3788,.4047,.4294,.4530,.4753,.4967,.5168,.5360,.5544, 6530.
6521 3 .5715,.5881,.6037,.6184,.6327,.6459,.6586,.6707,.6821,.6931, 6531.
6522 4 .7034,.7133,.7228,.7316,.7402,.7484,.7561,.7636,.7706,.7774, 6532.
6523 5 .7839,.7901,.7960,.8017,.8071,.8123,.8173,.8221,.8267,.8311/ 6533.
6524 C 6534.
6525 DATA C07T03/0.0, 6535.
6526 1 .0139,.0544,.0915,.1272,.1620,.1958,.2284,.2601,.2903,.3197, 6536.
6527 2 .3475,.3745,.4001,.4246,.4481,.4703,.4918,.5119,.5311,.5496, 6537.
6528 3 .5669,.5836,.5993,.6142,.6287,.6420,.6550,.6673,.6789,.6901, 6538.
6529 4 .7006,.7107,.7204,.7294,.7382,.7465,.7545,.7621,.7693,.7763, 6539.
6530 5 .7829,.7893,.7953,.8012,.8067,.8121,.8172,.8221,.8269,.8314/ 6540.
6531 C 6541.
6532 DATA C07T04/0.0, 6542.
6533 1 .0339,.0723,.1065,.1393,.1714,.2028,.2336,.2637,.2927,.3210, 6543.
6534 2 .3480,.3743,.3993,.4234,.4465,.4684,.4897,.5096,.5288,.5471, 6544.
6535 3 .5644,.5811,.5968,.6118,.6263,.6398,.6528,.6652,.6769,.6882, 6545.
6536 4 .6988,.7090,.7188,.7280,.7369,.7454,.7534,.7612,.7685,.7756, 6546.
6537 5 .7823,.7888,.7950,.8009,.8066,.8120,.8173,.8223,.8271,.8317/ 6547.
6538 C 6548.
6539 DATA C07T05/0.0, 6549.
6540 1 .0546,.0920,.1246,.1553,.1852,.2144,.2432,.2715,.2990,.3260, 6550.
6541 2 .3519,.3772,.4015,.4249,.4474,.4689,.4897,.5093,.5283,.5464, 6551.
6542 3 .5635,.5801,.5957,.6106,.6251,.6386,.6516,.6640,.6757,.6871, 6552.
6543 4 .6978,.7080,.7179,.7272,.7361,.7447,.7528,.7606,.7680,.7752, 6553.
6544 5 .7820,.7886,.7948,.8008,.8065,.8121,.8174,.8224,.8273,.8320/ 6554.
6545 C 6555.
6546 DATA C07T06/0.0, 6556.
6547 1 .0749,.1117,.1434,.1728,.2010,.2284,.2554,.2820,.3079,.3335, 6557.
6548 2 .3582,.3825,.4058,.4284,.4502,.4711,.4914,.5106,.5292,.5470, 6558.
6549 3 .5639,.5802,.5957,.6105,.6248,.6382,.6511,.6635,.6752,.6865, 6559.
6550 4 .6972,.7075,.7174,.7267,.7357,.7442,.7524,.7603,.7677,.7750, 6560.
6551 5 .7818,.7884,.7947,.8008,.8065,.8121,.8174,.8226,.8275,.8322/ 6561.
6552 C 6562.
6553 DATA C07T07/0.0, 6563.
6554 1 .0943,.1306,.1617,.1902,.2173,.2434,.2689,.2940,.3185,.3427, 6564.
6555 2 .3662,.3893,.4117,.4334,.4545,.4747,.4944,.5131,.5312,.5486, 6565.
6556 3 .5651,.5812,.5964,.6110,.6252,.6384,.6512,.6635,.6752,.6864, 6566.
6557 4 .6971,.7073,.7172,.7265,.7355,.7440,.7522,.7601,.7676,.7748, 6567.
6558 5 .7817,.7883,.7946,.8007,.8065,.8121,.8175,.8227,.8276,.8324/ 6568.
6559 C 6569.
6560 DATA C07T08/0.0, 6570.
6561 1 .1125,.1486,.1793,.2071,.2334,.2585,.2828,.3066,.3299,.3529, 6571.
6562 2 .3753,.3973,.4186,.4395,.4597,.4792,.4982,.5164,.5340,.5510, 6572.
6563 3 .5672,.5829,.5978,.6122,.6261,.6392,.6518,.6640,.6755,.6867, 6573.
6564 4 .6973,.7074,.7172,.7265,.7354,.7440,.7522,.7600,.7675,.7748, 6574.
6565 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8277,.8325/ 6575.
6566 C 6576.
6567 DATA C07T09/0.0, 6577.
6568 1 .1296,.1655,.1958,.2232,.2489,.2732,.2966,.3194,.3416,.3635, 6578.
6569 2 .3848,.4058,.4262,.4462,.4656,.4844,.5028,.5203,.5374,.5539, 6579.
6570 3 .5697,.5850,.5997,.6137,.6274,.6403,.6527,.6647,.6761,.6872, 6580.
6571 4 .6977,.7077,.7175,.7267,.7356,.7441,.7522,.7601,.7675,.7748, 6581.
6572 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6582.
6573 C 6583.
6574 DATA C07T10/0.0, 6584.
6575 1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 6585.
6576 2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 6586.
6577 3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 6587.
6578 4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 6588.
6579 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6589.
6580 C 6590.
6581 DATA C08T00/0.0, 6591.
6582 1 .0568,.1172,.1747,.2295,.2813,.3300,.3748,.4169,.4547,.4903, 6592.
6583 2 .5220,.5517,.5784,.6030,.6257,.6460,.6652,.6825,.6985,.7134, 6593.
6584 3 .7269,.7396,.7513,.7621,.7723,.7816,.7904,.7987,.8064,.8137, 6594.
6585 4 .8204,.8268,.8329,.8385,.8439,.8490,.8538,.8584,.8627,.8668, 6595.
6586 5 .8707,.8744,.8780,.8814,.8846,.8877,.8906,.8934,.8961,.8987/ 6596.
6587 C 6597.
6588 DATA C08T01/0.0, 6598.
6589 1 .0045,.0786,.1413,.1980,.2505,.2994,.3445,.3870,.4255,.4620, 6599.
6590 2 .4948,.5257,.5538,.5798,.6039,.6258,.6464,.6650,.6823,.6985, 6600.
6591 3 .7132,.7270,.7398,.7516,.7629,.7730,.7826,.7917,.8000,.8080, 6601.
6592 4 .8153,.8223,.8289,.8350,.8408,.8463,.8514,.8564,.8610,.8654, 6602.
6593 5 .8696,.8736,.8773,.8809,.8843,.8876,.8907,.8937,.8965,.8992/ 6603.
6594 C 6604.
6595 DATA C08T02/0.0, 6605.
6596 1 .0000,.0639,.1239,.1794,.2314,.2799,.3249,.3675,.4063,.4431, 6606.
6597 2 .4766,.5081,.5370,.5637,.5888,.6115,.6330,.6525,.6707,.6878, 6607.
6598 3 .7032,.7179,.7314,.7440,.7559,.7667,.7769,.7865,.7954,.8038, 6608.
6599 4 .8117,.8190,.8260,.8325,.8387,.8445,.8499,.8551,.8600,.8647, 6609.
6600 5 .8690,.8733,.8772,.8810,.8845,.8880,.8912,.8943,.8973,.9001/ 6610.
6601 C 6611.
6602 DATA C08T03/0.0, 6612.
6603 1 .0129,.0725,.1266,.1778,.2266,.2730,.3165,.3580,.3962,.4326, 6613.
6604 2 .4659,.4975,.5265,.5536,.5790,.6021,.6241,.6441,.6628,.6804, 6614.
6605 3 .6964,.7116,.7256,.7386,.7510,.7622,.7728,.7828,.7921,.8009, 6615.
6606 4 .8090,.8167,.8240,.8307,.8372,.8432,.8489,.8543,.8594,.8642, 6616.
6607 5 .8688,.8731,.8772,.8811,.8848,.8884,.8917,.8949,.8980,.9009/ 6617.
6608 C 6618.
6609 DATA C08T04/0.0, 6619.
6610 1 .0338,.0901,.1399,.1870,.2320,.2754,.3165,.3561,.3930,.4283, 6620.
6611 2 .4609,.4920,.5207,.5477,.5730,.5962,.6184,.6385,.6575,.6753, 6621.
6612 3 .6916,.7071,.7214,.7347,.7474,.7589,.7698,.7801,.7896,.7987, 6622.
6613 4 .8071,.8150,.8225,.8294,.8361,.8423,.8481,.8537,.8589,.8639, 6623.
6614 5 .8686,.8731,.8773,.8813,.8851,.8887,.8922,.8955,.8986,.9016/ 6624.
6615 C 6625.
6616 DATA C08T05/0.0, 6626.
6617 1 .0561,.1105,.1578,.2017,.2435,.2838,.3224,.3597,.3948,.4287, 6627.
6618 2 .4602,.4904,.5185,.5450,.5699,.5930,.6150,.6351,.6541,.6720, 6628.
6619 3 .6884,.7040,.7185,.7319,.7448,.7565,.7676,.7781,.7877,.7970, 6629.
6620 4 .8056,.8136,.8213,.8284,.8352,.8416,.8476,.8533,.8586,.8637, 6630.
6621 5 .8685,.8731,.8774,.8815,.8854,.8891,.8926,.8960,.8991,.9022/ 6631.
6622 C 6632.
6623 DATA C08T06/0.0, 6633.
6624 1 .0782,.1314,.1770,.2187,.2581,.2958,.3319,.3670,.4002,.4324, 6634.
6625 2 .4626,.4917,.5189,.5447,.5691,.5918,.6134,.6334,.6522,.6700, 6635.
6626 3 .6864,.7020,.7165,.7300,.7430,.7548,.7660,.7766,.7864,.7957, 6636.
6627 4 .8044,.8126,.8204,.8276,.8345,.8410,.8471,.8529,.8583,.8635, 6637.
6628 5 .8684,.8731,.8774,.8816,.8856,.8893,.8929,.8963,.8996,.9027/ 6638.
6629 C 6639.
6630 DATA C08T07/0.0, 6640.
6631 1 .0994,.1518,.1962,.2363,.2739,.3095,.3436,.3765,.4080,.4385, 6641.
6632 2 .4673,.4951,.5213,.5463,.5700,.5921,.6134,.6329,.6515,.6691, 6642.
6633 3 .6854,.7009,.7154,.7289,.7418,.7536,.7649,.7755,.7854,.7948, 6643.
6634 4 .8036,.8118,.8197,.8270,.8340,.8405,.8467,.8526,.8581,.8634, 6644.
6635 5 .8683,.8731,.8775,.8817,.8857,.8896,.8932,.8967,.8999,.9031/ 6645.
6636 C 6646.
6637 DATA C08T08/0.0, 6647.
6638 1 .1197,.1714,.2148,.2538,.2899,.3238,.3562,.3874,.4172,.4461, 6648.
6639 2 .4735,.5001,.5253,.5493,.5722,.5937,.6144,.6335,.6518,.6691, 6649.
6640 3 .6852,.7005,.7148,.7283,.7412,.7529,.7642,.7748,.7847,.7942, 6650.
6641 4 .8030,.8113,.8192,.8265,.8336,.8402,.8464,.8524,.8579,.8632, 6651.
6642 5 .8682,.8730,.8775,.8818,.8858,.8897,.8934,.8969,.9002,.9034/ 6652.
6643 C 6653.
6644 DATA C08T09/0.0, 6654.
6645 1 .1387,.1899,.2326,.2705,.3055,.3382,.3691,.3988,.4271,.4546, 6655.
6646 2 .4808,.5061,.5302,.5533,.5754,.5962,.6163,.6350,.6528,.6698, 6656.
6647 3 .6855,.7007,.7148,.7281,.7409,.7526,.7638,.7744,.7843,.7937, 6657.
6648 4 .8025,.8109,.8188,.8262,.8333,.8399,.8462,.8521,.8577,.8631, 6658.
6649 5 .8681,.8730,.8775,.8818,.8859,.8898,.8935,.8971,.9004,.9036/ 6659.
6650 C 6660.
6651 DATA C08T10/0.0, 6661.
6652 1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 6662.
6653 2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 6663.
6654 3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 6664.
6655 4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 6665.
6656 5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 6666.
6657 C 6667.
6658 DATA C09T00/0.0, 6668.
6659 1 .1151,.2302,.3312,.4172,.4903,.5514,.6016,.6447,.6796,.7102, 6669.
6660 2 .7355,.7578,.7769,.7935,.8085,.8212,.8330,.8432,.8524,.8609, 6670.
6661 3 .8683,.8752,.8815,.8872,.8926,.8974,.9019,.9061,.9100,.9136, 6671.
6662 4 .9170,.9201,.9231,.9258,.9284,.9309,.9332,.9354,.9374,.9394, 6672.
6663 5 .9412,.9430,.9446,.9462,.9477,.9492,.9506,.9519,.9531,.9543/ 6673.
6664 C 6674.
6665 DATA C09T01/0.0, 6675.
6666 1 .0245,.1526,.2576,.3468,.4239,.4902,.5461,.5952,.6357,.6717, 6676.
6667 2 .7017,.7283,.7513,.7712,.7891,.8043,.8183,.8304,.8413,.8512, 6677.
6668 3 .8599,.8680,.8753,.8818,.8880,.8934,.8985,.9032,.9075,.9116, 6678.
6669 4 .9153,.9187,.9220,.9250,.9278,.9305,.9329,.9353,.9375,.9396, 6679.
6670 5 .9415,.9434,.9451,.9468,.9484,.9499,.9513,.9527,.9540,.9552/ 6680.
6671 C 6681.
6672 DATA C09T02/0.0, 6682.
6673 1 .0057,.1184,.2173,.3044,.3816,.4494,.5078,.5598,.6035,.6428, 6683.
6674 2 .6758,.7053,.7309,.7532,.7733,.7904,.8062,.8197,.8320,.8432, 6684.
6675 3 .8529,.8619,.8700,.8772,.8841,.8901,.8956,.9008,.9055,.9099, 6685.
6676 4 .9139,.9177,.9212,.9244,.9274,.9302,.9329,.9354,.9377,.9399, 6686.
6677 5 .9419,.9439,.9457,.9475,.9491,.9507,.9521,.9535,.9549,.9561/ 6687.
6678 C 6688.
6679 DATA C09T03/0.0, 6689.
6680 1 .0177,.1190,.2077,.2880,.3610,.4269,.4847,.5372,.5820,.6227, 6690.
6681 2 .6574,.6886,.7157,.7396,.7612,.7796,.7967,.8113,.8246,.8367, 6691.
6682 3 .8472,.8570,.8657,.8735,.8809,.8873,.8933,.8989,.9039,.9086, 6692.
6683 4 .9129,.9168,.9205,.9239,.9271,.9301,.9329,.9355,.9379,.9402, 6693.
6684 5 .9423,.9444,.9462,.9481,.9497,.9514,.9529,.9543,.9557,.9570/ 6694.
6685 C 6695.
6686 DATA C09T04/0.0, 6696.
6687 1 .0383,.1335,.2145,.2879,.3553,.4173,.4729,.5241,.5685,.6094, 6697.
6688 2 .6446,.6766,.7046,.7294,.7519,.7713,.7891,.8046,.8186,.8314, 6698.
6689 3 .8425,.8529,.8621,.8704,.8782,.8850,.8913,.8972,.9025,.9074, 6699.
6690 4 .9119,.9161,.9200,.9235,.9269,.9300,.9328,.9356,.9381,.9405, 6700.
6691 5 .9427,.9448,.9467,.9486,.9503,.9520,.9535,.9550,.9564,.9577/ 6701.
6692 C 6702.
6693 DATA C09T05/0.0, 6703.
6694 1 .0614,.1528,.2288,.2967,.3590,.4167,.4692,.5181,.5613,.6013, 6704.
6695 2 .6363,.6684,.6966,.7219,.7449,.7648,.7832,.7993,.8138,.8271, 6705.
6696 3 .8387,.8495,.8591,.8678,.8759,.8830,.8896,.8958,.9013,.9064, 6706.
6697 4 .9111,.9154,.9195,.9232,.9266,.9298,.9328,.9356,.9382,.9407, 6707.
6698 5 .9429,.9451,.9471,.9490,.9508,.9525,.9541,.9556,.9570,.9583/ 6708.
6699 C 6709.
6700 DATA C09T06/0.0, 6710.
6701 1 .0849,.1736,.2461,.3098,.3680,.4217,.4710,.5172,.5586,.5974, 6711.
6702 2 .6316,.6632,.6913,.7166,.7398,.7599,.7787,.7951,.8100,.8236, 6712.
6703 3 .8355,.8467,.8566,.8656,.8740,.8813,.8882,.8945,.9002,.9055, 6713.
6704 4 .9104,.9148,.9190,.9228,.9264,.9297,.9328,.9356,.9383,.9408, 6714.
6705 5 .9431,.9454,.9474,.9494,.9512,.9529,.9545,.9561,.9575,.9589/ 6715.
6706 C 6716.
6707 DATA C09T07/0.0, 6717.
6708 1 .1078,.1944,.2643,.3249,.3797,.4300,.4764,.5199,.5594,.5965, 6718.
6709 2 .6296,.6605,.6881,.7132,.7362,.7565,.7753,.7918,.8069,.8208, 6719.
6710 3 .8330,.8443,.8545,.8637,.8723,.8799,.8869,.8934,.8992,.9047, 6720.
6711 4 .9097,.9143,.9186,.9225,.9262,.9295,.9327,.9356,.9384,.9409, 6721.
6712 5 .9433,.9456,.9477,.9497,.9515,.9533,.9549,.9565,.9579,.9593/ 6722.
6713 C 6723.
6714 DATA C09T08/0.0, 6724.
6715 1 .1297,.2146,.2824,.3405,.3927,.4402,.4839,.5250,.5625,.5979, 6725.
6716 2 .6298,.6597,.6866,.7113,.7340,.7541,.7729,.7895,.8046,.8186, 6726.
6717 3 .8309,.8424,.8528,.8621,.8709,.8786,.8858,.8924,.8984,.9040, 6727.
6718 4 .9091,.9138,.9182,.9222,.9259,.9294,.9326,.9356,.9384,.9410, 6728.
6719 5 .9434,.9457,.9479,.9499,.9518,.9536,.9552,.9568,.9583,.9597/ 6729.
6720 C 6730.
6721 DATA C09T09/0.0, 6731.
6722 1 .1505,.2340,.2999,.3561,.4060,.4512,.4927,.5315,.5672,.6009, 6732.
6723 2 .6315,.6603,.6865,.7105,.7328,.7526,.7713,.7878,.8029,.8169, 6733.
6724 3 .8293,.8409,.8513,.8608,.8697,.8775,.8848,.8916,.8976,.9033, 6734.
6725 4 .9085,.9133,.9178,.9219,.9257,.9292,.9325,.9356,.9384,.9411, 6735.
6726 5 .9435,.9459,.9480,.9501,.9520,.9538,.9555,.9571,.9586,.9600/ 6736.
6727 C 6737.
6728 DATA C09T10/0.0, 6738.
6729 1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 6739.
6730 2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 6740.
6731 3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 6741.
6732 4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 6742.
6733 5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 6743.
6734 C 6744.
6735 C 6745.
6736 IF(TAU.GT.1.0) THEN 6746.
6737 CALL HGCLD1(XMU,TAU,G,GG) 6747.
6738 GO TO 130 6748.
6739 ENDIF 6749.
6740 C 6750.
6741 C ---------------------------------------------------------------- 6751.
6742 C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 6752.
6743 C FOR AEROSOL ALBEDOS FOR OPTICAL THICKNESSES OF (0.0 < TAU < 1.0) 6753.
6744 C ---------------------------------------------------------------- 6754.
6745 C 6755.
6746 C 6756.
6747 C ------------------------------------------- 6757.
6748 C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 6758.
6749 C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 6759.
6750 C ------------------------------------------- 6760.
6751 C 6761.
6752 XI=XMU*50.0+0.9999 6762.
6753 IX=XI 6763.
6754 IF(IX.LT.1) IX=1 6764.
6755 JX=IX+1 6765.
6756 WXJ=XI-IX 6766.
6757 WXI=1.0-WXJ 6767.
6758 C 6768.
6759 C ------------------------- 6769.
6760 C AEROSOL TAU INTERPOLATION 6770.
6761 C 0.10 ON (0.0 < XMU < 1.0) 6771.
6762 C ------------------------- 6772.
6763 C 6773.
6764 TI=TAU*10.0+0.9999 6774.
6765 IT=TI 6775.
6766 IF(IT.LT.1) IT=1 6776.
6767 IF(IT.GT.11) IT=11 6777.
6768 JT=IT+1 6778.
6769 IF(JT.GT.11) JT=11 6779.
6770 WTJ=TI-IT 6780.
6771 WTI=1.0-WTJ 6781.
6772 C 6782.
6773 C ------------------------------- 6783.
6774 C COSBAR DEPENDENCE INTERPOLATION 6784.
6775 C 0.10 ON (0.5 < COSBAR < 0.9) 6785.
6776 C LINEAR FOR (0.0 < COSBAR < 0.5) 6786.
6777 C ------------------------------- 6787.
6778 C 6788.
6779 GI=G*10.0 6789.
6780 IF(GI.GT.5.0) GO TO 110 6790.
6781 JG=1 6791.
6782 GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6792.
6783 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6793.
6784 GG=GG+GG 6794.
6785 GO TO 130 6795.
6786 C 6796.
6787 110 IG=GI 6797.
6788 WGJ=GI-IG 6798.
6789 WGI=1.0-WGJ 6799.
6790 IG=IG-4 6800.
6791 JG=IG+1 6801.
6792 IF(IG.GT.4) GO TO 120 6802.
6793 C 6803.
6794 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6804.
6795 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6805.
6796 + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6806.
6797 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6807.
6798 GO TO 130 6808.
6799 C 6809.
6800 120 IG=5 6810.
6801 C 6811.
6802 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6812.
6803 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6813.
6804 + +WGJ 6814.
6805 C 6815.
6806 130 CONTINUE 6816.
6807 C 6817.
6808 RETURN 6818.
6809 END 6819.
6810 SUBROUTINE HGCLD1(XMU,TAU,G,GG) 6820.
6811 C 6821.
6812 DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6822.
6813 DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6823.
6814 DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6824.
6815 DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6825.
6816 DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6826.
6817 DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6827.
6818 DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6828.
6819 DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6829.
6820 DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6830.
6821 DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6831.
6822 DIMENSION C05T99(51),C06T99(51),C07T99(51),C08T99(51),C09T99(51) 6832.
6823 C 6833.
6824 DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6834.
6825 DIMENSION C09TAU(51,11) 6835.
6826 C 6836.
6827 DIMENSION GTAU(51,11,5) 6837.
6828 C 6838.
6829 EQUIVALENCE (C05TAU(1, 1),C05T01(1)),(C05TAU(1, 2),C05T02(1)) 6839.
6830 EQUIVALENCE (C05TAU(1, 3),C05T03(1)),(C05TAU(1, 4),C05T04(1)) 6840.
6831 EQUIVALENCE (C05TAU(1, 5),C05T05(1)),(C05TAU(1, 6),C05T06(1)) 6841.
6832 EQUIVALENCE (C05TAU(1, 7),C05T07(1)),(C05TAU(1, 8),C05T08(1)) 6842.
6833 EQUIVALENCE (C05TAU(1, 9),C05T09(1)),(C05TAU(1,10),C05T10(1)) 6843.
6834 EQUIVALENCE (C05TAU(1,11),C05T99(1)) 6844.
6835 C 6845.
6836 EQUIVALENCE (C06TAU(1, 1),C06T01(1)),(C06TAU(1, 2),C06T02(1)) 6846.
6837 EQUIVALENCE (C06TAU(1, 3),C06T03(1)),(C06TAU(1, 4),C06T04(1)) 6847.
6838 EQUIVALENCE (C06TAU(1, 5),C06T05(1)),(C06TAU(1, 6),C06T06(1)) 6848.
6839 EQUIVALENCE (C06TAU(1, 7),C06T07(1)),(C06TAU(1, 8),C06T08(1)) 6849.
6840 EQUIVALENCE (C06TAU(1, 9),C06T09(1)),(C06TAU(1,10),C06T10(1)) 6850.
6841 EQUIVALENCE (C06TAU(1,11),C06T99(1)) 6851.
6842 C 6852.
6843 EQUIVALENCE (C07TAU(1, 1),C07T01(1)),(C07TAU(1, 2),C07T02(1)) 6853.
6844 EQUIVALENCE (C07TAU(1, 3),C07T03(1)),(C07TAU(1, 4),C07T04(1)) 6854.
6845 EQUIVALENCE (C07TAU(1, 5),C07T05(1)),(C07TAU(1, 6),C07T06(1)) 6855.
6846 EQUIVALENCE (C07TAU(1, 7),C07T07(1)),(C07TAU(1, 8),C07T08(1)) 6856.
6847 EQUIVALENCE (C07TAU(1, 9),C07T09(1)),(C07TAU(1,10),C07T10(1)) 6857.
6848 EQUIVALENCE (C07TAU(1,11),C07T99(1)) 6858.
6849 C 6859.
6850 EQUIVALENCE (C08TAU(1, 1),C08T01(1)),(C08TAU(1, 2),C08T02(1)) 6860.
6851 EQUIVALENCE (C08TAU(1, 3),C08T03(1)),(C08TAU(1, 4),C08T04(1)) 6861.
6852 EQUIVALENCE (C08TAU(1, 5),C08T05(1)),(C08TAU(1, 6),C08T06(1)) 6862.
6853 EQUIVALENCE (C08TAU(1, 7),C08T07(1)),(C08TAU(1, 8),C08T08(1)) 6863.
6854 EQUIVALENCE (C08TAU(1, 9),C08T09(1)),(C08TAU(1,10),C08T10(1)) 6864.
6855 EQUIVALENCE (C08TAU(1,11),C08T99(1)) 6865.
6856 C 6866.
6857 EQUIVALENCE (C09TAU(1, 1),C09T01(1)),(C09TAU(1, 2),C09T02(1)) 6867.
6858 EQUIVALENCE (C09TAU(1, 3),C09T03(1)),(C09TAU(1, 4),C09T04(1)) 6868.
6859 EQUIVALENCE (C09TAU(1, 5),C09T05(1)),(C09TAU(1, 6),C09T06(1)) 6869.
6860 EQUIVALENCE (C09TAU(1, 7),C09T07(1)),(C09TAU(1, 8),C09T08(1)) 6870.
6861 EQUIVALENCE (C09TAU(1, 9),C09T09(1)),(C09TAU(1,10),C09T10(1)) 6871.
6862 EQUIVALENCE (C09TAU(1,11),C09T99(1)) 6872.
6863 C 6873.
6864 EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6874.
6865 EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6875.
6866 EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6876.
6867 C 6877.
6868 C 6878.
6869 DATA C05T01/0.0, 6879.
6870 1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6880.
6871 2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6881.
6872 3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6882.
6873 4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6883.
6874 5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6884.
6875 C 6885.
6876 DATA C05T02/0.0, 6886.
6877 1 .1981,.2188,.2361,.2514,.2656,.2788,.2912,.3031,.3145,.3255, 6887.
6878 2 .3362,.3466,.3569,.3669,.3768,.3865,.3962,.4057,.4151,.4244, 6888.
6879 3 .4337,.4428,.4519,.4609,.4698,.4785,.4872,.4958,.5043,.5127, 6889.
6880 4 .5209,.5290,.5371,.5450,.5528,.5604,.5679,.5753,.5826,.5898, 6890.
6881 5 .5968,.6037,.6105,.6171,.6237,.6301,.6364,.6425,.6486,.6545/ 6891.
6882 C 6892.
6883 DATA C05T03/0.0, 6893.
6884 1 .2435,.2639,.2809,.2960,.3099,.3227,.3348,.3463,.3571,.3676, 6894.
6885 2 .3777,.3874,.3969,.4060,.4150,.4237,.4323,.4407,.4489,.4570, 6895.
6886 3 .4650,.4728,.4806,.4882,.4957,.5031,.5104,.5177,.5248,.5319, 6896.
6887 4 .5388,.5457,.5525,.5592,.5659,.5724,.5788,.5852,.5915,.5977, 6897.
6888 5 .6038,.6098,.6157,.6215,.6273,.6330,.6385,.6440,.6494,.6547/ 6898.
6889 C 6899.
6890 DATA C05T04/0.0, 6900.
6891 1 .2714,.2914,.3081,.3229,.3365,.3491,.3608,.3719,.3824,.3925, 6901.
6892 2 .4022,.4115,.4205,.4292,.4377,.4459,.4540,.4618,.4694,.4769, 6902.
6893 3 .4842,.4914,.4985,.5054,.5122,.5189,.5255,.5320,.5384,.5447, 6903.
6894 4 .5509,.5570,.5631,.5690,.5749,.5807,.5865,.5921,.5977,.6033, 6904.
6895 5 .6087,.6141,.6194,.6246,.6298,.6349,.6399,.6448,.6497,.6545/ 6905.
6896 C 6906.
6897 DATA C05T05/0.0, 6907.
6898 1 .2900,.3097,.3262,.3408,.3541,.3664,.3778,.3887,.3989,.4088, 6908.
6899 2 .4181,.4272,.4358,.4442,.4524,.4602,.4680,.4754,.4827,.4898, 6909.
6900 3 .4967,.5035,.5101,.5166,.5230,.5293,.5354,.5415,.5474,.5533, 6910.
6901 4 .5590,.5647,.5703,.5757,.5812,.5865,.5918,.5970,.6021,.6071, 6911.
6902 5 .6121,.6171,.6219,.6267,.6315,.6361,.6407,.6453,.6498,.6542/ 6912.
6903 C 6913.
6904 DATA C05T06/0.0, 6914.
6905 1 .3033,.3228,.3390,.3534,.3665,.3786,.3898,.4005,.4105,.4201, 6915.
6906 2 .4292,.4380,.4465,.4546,.4625,.4701,.4776,.4848,.4918,.4986, 6916.
6907 3 .5053,.5118,.5182,.5244,.5305,.5364,.5423,.5480,.5537,.5592, 6917.
6908 4 .5646,.5700,.5753,.5804,.5855,.5905,.5955,.6004,.6052,.6099, 6918.
6909 5 .6146,.6192,.6237,.6282,.6326,.6370,.6413,.6456,.6498,.6539/ 6919.
6910 C 6920.
6911 DATA C05T07/0.0, 6921.
6912 1 .3133,.3325,.3485,.3627,.3757,.3876,.3987,.4092,.4190,.4284, 6922.
6913 2 .4374,.4460,.4543,.4622,.4700,.4774,.4846,.4916,.4984,.5051, 6923.
6914 3 .5115,.5178,.5240,.5300,.5359,.5416,.5472,.5528,.5582,.5635, 6924.
6915 4 .5687,.5738,.5789,.5838,.5887,.5935,.5982,.6029,.6074,.6119, 6925.
6916 5 .6164,.6208,.6251,.6293,.6335,.6377,.6418,.6458,.6498,.6537/ 6926.
6917 C 6927.
6918 DATA C05T08/0.0, 6928.
6919 1 .3210,.3400,.3559,.3699,.3827,.3945,.4054,.4158,.4255,.4348, 6929.
6920 2 .4436,.4521,.4602,.4680,.4756,.4829,.4900,.4968,.5034,.5099, 6930.
6921 3 .5162,.5224,.5284,.5342,.5400,.5455,.5510,.5564,.5616,.5667, 6931.
6922 4 .5718,.5767,.5816,.5864,.5911,.5957,.6003,.6047,.6091,.6135, 6932.
6923 5 .6177,.6219,.6261,.6302,.6342,.6381,.6421,.6459,.6497,.6535/ 6933.
6924 C 6934.
6925 DATA C05T09/0.0, 6935.
6926 1 .3271,.3460,.3618,.3757,.3883,.4000,.4108,.4211,.4306,.4398, 6936.
6927 2 .4485,.4569,.4649,.4726,.4800,.4872,.4941,.5008,.5074,.5137, 6937.
6928 3 .5199,.5259,.5318,.5375,.5431,.5486,.5539,.5591,.5642,.5693, 6938.
6929 4 .5742,.5790,.5837,.5884,.5930,.5974,.6018,.6062,.6104,.6146, 6939.
6930 5 .6188,.6228,.6268,.6308,.6347,.6385,.6423,.6460,.6497,.6533/ 6940.
6931 C 6941.
6932 DATA C05T10/0.0, 6942.
6933 1 .3321,.3509,.3665,.3803,.3929,.4045,.4152,.4253,.4348,.4439, 6943.
6934 2 .4525,.4607,.4686,.4762,.4836,.4906,.4975,.5041,.5105,.5168, 6944.
6935 3 .5229,.5288,.5345,.5401,.5457,.5510,.5562,.5614,.5664,.5713, 6945.
6936 4 .5761,.5808,.5854,.5900,.5944,.5988,.6031,.6073,.6115,.6156, 6946.
6937 5 .6196,.6236,.6275,.6313,.6351,.6388,.6425,.6461,.6497,.6532/ 6947.
6938 C 6948.
6939 DATA C05T99/0.0, 6949.
6940 1 .3759,.3933,.4078,.4204,.4320,.4425,.4522,.4614,.4699,.4781, 6950.
6941 2 .4857,.4930,.5000,.5067,.5131,.5192,.5252,.5309,.5364,.5417, 6951.
6942 3 .5469,.5519,.5568,.5615,.5661,.5705,.5749,.5791,.5832,.5873, 6952.
6943 4 .5912,.5950,.5988,.6024,.6060,.6095,.6130,.6164,.6196,.6229, 6953.
6944 5 .6260,.6292,.6322,.6352,.6381,.6410,.6439,.6467,.6494,.6521/ 6954.
6945 C 6955.
6946 DATA C06T01/0.0, 6956.
6947 1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6957.
6948 2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6958.
6949 3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6959.
6950 4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6960.
6951 5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6961.
6952 C 6962.
6953 DATA C06T02/0.0, 6963.
6954 1 .2301,.2561,.2779,.2973,.3151,.3317,.3472,.3620,.3761,.3897, 6964.
6955 2 .4028,.4155,.4279,.4399,.4518,.4633,.4747,.4858,.4968,.5076, 6965.
6956 3 .5182,.5287,.5389,.5490,.5589,.5686,.5781,.5875,.5967,.6057, 6966.
6957 4 .6144,.6230,.6315,.6397,.6478,.6556,.6633,.6708,.6781,.6853, 6967.
6958 5 .6922,.6991,.7057,.7121,.7184,.7246,.7306,.7364,.7421,.7476/ 6968.
6959 C 6969.
6960 DATA C06T03/0.0, 6970.
6961 1 .2848,.3100,.3311,.3497,.3668,.3825,.3971,.4110,.4240,.4365, 6971.
6962 2 .4484,.4599,.4710,.4816,.4921,.5021,.5119,.5214,.5308,.5399, 6972.
6963 3 .5488,.5575,.5661,.5745,.5828,.5908,.5988,.6066,.6142,.6217, 6973.
6964 4 .6291,.6364,.6435,.6505,.6574,.6641,.6707,.6772,.6835,.6898, 6974.
6965 5 .6959,.7019,.7077,.7135,.7191,.7246,.7300,.7353,.7404,.7455/ 6975.
6966 C 6976.
6967 DATA C06T04/0.0, 6977.
6968 1 .3189,.3434,.3639,.3819,.3983,.4134,.4273,.4406,.4529,.4647, 6978.
6969 2 .4759,.4867,.4970,.5069,.5165,.5258,.5348,.5435,.5519,.5602, 6979.
6970 3 .5682,.5761,.5837,.5912,.5985,.6057,.6127,.6196,.6263,.6330, 6980.
6971 4 .6395,.6459,.6521,.6583,.6644,.6703,.6761,.6819,.6875,.6931, 6981.
6972 5 .6985,.7039,.7091,.7143,.7194,.7243,.7292,.7340,.7387,.7433/ 6982.
6973 C 6983.
6974 DATA C06T05/0.0, 6984.
6975 1 .3420,.3660,.3859,.4034,.4193,.4339,.4474,.4601,.4720,.4833, 6985.
6976 2 .4940,.5043,.5141,.5235,.5326,.5413,.5498,.5579,.5658,.5736, 6986.
6977 3 .5810,.5883,.5954,.6023,.6091,.6157,.6221,.6285,.6346,.6407, 6987.
6978 4 .6466,.6525,.6582,.6638,.6693,.6747,.6800,.6853,.6904,.6955, 6988.
6979 5 .7004,.7053,.7101,.7148,.7194,.7240,.7285,.7329,.7372,.7415/ 6989.
6980 C 6990.
6981 DATA C06T06/0.0, 6991.
6982 1 .3586,.3821,.4016,.4187,.4342,.4484,.4615,.4739,.4854,.4964, 6992.
6983 2 .5067,.5166,.5260,.5350,.5438,.5521,.5602,.5680,.5755,.5829, 6993.
6984 3 .5899,.5968,.6036,.6101,.6165,.6227,.6287,.6347,.6405,.6462, 6994.
6985 4 .6517,.6571,.6625,.6677,.6729,.6779,.6828,.6877,.6925,.6972, 6995.
6986 5 .7018,.7063,.7108,.7152,.7195,.7237,.7279,.7320,.7360,.7400/ 6996.
6987 C 6997.
6988 DATA C06T07/0.0, 6998.
6989 1 .3711,.3942,.4133,.4301,.4453,.4592,.4720,.4841,.4953,.5060, 6999.
6990 2 .5160,.5256,.5348,.5435,.5520,.5600,.5678,.5753,.5826,.5896, 7000.
6991 3 .5964,.6031,.6095,.6157,.6219,.6278,.6336,.6392,.6447,.6501, 7001.
6992 4 .6554,.6606,.6657,.6706,.6755,.6802,.6849,.6895,.6940,.6985, 7002.
6993 5 .7028,.7071,.7113,.7154,.7195,.7235,.7274,.7313,.7351,.7388/ 7003.
6994 C 7004.
6995 DATA C06T08/0.0, 7005.
6996 1 .3808,.4036,.4224,.4390,.4539,.4676,.4801,.4920,.5029,.5134, 7006.
6997 2 .5232,.5326,.5415,.5500,.5582,.5660,.5736,.5809,.5880,.5948, 7007.
6998 3 .6014,.6078,.6140,.6200,.6259,.6316,.6372,.6427,.6480,.6532, 7008.
6999 4 .6582,.6632,.6681,.6728,.6775,.6820,.6865,.6909,.6952,.6994, 7009.
7000 5 .7036,.7077,.7117,.7156,.7195,.7233,.7270,.7307,.7343,.7379/ 7010.
7001 C 7011.
7002 DATA C06T09/0.0, 7012.
7003 1 .3886,.4111,.4297,.4460,.4607,.4742,.4865,.4982,.5089,.5192, 7013.
7004 2 .5288,.5380,.5467,.5551,.5631,.5708,.5782,.5853,.5922,.5988, 7014.
7005 3 .6052,.6115,.6175,.6234,.6291,.6347,.6401,.6454,.6505,.6555, 7015.
7006 4 .6604,.6652,.6699,.6745,.6790,.6834,.6877,.6920,.6961,.7002, 7016.
7007 5 .7042,.7081,.7119,.7157,.7195,.7231,.7267,.7303,.7337,.7372/ 7017.
7008 C 7018.
7009 DATA C06T10/0.0, 7019.
7010 1 .3949,.4172,.4356,.4517,.4663,.4796,.4917,.5032,.5138,.5239, 7020.
7011 2 .5334,.5424,.5510,.5592,.5671,.5746,.5819,.5888,.5955,.6021, 7021.
7012 3 .6083,.6144,.6203,.6261,.6317,.6371,.6424,.6475,.6525,.6574, 7022.
7013 4 .6622,.6668,.6714,.6759,.6802,.6845,.6887,.6928,.6968,.7008, 7023.
7014 5 .7046,.7085,.7122,.7159,.7195,.7230,.7265,.7299,.7333,.7366/ 7024.
7015 C 7025.
7016 DATA C06T99/0.0, 7026.
7017 1 .4509,.4707,.4871,.5013,.5141,.5256,.5362,.5461,.5551,.5638, 7027.
7018 2 .5718,.5794,.5866,.5934,.6000,.6062,.6122,.6178,.6233,.6286, 7028.
7019 3 .6336,.6386,.6433,.6478,.6523,.6565,.6607,.6647,.6686,.6724, 7029.
7020 4 .6761,.6797,.6832,.6866,.6900,.6932,.6964,.6995,.7025,.7055, 7030.
7021 5 .7084,.7112,.7140,.7167,.7194,.7220,.7245,.7270,.7295,.7319/ 7031.
7022 C 7032.
7023 DATA C07T01/0.0, 7033.
7024 1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 7034.
7025 2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 7035.
7026 3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 7036.
7027 4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 7037.
7028 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 7038.
7029 C 7039.
7030 DATA C07T02/0.0, 7040.
7031 1 .2601,.2939,.3219,.3466,.3691,.3898,.4090,.4272,.4442,.4606, 7041.
7032 2 .4762,.4912,.5057,.5198,.5334,.5466,.5596,.5721,.5843,.5963, 7042.
7033 3 .6078,.6192,.6302,.6410,.6515,.6616,.6715,.6811,.6904,.6995, 7043.
7034 4 .7083,.7168,.7251,.7331,.7409,.7483,.7556,.7626,.7694,.7760, 7044.
7035 5 .7824,.7885,.7945,.8002,.8058,.8111,.8163,.8214,.8262,.8309/ 7045.
7036 C 7046.
7037 DATA C07T03/0.0, 7047.
7038 1 .3256,.3578,.3842,.4074,.4283,.4473,.4648,.4813,.4966,.5111, 7048.
7039 2 .5248,.5379,.5504,.5624,.5740,.5851,.5959,.6063,.6163,.6262, 7049.
7040 3 .6357,.6450,.6540,.6628,.6715,.6798,.6880,.6960,.7037,.7113, 7050.
7041 4 .7187,.7259,.7330,.7398,.7465,.7530,.7594,.7656,.7716,.7774, 7051.
7042 5 .7831,.7887,.7940,.7993,.8044,.8093,.8141,.8188,.8233,.8278/ 7052.
7043 C 7053.
7044 DATA C07T04/0.0, 7054.
7045 1 .3675,.3983,.4235,.4455,.4652,.4831,.4995,.5149,.5290,.5424, 7055.
7046 2 .5550,.5670,.5783,.5892,.5996,.6096,.6192,.6284,.6374,.6461, 7056.
7047 3 .6544,.6626,.6705,.6781,.6857,.6929,.7000,.7070,.7137,.7204, 7057.
7048 4 .7268,.7331,.7393,.7453,.7512,.7569,.7625,.7680,.7734,.7786, 7058.
7049 5 .7837,.7887,.7936,.7983,.8030,.8075,.8119,.8163,.8205,.8246/ 7059.
7050 C 7060.
7051 DATA C07T05/0.0, 7061.
7052 1 .3963,.4260,.4503,.4714,.4902,.5073,.5228,.5374,.5507,.5634, 7062.
7053 2 .5752,.5864,.5970,.6071,.6168,.6260,.6349,.6434,.6516,.6596, 7063.
7054 3 .6672,.6746,.6818,.6888,.6956,.7022,.7086,.7149,.7210,.7270, 7064.
7055 4 .7328,.7384,.7440,.7494,.7547,.7599,.7650,.7699,.7748,.7796, 7065.
7056 5 .7842,.7887,.7932,.7976,.8018,.8060,.8101,.8141,.8180,.8218/ 7066.
7057 C 7067.
7058 DATA C07T06/0.0, 7068.
7059 1 .4172,.4461,.4696,.4900,.5082,.5246,.5395,.5535,.5662,.5783, 7069.
7060 2 .5895,.6001,.6102,.6198,.6289,.6376,.6460,.6540,.6617,.6691, 7070.
7061 3 .6763,.6832,.6899,.6964,.7028,.7089,.7148,.7206,.7263,.7318, 7071.
7062 4 .7371,.7424,.7475,.7525,.7574,.7622,.7668,.7714,.7759,.7803, 7072.
7063 5 .7846,.7888,.7929,.7969,.8009,.8048,.8086,.8123,.8159,.8195/ 7073.
7064 C 7074.
7065 DATA C07T07/0.0, 7075.
7066 1 .4331,.4613,.4842,.5040,.5216,.5375,.5520,.5654,.5777,.5893, 7076.
7067 2 .6001,.6104,.6200,.6291,.6379,.6462,.6542,.6618,.6691,.6762, 7077.
7068 3 .6830,.6896,.6959,.7021,.7081,.7138,.7194,.7249,.7302,.7354, 7078.
7069 4 .7404,.7453,.7502,.7548,.7594,.7639,.7683,.7726,.7768,.7809, 7079.
7070 5 .7849,.7888,.7927,.7965,.8002,.8038,.8074,.8109,.8143,.8177/ 7080.
7071 C 7081.
7072 DATA C07T08/0.0, 7082.
7073 1 .4455,.4731,.4955,.5148,.5320,.5475,.5616,.5747,.5866,.5979, 7083.
7074 2 .6083,.6182,.6275,.6363,.6448,.6528,.6605,.6678,.6748,.6816, 7084.
7075 3 .6881,.6944,.7005,.7064,.7121,.7176,.7230,.7282,.7332,.7382, 7085.
7076 4 .7430,.7476,.7522,.7566,.7610,.7652,.7694,.7735,.7774,.7813, 7086.
7077 5 .7851,.7889,.7925,.7961,.7996,.8030,.8064,.8097,.8130,.8162/ 7087.
7078 C 7088.
7079 DATA C07T09/0.0, 7089.
7080 1 .4555,.4826,.5046,.5235,.5404,.5555,.5692,.5820,.5936,.6046, 7090.
7081 2 .6147,.6244,.6334,.6420,.6502,.6579,.6654,.6725,.6793,.6859, 7091.
7082 3 .6921,.6982,.7041,.7098,.7153,.7206,.7257,.7308,.7356,.7404, 7092.
7083 4 .7449,.7494,.7538,.7581,.7622,.7663,.7703,.7742,.7780,.7817, 7093.
7084 5 .7853,.7889,.7924,.7958,.7992,.8024,.8057,.8088,.8119,.8150/ 7094.
7085 C 7095.
7086 DATA C07T10/0.0, 7096.
7087 1 .4637,.4903,.5120,.5306,.5471,.5620,.5754,.5879,.5993,.6101, 7097.
7088 2 .6200,.6294,.6382,.6466,.6546,.6621,.6694,.6763,.6829,.6893, 7098.
7089 3 .6954,.7013,.7070,.7125,.7179,.7230,.7280,.7328,.7375,.7421, 7099.
7090 4 .7465,.7509,.7551,.7592,.7632,.7672,.7710,.7747,.7784,.7820, 7100.
7091 5 .7855,.7889,.7923,.7956,.7988,.8020,.8051,.8081,.8111,.8140/ 7101.
7092 C 7102.
7093 DATA C07T99/0.0, 7103.
7094 1 .5366,.5590,.5770,.5924,.6060,.6180,.6289,.6389,.6480,.6565, 7104.
7095 2 .6643,.6717,.6785,.6850,.6912,.6969,.7025,.7077,.7127,.7175, 7105.
7096 3 .7220,.7264,.7306,.7347,.7386,.7423,.7460,.7495,.7529,.7562, 7106.
7097 4 .7594,.7625,.7655,.7684,.7712,.7740,.7767,.7793,.7818,.7843, 7107.
7098 5 .7867,.7891,.7914,.7937,.7959,.7981,.8002,.8022,.8043,.8062/ 7108.
7099 C 7109.
7100 DATA C08T01/0.0, 7110.
7101 1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 7111.
7102 2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 7112.
7103 3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 7113.
7104 4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 7114.
7105 5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 7115.
7106 C 7116.
7107 DATA C08T02/0.0, 7117.
7108 1 .2878,.3342,.3718,.4041,.4329,.4588,.4824,.5045,.5249,.5442, 7118.
7109 2 .5623,.5797,.5962,.6120,.6272,.6417,.6559,.6693,.6823,.6949, 7119.
7110 3 .7069,.7186,.7298,.7405,.7509,.7606,.7701,.7792,.7879,.7963, 7120.
7111 4 .8042,.8118,.8191,.8260,.8327,.8390,.8451,.8509,.8564,.8617, 7121.
7112 5 .8667,.8716,.8762,.8806,.8848,.8888,.8926,.8963,.8998,.9032/ 7122.
7113 C 7123.
7114 DATA C08T03/0.0, 7124.
7115 1 .3656,.4087,.4432,.4725,.4984,.5215,.5422,.5614,.5789,.5954, 7125.
7116 2 .6106,.6251,.6387,.6517,.6641,.6758,.6872,.6981,.7085,.7187, 7126.
7117 3 .7283,.7378,.7468,.7555,.7641,.7722,.7801,.7878,.7951,.8022, 7127.
7118 4 .8091,.8157,.8221,.8282,.8342,.8399,.8454,.8507,.8558,.8608, 7128.
7119 5 .8655,.8700,.8744,.8786,.8826,.8865,.8903,.8939,.8973,.9006/ 7129.
7120 C 7130.
7121 DATA C08T04/0.0, 7131.
7122 1 .4167,.4573,.4895,.5167,.5405,.5616,.5805,.5979,.6136,.6283, 7132.
7123 2 .6419,.6547,.6668,.6781,.6890,.6992,.7091,.7184,.7274,.7361, 7133.
7124 3 .7444,.7525,.7602,.7677,.7750,.7820,.7888,.7954,.8018,.8080, 7134.
7125 4 .8139,.8197,.8254,.8308,.8361,.8412,.8462,.8510,.8556,.8601, 7135.
7126 5 .8645,.8687,.8728,.8767,.8805,.8842,.8877,.8912,.8945,.8977/ 7136.
7127 C 7137.
7128 DATA C08T05/0.0, 7138.
7129 1 .4528,.4913,.5218,.5473,.5696,.5893,.6069,.6230,.6375,.6511, 7139.
7130 2 .6635,.6752,.6862,.6965,.7063,.7156,.7245,.7329,.7409,.7487, 7140.
7131 3 .7561,.7633,.7703,.7769,.7834,.7896,.7957,.8015,.8072,.8127, 7141.
7132 4 .8180,.8232,.8283,.8332,.8379,.8426,.8470,.8514,.8556,.8598, 7142.
7133 5 .8638,.8677,.8714,.8751,.8787,.8821,.8855,.8887,.8919,.8950/ 7143.
7134 C 7144.
7135 DATA C08T06/0.0, 7145.
7136 1 .4795,.5164,.5454,.5697,.5909,.6095,.6261,.6412,.6548,.6675, 7146.
7137 2 .6791,.6901,.7003,.7098,.7190,.7275,.7357,.7435,.7509,.7581, 7147.
7138 3 .7648,.7714,.7778,.7838,.7898,.7954,.8009,.8063,.8115,.8165, 7148.
7139 4 .8214,.8261,.8307,.8352,.8395,.8437,.8479,.8519,.8558,.8596, 7149.
7140 5 .8633,.8669,.8704,.8738,.8772,.8804,.8836,.8866,.8896,.8925/ 7150.
7141 C 7151.
7142 DATA C08T07/0.0, 7152.
7143 1 .5000,.5356,.5635,.5868,.6070,.6248,.6406,.6550,.6679,.6800, 7153.
7144 2 .6909,.7013,.7109,.7199,.7285,.7365,.7442,.7515,.7584,.7651, 7154.
7145 3 .7715,.7776,.7835,.7892,.7947,.7999,.8051,.8100,.8148,.8195, 7155.
7146 4 .8240,.8284,.8327,.8368,.8408,.8448,.8486,.8523,.8560,.8595, 7156.
7147 5 .8630,.8663,.8696,.8728,.8759,.8790,.8820,.8849,.8877,.8905/ 7157.
7148 C 7158.
7149 DATA C08T08/0.0, 7159.
7150 1 .5162,.5507,.5777,.6002,.6197,.6368,.6519,.6657,.6781,.6896, 7160.
7151 2 .7001,.7100,.7191,.7277,.7359,.7435,.7508,.7577,.7643,.7706, 7161.
7152 3 .7766,.7824,.7880,.7933,.7986,.8035,.8083,.8130,.8175,.8219, 7162.
7153 4 .8261,.8302,.8343,.8381,.8419,.8456,.8492,.8527,.8561,.8595, 7163.
7154 5 .8627,.8659,.8690,.8720,.8750,.8778,.8806,.8834,.8861,.8887/ 7164.
7155 C 7165.
7156 DATA C08T09/0.0, 7166.
7157 1 .5293,.5629,.5891,.6109,.6298,.6464,.6610,.6743,.6862,.6974, 7167.
7158 2 .7074,.7169,.7257,.7340,.7418,.7491,.7561,.7627,.7690,.7750, 7168.
7159 3 .7807,.7863,.7916,.7967,.8016,.8063,.8109,.8154,.8196,.8238, 7169.
7160 4 .8278,.8317,.8356,.8392,.8428,.8463,.8497,.8531,.8563,.8595, 7170.
7161 5 .8625,.8656,.8685,.8714,.8742,.8769,.8796,.8822,.8847,.8872/ 7171.
7162 C 7172.
7163 DATA C08T10/0.0, 7173.
7164 1 .5401,.5729,.5985,.6197,.6381,.6542,.6684,.6813,.6929,.7036, 7174.
7165 2 .7134,.7226,.7311,.7390,.7466,.7536,.7604,.7667,.7728,.7786, 7175.
7166 3 .7841,.7894,.7945,.7994,.8042,.8087,.8131,.8173,.8214,.8254, 7176.
7167 4 .8292,.8330,.8366,.8401,.8436,.8469,.8502,.8534,.8564,.8595, 7177.
7168 5 .8624,.8653,.8681,.8708,.8735,.8761,.8787,.8812,.8836,.8860/ 7178.
7169 C 7179.
7170 DATA C08T99/0.0, 7180.
7171 1 .6384,.6631,.6821,.6978,.7111,.7227,.7328,.7420,.7501,.7576, 7181.
7172 2 .7644,.7707,.7765,.7819,.7870,.7918,.7963,.8005,.8045,.8084, 7182.
7173 3 .8120,.8154,.8187,.8219,.8250,.8278,.8307,.8334,.8360,.8385, 7183.
7174 4 .8409,.8432,.8455,.8477,.8498,.8519,.8539,.8559,.8578,.8596, 7184.
7175 5 .8614,.8632,.8648,.8665,.8681,.8697,.8712,.8728,.8742,.8757/ 7185.
7176 C 7186.
7177 DATA C09T01/0.0, 7187.
7178 1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 7188.
7179 2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 7189.
7180 3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 7190.
7181 4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 7191.
7182 5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 7192.
7183 C 7193.
7184 DATA C09T02/0.0, 7194.
7185 1 .3174,.3895,.4438,.4879,.5256,.5583,.5872,.6136,.6374,.6597, 7195.
7186 2 .6802,.6995,.7175,.7345,.7506,.7655,.7798,.7930,.8055,.8173, 7196.
7187 3 .8281,.8385,.8481,.8570,.8655,.8731,.8804,.8872,.8935,.8994, 7197.
7188 4 .9049,.9099,.9148,.9191,.9233,.9271,.9307,.9341,.9373,.9402, 7198.
7189 5 .9430,.9456,.9480,.9503,.9524,.9544,.9563,.9581,.9598,.9613/ 7199.
7190 C 7200.
7191 DATA C09T03/0.0, 7201.
7192 1 .4078,.4729,.5209,.5592,.5915,.6191,.6431,.6649,.6842,.7022, 7202.
7193 2 .7185,.7339,.7481,.7614,.7741,.7859,.7972,.8078,.8178,.8274, 7203.
7194 3 .8364,.8451,.8532,.8608,.8682,.8750,.8815,.8877,.8934,.8989, 7204.
7195 4 .9040,.9089,.9135,.9177,.9218,.9256,.9292,.9326,.9358,.9388, 7205.
7196 5 .9416,.9443,.9468,.9491,.9514,.9535,.9554,.9573,.9591,.9607/ 7206.
7197 C 7207.
7198 DATA C09T04/0.0, 7208.
7199 1 .4692,.5288,.5723,.6066,.6353,.6597,.6807,.6997,.7163,.7318, 7209.
7200 2 .7457,.7588,.7708,.7821,.7927,.8026,.8121,.8210,.8295,.8376, 7210.
7201 3 .8452,.8525,.8595,.8661,.8724,.8784,.8841,.8896,.8948,.8998, 7211.
7202 4 .9044,.9089,.9132,.9172,.9210,.9247,.9281,.9314,.9345,.9374, 7212.
7203 5 .9402,.9429,.9453,.9477,.9500,.9521,.9541,.9560,.9579,.9596/ 7213.
7204 C 7214.
7205 DATA C09T05/0.0, 7215.
7206 1 .5136,.5690,.6090,.6404,.6666,.6886,.7076,.7246,.7394,.7532, 7216.
7207 2 .7655,.7771,.7877,.7976,.8069,.8156,.8239,.8316,.8390,.8461, 7217.
7208 3 .8528,.8592,.8653,.8711,.8767,.8820,.8871,.8920,.8967,.9012, 7218.
7209 4 .9054,.9095,.9134,.9171,.9207,.9241,.9274,.9305,.9335,.9363, 7219.
7210 5 .9390,.9416,.9440,.9464,.9486,.9507,.9527,.9546,.9565,.9582/ 7220.
7211 C 7221.
7212 DATA C09T06/0.0, 7222.
7213 1 .5473,.5993,.6366,.6658,.6900,.7102,.7277,.7432,.7568,.7693, 7223.
7214 2 .7805,.7910,.8006,.8095,.8179,.8257,.8332,.8401,.8468,.8531, 7224.
7215 3 .8591,.8648,.8703,.8755,.8806,.8853,.8899,.8944,.8986,.9027, 7225.
7216 4 .9066,.9103,.9140,.9174,.9207,.9239,.9270,.9299,.9327,.9354, 7226.
7217 5 .9380,.9405,.9429,.9451,.9473,.9494,.9514,.9533,.9551,.9568/ 7227.
7218 C 7228.
7219 DATA C09T07/0.0, 7229.
7220 1 .5737,.6230,.6581,.6855,.7081,.7271,.7433,.7577,.7703,.7819, 7230.
7221 2 .7922,.8019,.8107,.8189,.8266,.8338,.8406,.8470,.8530,.8588, 7231.
7222 3 .8643,.8695,.8745,.8793,.8839,.8883,.8925,.8966,.9004,.9042, 7232.
7223 4 .9078,.9113,.9146,.9178,.9209,.9239,.9268,.9295,.9322,.9348, 7233.
7224 5 .9372,.9396,.9419,.9441,.9462,.9482,.9502,.9520,.9538,.9555/ 7234.
7225 C 7235.
7226 DATA C09T08/0.0, 7236.
7227 1 .5950,.6420,.6754,.7013,.7226,.7405,.7557,.7693,.7811,.7919, 7237.
7228 2 .8016,.8106,.8188,.8265,.8337,.8403,.8466,.8525,.8582,.8635, 7238.
7229 3 .8686,.8734,.8781,.8825,.8868,.8908,.8947,.8985,.9021,.9056, 7239.
7230 4 .9089,.9121,.9153,.9183,.9212,.9240,.9267,.9293,.9318,.9343, 7240.
7231 5 .9366,.9389,.9411,.9432,.9452,.9472,.9490,.9509,.9526,.9543/ 7241.
7232 C 7242.
7233 DATA C09T09/0.0, 7243.
7234 1 .6125,.6576,.6894,.7142,.7345,.7514,.7659,.7787,.7899,.8001, 7244.
7235 2 .8093,.8177,.8255,.8327,.8394,.8457,.8516,.8572,.8624,.8675, 7245.
7236 3 .8722,.8767,.8811,.8852,.8892,.8930,.8966,.9002,.9035,.9068, 7246.
7237 4 .9100,.9130,.9159,.9187,.9215,.9241,.9267,.9292,.9316,.9339, 7247.
7238 5 .9361,.9383,.9404,.9424,.9443,.9462,.9481,.9498,.9515,.9532/ 7248.
7239 C 7249.
7240 DATA C09T10/0.0, 7250.
7241 1 .6272,.6706,.7012,.7249,.7443,.7605,.7743,.7866,.7972,.8069, 7251.
7242 2 .8156,.8236,.8310,.8378,.8442,.8501,.8558,.8610,.8660,.8708, 7252.
7243 3 .8752,.8795,.8836,.8875,.8913,.8949,.8983,.9016,.9048,.9079, 7253.
7244 4 .9109,.9137,.9165,.9192,.9218,.9243,.9267,.9291,.9314,.9336, 7254.
7245 5 .9357,.9378,.9398,.9417,.9436,.9454,.9472,.9489,.9506,.9522/ 7255.
7246 C 7256.
7247 DATA C09T99/0.0, 7257.
7248 1 .7681,.7934,.8109,.8243,.8350,.8439,.8514,.8579,.8636,.8687, 7258.
7249 2 .8732,.8774,.8812,.8847,.8880,.8910,.8938,.8964,.8989,.9013, 7259.
7250 3 .9035,.9056,.9076,.9095,.9113,.9130,.9147,.9163,.9178,.9193, 7260.
7251 4 .9207,.9221,.9234,.9247,.9260,.9271,.9283,.9294,.9305,.9316, 7261.
7252 5 .9326,.9336,.9346,.9355,.9364,.9373,.9382,.9390,.9398,.9406/ 7262.
7253 C 7263.
7254 C 7264.
7255 C ---------------------------------------------------------------- 7265.
7256 C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 7266.
7257 C FOR CLOUD ALBEDOS FOR OPTICAL THICKNESS FROM (1.0 < TAU < 99.0) 7267.
7258 C ---------------------------------------------------------------- 7268.
7259 C 7269.
7260 C 7270.
7261 C ------------------------------------------- 7271.
7262 C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 7272.
7263 C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 7273.
7264 C ------------------------------------------- 7274.
7265 C 7275.
7266 XI=XMU*50.0+0.9999 7276.
7267 IX=XI 7277.
7268 IF(IX.LT.1) IX=1 7278.
7269 JX=IX+1 7279.
7270 WXJ=XI-IX 7280.
7271 WXI=1.0-WXJ 7281.
7272 C 7282.
7273 C ----------------------- 7283.
7274 C CLOUD TAU INTERPOLATION 7284.
7275 C 1.0 OVER (1 < TAU < 10) 7285.
7276 C LINEAR (10 < TAU < 100) 7286.
7277 C ----------------------- 7287.
7278 C 7288.
7279 TI=TAU 7289.
7280 IT=TI 7290.
7281 IF(IT.LT.1) IT=1 7291.
7282 WTJ=TI-IT 7292.
7283 IF(IT.GT.9) THEN 7293.
7284 WTJ=(TAU-10.0)/90.0 7294.
7285 IT=10 7295.
7286 ENDIF 7296.
7287 WTI=1.0-WTJ 7297.
7288 JT=IT+1 7298.
7289 C 7299.
7290 C ------------------------------- 7300.
7291 C COSBAR DEPENDENCE INTERPOLATION 7301.
7292 C 0.10 ON (0.5 < COSBAR < 0.9) 7302.
7293 C LINEAR FOR (0.0 < COSBAR < 0.5) 7303.
7294 C ------------------------------- 7304.
7295 C 7305.
7296 GI=G*10.0 7306.
7297 IF(GI.GT.5.0) GO TO 110 7307.
7298 JG=1 7308.
7299 GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7309.
7300 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7310.
7301 GG=GG+GG 7311.
7302 GO TO 130 7312.
7303 C 7313.
7304 110 IG=GI 7314.
7305 WGJ=GI-IG 7315.
7306 WGI=1.0-WGJ 7316.
7307 IG=IG-4 7317.
7308 JG=IG+1 7318.
7309 IF(IG.GT.4) GO TO 120 7319.
7310 C 7320.
7311 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7321.
7312 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7322.
7313 + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7323.
7314 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7324.
7315 GO TO 130 7325.
7316 C 7326.
7317 120 IG=5 7327.
7318 C 7328.
7319 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7329.
7320 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7330.
7321 + +WGJ 7331.
7322 C 7332.
7323 130 CONTINUE 7333.
7324 C 7334.
7325 RETURN 7335.
7326 END 7336.
  ViewVC Help
Powered by ViewVC 1.1.22