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

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

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

Revision 1.1 - (hide annotations) (download)
Fri Aug 11 19:35:31 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN 
atm2d package
1 jscott 1.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