/[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.2 - (hide annotations) (download)
Mon Apr 23 21:20:18 2007 UTC (18 years, 3 months ago) by jscott
Branch: MAIN
Changes since 1.1: +9 -8 lines 
bring igsm atmos code up to date
1 jscott 1.2 c source sokolov users 559243 Aug 15 2006 /home/sokolov/IGSM2/SRC/r95mit.F
2 jscott 1.1 #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 jscott 1.2 #include "CLM.h"
204 jscott 1.1 #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 jscott 1.2 i=1
448     BEAVIS=0.7*asdirclm(i,JLAT)+0.3*asdifclm(i,JLAT)
449     BEANIR=0.7*aldirclm(i,JLAT)+0.3*aldifclm(i,JLAT)
450 jscott 1.1 XEAVIS=BEAVIS
451     XEANIR=BEANIR
452     c endif
453     c if(ncallclm.eq.0)then
454     c print *,JLAT,BEAVIS,BEANIR
455     c endif
456     #endif
457    
458     C 445.
459     ITEA=TGE 446.
460     WTEA=TGE-ITEA 447.
461     ITEA=ITEA-IT0 448.
462     BEASUM=0. 449.
463     BEAM=0. 450.
464     BEAP=0. 451.
465     C 452.
466     C 467.
467     DO 450 K=1,NKTR 453.
468     TRAPEA=AGSIDV(K,1)*(1.-EXPSNE) 454.
469     + +AGSIDV(K,3)*DSFRAC*(1.-WETTRA*WEARTH) 455.
470     + +AGSIDV(K,4)*VGFRAC 456.
471     BEAM1 =(PLANCK(ITEA-1)-(PLANCK(ITEA-1)-PLANCK(ITEA ))*WTEA) 457.
472     + *(1.-TRAPEA) 458.
473     BEAM =BEAM+BEAM1 459.
474     BEAP1 =(PLANCK(ITEA+1)-(PLANCK(ITEA+1)-PLANCK(ITEA+2))*WTEA) 460.
475     + *(1.-TRAPEA) 461.
476     BEAP =BEAP+BEAP1 462.
477     BEA =(PLANCK(ITEA )-(PLANCK(ITEA )-PLANCK(ITEA+1))*WTEA) 463.
478     + *(1.-TRAPEA) 464.
479     BEASUM=BEASUM+BEA 465.
480     ITEA=ITEA+ITNEXT 466.
481     TRGALB(K)=TRGALB(K)+PEARTH*TRAPEA 468.
482     BGFEMD(K)=BGFEMD(K)+PEARTH*(BEAP1-BEAM1) 469.
483     450 BGFEMT(K)=BGFEMT(K)+PEARTH*BEA 470.
484     DTRUFG(2)=0.5*(BEAP-BEAM) 471.
485     if(ncallclm.eq.-1)then
486     print *,'471 JLAT=',JLAT
487     print *,(ITEA-1),(ITEA),(ITEA+1)
488     print *,PLANCK(ITEA-1),PLANCK(ITEA),PLANCK(ITEA+1)
489     print *,' VGFRAC=',VGFRAC,' DSFRAC=',DSFRAC
490     print *,' WTEA=',WTEA,' WEARTH=',WEARTH
491     print *,' SNOWE=',SNOWE,' EXPSNE=',EXPSNE
492     c print *,JLAT,' BEAVIS=',BEAVIS,' BEANIR=',BEANIR
493     endif
494     C 472.
495     C ------------------------------ 473.
496     C OCEAN ICE ALBEDO SPECIFICATION 474.
497     C ------------------------------ 475.
498     500 CONTINUE 476.
499     IF(POICE.LT.1.E-04) GO TO 600 477.
500     EXPSNO=EXP(-SNOWOI/DMOICE) 478.
501     BOIVIS=AOIVIS*EXPSNO+BSNVIS*(1.-EXPSNO) 479.
502     BOINIR=AOINIR*EXPSNO+BSNNIR*(1.-EXPSNO) 480.
503     XOIVIS=BOIVIS 481.
504     XOINIR=BOINIR 482.
505     C 483.
506     ITOI=TGOI 484.
507     WTOI=TGOI-ITOI 485.
508     ITOI=ITOI-IT0 486.
509     BOISUM=0. 487.
510     BOIM=0. 488.
511     BOIP=0. 489.
512     C 490.
513     DO 510 K=1,NKTR 491.
514     TRAPOI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNO) 492.
515     + +AGSIDV(K,2)*EICTRA*EXPSNO 493.
516     BOIM1 =(PLANCK(ITOI-1)-(PLANCK(ITOI-1)-PLANCK(ITOI ))*WTOI) 494.
517     + *(1.-TRAPOI) 495.
518     BOIM =BOIM+BOIM1 496.
519     BOIP1 =(PLANCK(ITOI+1)-(PLANCK(ITOI+1)-PLANCK(ITOI+2))*WTOI) 497.
520     + *(1.-TRAPOI) 498.
521     BOIP =BOIP+BOIP1 499.
522     BOI =(PLANCK(ITOI )-(PLANCK(ITOI )-PLANCK(ITOI+1))*WTOI) 500.
523     + *(1.-TRAPOI) 501.
524     BOISUM=BOISUM+BOI 502.
525     ITOI=ITOI+ITNEXT 503.
526     C 504.
527     TRGALB(K)=TRGALB(K)+POICE*TRAPOI 505.
528     BGFEMD(K)=BGFEMD(K)+POICE*(BOIP1-BOIM1) 506.
529     510 BGFEMT(K)=BGFEMT(K)+POICE*BOI 507.
530     DTRUFG(3)=0.5*(BOIP-BOIM) 508.
531     C 509.
532     C ----------------------------- 510.
533     C LAND ICE ALBEDO SPECIFICATION 511.
534     C ----------------------------- 512.
535     600 CONTINUE 513.
536     IF(PLICE.LT.1.E-04) GO TO 700 514.
537     EXPSNL=EXP(-SNOWLI/DMLICE) 515.
538     BLIVIS=ALIVIS*EXPSNL+BSNVIS*(1.-EXPSNL) 516.
539     BLINIR=ALINIR*EXPSNL+BSNNIR*(1.-EXPSNL) 517.
540    
541     #if ( defined CLM )
542     c if(ncallclm.ge.1)then
543 jscott 1.2 i=1
544     BLIVIS=0.7*asdirclm(i,JLAT)+0.3*asdifclm(i,JLAT)
545     BLINIR=0.7*aldirclm(i,JLAT)+0.3*aldifclm(i,JLAT)
546 jscott 1.1 c endif
547     #endif
548    
549     XLIVIS=BLIVIS 518.
550     XLINIR=BLINIR 519.
551     C 520.
552     ITLI=TGLI 521.
553     WTLI=TGLI-ITLI 522.
554     ITLI=ITLI-IT0 523.
555     C 524.
556     BLISUM=0. 525.
557     BLIM=0. 526.
558     BLIP=0. 527.
559     BGF=0. 528.
560     C 529.
561     DO 610 K=1,NKTR 530.
562     TRAPLI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNL) 531.
563     + +AGSIDV(K,2)*EICTRA*EXPSNL 532.
564     BLIM1 =(PLANCK(ITLI-1)-(PLANCK(ITLI-1)-PLANCK(ITLI ))*WTLI) 533.
565     + *(1.-TRAPLI) 534.
566     BLIM =BLIM+BLIM1 535.
567     BLIP1 =(PLANCK(ITLI+1)-(PLANCK(ITLI+1)-PLANCK(ITLI+2))*WTLI) 536.
568     + *(1.-TRAPLI) 537.
569     BLIP =BLIP+BLIP1 538.
570     BLI =(PLANCK(ITLI )-(PLANCK(ITLI )-PLANCK(ITLI+1))*WTLI) 539.
571     + *(1.-TRAPLI) 540.
572     BLISUM=BLISUM+BLI 541.
573     ITLI=ITLI+ITNEXT 542.
574     C 543.
575     TRGALB(K)=TRGALB(K)+PLICE*TRAPLI 544.
576     BGFEMD(K)=BGFEMD(K)+PLICE*(BLIP1-BLIM1) 545.
577     610 BGFEMT(K)=BGFEMT(K)+PLICE*BLI 546.
578     DTRUFG(4)=0.5*(BLIP-BLIM) 547.
579     C 548.
580     700 CONTINUE 549.
581     BVSURF=POCEAN*BOCVIS +PEARTH*BEAVIS +POICE*BOIVIS +PLICE*BLIVIS 550.
582     XVSURF=POCEAN*XOCVIS +PEARTH*XEAVIS +POICE*XOIVIS +PLICE*XLIVIS 551.
583     BNSURF=POCEAN*BOCNIR +PEARTH*BEANIR +POICE*BOINIR +PLICE*BLINIR 552.
584     XNSURF=POCEAN*XOCNIR +PEARTH*XEANIR +POICE*XOINIR +PLICE*XLINIR 553.
585    
586     #if ( !defined CPL_CHEM ) && ( (defined SVI_ALBEDO || defined GHS_ALB) )
587     IF(COSZ.GE.0.01) then
588     XALBEDO=0.6*XVSURF+0.4*XNSURF
589     SECZ=1./COSZ
590     if(JLAT.le.-2)then
591     print *,' JLAT=',JLAT
592     print *,' COSZ=',COSZ
593     print*,POCEAN,PEARTH,POICE,PLICE
594     print *,' XALBEDO=',XALBEDO
595     print *,BVSURF,XVSURF,BNSURF,XNSURF
596     endif
597     BVSURF=BVSURF+BVSURFA*(1.-XALBEDO)**2*SECZ
598     XVSURF=XVSURF+XVSURFA*(1.-XALBEDO)**2*SECZ
599     BNSURF=BNSURF+BNSURFA*(1.-XALBEDO)**2*SECZ
600     XNSURF=XNSURF+XNSURFA*(1.-XALBEDO)**2*SECZ
601     if(JLAT.eq.-10)then
602     print *,' After add'
603     print *,'BVSURFA=',BVSURFA
604     print *,'DAsrf=',BVSURFA*(1.-XALBEDO)**2*SECZ
605     print *,BVSURF,XVSURF,BNSURF,XNSURF
606     endif
607     endif
608     #endif
609    
610     C ---------------------------------------------------------------- 554.
611     C SPECTRAL DISTRIBUTION ASSUMES THAT: AMEAN = 0.6*AVIS + 0.4*ANIR 555.
612     C ---------------------------------------------------------------- 556.
613     C 557.
614     IF(KEEPAL.EQ.1) GO TO 800 558.
615     SRBALB(6)=BVSURF+0.4*VISNIR*(BNSURF-BVSURF) 559.
616     SRXALB(6)=XVSURF+0.4*VISNIR*(XNSURF-XVSURF) 560.
617     DO 710 I=1,5 561.
618     SRBALB(I)=BNSURF-0.6*VISNIR*(BNSURF-BVSURF) 562.
619     710 SRXALB(I)=XNSURF-0.6*VISNIR*(XNSURF-XVSURF) 563.
620     IF(KALVIS.EQ.0) GO TO 800 564.
621     SRBALB(4)=SRBALB(6) 565.
622     SRXALB(4)=SRXALB(6) 566.
623     C 567.
624     C-------------------------------------------------------------------- 568.
625     C DEFINE SURFACE FLUX FACTORS, FLUX DERIVATIVES FOR EACH SURFTYPE 569.
626     C-------------------------------------------------------------------- 570.
627     800 BGF=0. 571.
628     DO 810 K=1,NKTR 572.
629     BGFEMD(K)=BGFEMD(K)*0.5 573.
630     810 BGF=BGF+BGFEMT(K) 574.
631     C 575.
632     BGM=BOCM*POCEAN+BEAM*PEARTH+BOIM*POICE+BLIM*PLICE 576.
633     BGP=BOCP*POCEAN+BEAP*PEARTH+BOIP*POICE+BLIP*PLICE 577.
634     TTRUFG=0.5*(BGP-BGM) 578.
635     C 579.
636     FTRUFG(1)=BOCSUM/BGF 580.
637     FTRUFG(2)=BEASUM/BGF 581.
638     FTRUFG(3)=BOISUM/BGF 582.
639     FTRUFG(4)=BLISUM/BGF 583.
640     C 584.
641     RETURN 585.
642     END 586.
643     c SUBROUTINE SETGAS 587.
644     c 20/06/2005
645     SUBROUTINE SETGAS(KTREND)
646    
647     #include "B83XX.COM" 588.
648     #include "chem_para"
649     #include "chem_com"
650    
651     EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 649.
652     EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 650.
653     C 651.
654     C 652.
655     C---------------------------------------------------------------------- 653.
656     C GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS 654.
657     C---------------------------------------------------------------------- 655.
658     C 656.
659     COMMON/O3GLOB/ PLB0(40),TLM0(40),U0GAS3(40) 656.11
660     DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 657.
661     DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 658.
662     + ,3.7338E-03/ 659.
663     DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/ 660.
664     DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 661.
665     DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 662.
666     DATA HPCON/34.16319/ 663.
667     DATA PI/3.1415926/ 664.
668     DATA P0/1013.25/ 665.
669     C 666.
670     DIMENSION KGAS(9,3) 667.
671     DATA KGAS/ 1, 2, 3, 0, 0, 9, 11, 12, 13 668.
672     + , 4, 6, 8, 0, 0,10, 0, 0, 0 669.
673     + , 5, 7, 0, 0, 0, 0, 0, 0, 0/ 670.
674     C 671.
675     C ----------------------------------------------------- 672.
676     C USE PLB TO FIX STANDARD HEIGHTS FOR GAS DISTRIBUTIONS 673.
677     C ----------------------------------------------------- 674.
678     C 675.
679     c print *,'FROM SETGAS PREDICTED_GASES=',PREDICTED_GASES
680     c 6/20/2005
681     if(KTREND.le.0)then
682     C assign background GHGs
683     PPMV58(2)=GHGBGR(1) ! CO2
684     PPMV58(6)=GHGBGR(2) ! N2O
685     PPMV58(7)=GHGBGR(3) ! CH4
686     PPMV58(8)=GHGBGR(4) ! F11
687     PPMV58(9)=GHGBGR(5) ! F12
688     endif
689     print *,'PPMV58 from SETGAS'
690     print *,PPMV58
691     NLP=NL+1 676.
692     NLMOD=NLP-LAYRAD 677.
693     PS0=PLB(1) 678.
694     PTOP=PLB(NLP-LAYRAD) 679.
695     C 680.
696     DO 100 L=1,NL 681.
697     DPL(L)=PLB(L)-PLB(L+1) 682.
698     100 PL(L)=(PLB(L)+PLB(L+1))*0.5 683.
699     NLNKTR=NL*NKTR 684.
700     C 685.
701     IF(LASTVC.GE.0) GO TO 107 686.
702     C 687.
703     DO 105 L=1,NL 688.
704     P=PLB(L) 689.
705     DO 101 N=2,8 690.
706     IF(P.GT.SPLB(N)) GO TO 102 691.
707     101 CONTINUE 691.5
708     N=9 692.
709     102 N=N-1 693.
710     IF(ABS(SDLB(N)).LT.1.E-04) GO TO 103 694.
711     H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 695.
712     GO TO 104 696.
713     C ALOG
714     103 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 697.
715     C ALOG
716     104 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 698.
717     TLB(L)=T 699.
718     105 HLB(L)=H 700.
719     ! print *,' After 105'
720     HLB(1)=1.E-10 701.
721     HLB(NL+1)=99.99 702.
722     TLB(NL+1)=STLB(8) 703.
723     DO 106 L=1,NL 704.
724     TLT(L)=TLB(L+1) 705.
725     106 TLM(L)=0.5*(TLB(L)+TLT(L)) 706.
726     TLB(NL+1)=TLT(NL) 707.
727     C 708.
728     107 NLAY=LASTVC/100000 709.
729     NATM=(LASTVC-NLAY*100000)/10000 710.
730     IF(NATM.GT.0) GO TO 112 711.
731     C 712.
732     C--------------------------------------------------------------------- 713.
733     C DEFINE GLOBAL MEAN GAS AMOUNTS FOR TRACEGAS & OVERLAP ABSORPTION 714.
734     C--------------------------------------------------------------------- 715.
735     C 716.
736     C ---------------------------- 717.
737     C GLOBAL MEAN H2O DISTRIBUTION 718.
738     C ---------------------------- 719.
739     RHP=0.77 720.
740     EST=10.0**(9.4051-2353.0/TLB(1)) 721.
741     FWB=0.662*RHP*EST/(PLB(1)-RHP*EST) 722.
742     DO 111 L=1,NL 723.
743     PLT=PLB(L+1) 724.
744     DP=PLB(L)-PLT 725.
745     RHP=0.77*(PLT/P0-0.02)/.98 726.
746     EST=10.0**(9.4051-2353.0/TLT(L)) 727.
747     FWT=0.662*RHP*EST/(PLT-RHP*EST) 728.
748     IF(FWT.GT.3.E-06) GO TO 110 729.
749     FWT=3.E-06 730.
750     RHP=FWT*PLT/(EST*(FWT+0.662)) 731.
751     110 ULGASL=0.5*(FWB+FWT)*DP*1270. 732.
752     C$110 ULGASL=0.5*(FWB+FWT)*DP*1268.75 733.
753     U0GAS(L,1)=ULGASL 734.
754     SHL(L)=ULGASL/(ULGASL+1268.75*DP) 735.
755     EQ=0.5*(PLB(L)+PLT)*SHL(L)/(0.662+0.378*SHL(L)) 736.
756     ES=10.**(9.4051-2353./TLM(L)) 737.
757     RHL(L)=EQ/ES 738.
758     111 FWB=FWT 739.
759     112 CONTINUE 740.
760     C ---------------------------- 741.
761     C GLOBAL MEAN O3 DISTRIBUTION 742.
762     C---------------- ---------------------------- 743.
763     ! print *,' Before SETO3D'
764     CALL SETO3D 744.
765     ! print *,' After SETO3D'
766     C---------------- 745.
767     JJLAT=JLAT 746.
768     C IF(JDAY.LT.1) KEEP SETATM O3 DISTRIBUTION 747.
769     C ------------------------------------------ 748.
770     IF(JDAY.LT.1) GO TO 125 749.
771     C---------------- 750.
772     ! print *,' Before O3DDAY'
773     CALL O3DDAY 751.
774     ! print *,' After O3DDAY'
775     C---------------- 752.
776     C 753.
777     DO 120 J=1,JMLAT 754.
778     RADLAT=PI*DLAT(J)/180. 755.
779     120 COSLAT(J)=0.5+0.5*SIN(RADLAT) 756.
780     C 757.
781     DO 121 N=1,NL 758.
782     121 UO3L(N)=0. 759.
783     DO 123 JLAT=1,JMLAT 760.
784     C---------------- 761.
785     ! print *,' Before O3DLAT'
786     CALL O3DLAT 762.
787     ! print *,' After O3DLAT'
788     C---------------- 763.
789     JB=JLAT+1 764.
790     JA=JLAT-1 765.
791     IF(JB.GT.JMLAT) JB=JMLAT 766.
792     IF(JA.LT.1 ) JA=1 767.
793     WTLAT=0.5*(COSLAT(JB)-COSLAT(JA)) 768.
794     DO 122 N=1,NL 769.
795     122 UO3L(N)=UO3L(N)+U0GAS(N,3)*WTLAT 770.
796     123 CONTINUE 771.
797     DO 124 N=1,NL 772.
798     124 U0GAS(N,3)=UO3L(N) 773.
799     125 JLAT=JJLAT 774.
800     ! print *,' After 774'
801     XXXX=SETAO3(OCM) 775.
802     ! print *,' After 775'
803     C 775.11
804     C SAVE GLOBAL MEAN P,T,O3 FOR UPDATING LAPGAS TAU TABLE IN SETLAP 775.12
805     C --------------------------------------------------------------- 775.13
806     C 775.14
807     DO 126 N=1,NL 775.15
808     PLB0(N)=PLB(N) 775.16
809     TLM0(N)=TLM(N) 775.17
810     126 U0GAS3(N)=U0GAS(N,3) 775.18
811     PLB0(NLP)=PLB(NLP) 775.19
812     C ---------------------------- 776.
813     C GLOBAL MEAN NO2 DISTRIBUTION 777.
814     C ---------------------------- 778.
815     ! print *,' After 778'
816     ACM=0.0 779.
817     HI=0.0 780.
818     FI=CMANO2(1) 781.
819     HL=HLB(2) 782.
820     L=1 783.
821     J=1 784.
822     130 J=J+1 785.
823     IF(J.GT.42) GO TO 133 786.
824     HJ=HI+2.0 787.
825     FJ=CMANO2(J) 788.
826     131 DH=HJ-HI 789.
827     IF(HJ.GT.HL) GO TO 132 790.
828     ACM=ACM+(FI+FJ)*DH*0.5 791.
829     HI=HJ 792.
830     FI=FJ 793.
831     GO TO 130 794.
832     132 FF=FI+(FJ-FI)*(HL-HI)/DH 795.
833     DH=HL-HI 796.
834     ACM=ACM+(FI+FJ)*DH*0.5 797.
835     U0GAS(L,5)=ACM 798.
836     ACM=0.0 799.
837     HI=HL 800.
838     FI=FF 801.
839     IF(L.EQ.NL) GO TO 133 802.
840     L=L+1 803.
841     HL=HLB(L+1) 804.
842     GO TO 131 805.
843     133 U0GAS(L,5)=ACM 806.
844     ACM=0.0 807.
845     L=L+1 808.
846     IF(L.LT.NLP) GO TO 133 809.
847     ! print *,' After 809'
848     C ----------------------------------------- 810.
849     C (CO2,O2) UNIFORMLY MIXED GAS DISTRIBUTION 811.
850     C ----------------------------------------- 812.
851     DO 141 K=2,4,2 813.
852     DO 140 N=1,NL 814.
853     140 U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 815.
854     141 CONTINUE 816.
855     C PRINT
856     print *,' CO2',PPMV58(2)
857     c print *,'NLMOD=',NLMOD
858     c print *,'PSIG'
859     c print *,(PSIG(L),L=1,NLMOD+1)
860     c print *,'PLB'
861     c print *,(PLB(L),L=1,NLMOD+1)
862     c print *,(U0GAS(n,2),n=1,nl)
863     C PRINT
864     C ----------------------------------------------------- 817.
865     C (N20,CH4,F11,F12) SPECIFIED VERTICAL GAS DISTRIBUTION 818.
866     C ----------------------------------------------------- 819.
867     DO 151 K=6,9 820.
868     DO 150 N=1,NL 821.
869     U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 822.
870     ZT=(HLB(N+1)-Z0(K))/ZH(K) 823.
871     IF(ZT.LE.0.) GO TO 150 824.
872     ZB=(HLB(N)-Z0(K))/ZH(K) 825.
873     EXPZT=EXP(-ZT) 826.
874     EXPZB=EXP(-ZB) 827.
875     IF(ZB.LT.0.) EXPZB=1.-ZB 828.
876     U0GAS(N,K)=U0GAS(N,K)*(EXPZB-EXPZT)/(ZT-ZB) 829.
877     150 CONTINUE 830.
878     151 CONTINUE 831.
879     C ------------------------------------------------ 832.
880     C SPECIFIED GAS AMOUNTS (INCLUDING SCALING FACTOR) 833.
881     C ------------------------------------------------ 834.
882     C 835.
883     DO 161 K=1,9 836.
884     DO 160 N=1,NL 837.
885     160 ULGAS(N,K)=U0GAS(N,K)*FULGAS(K) 838.
886     161 CONTINUE 839.
887     C PRINT
888     ! print *,' after 161'
889     ! print *,(ULGAS(n,2),n=1,nl)
890     C PRINT
891     C 840.
892     C------------------------------- 841.
893     CALL SETAO2(ULGAS(1,4),NL) 842.
894     C------------------------------- 843.
895     C 844.
896     C -------------------------------------------------------------- 845.
897     C OVERLAP ABSORPTION (ILGAS1,ILGAS2) FOR GLOBAL MEAN GAS AMOUNTS 846.
898     C -------------------------------------------------------------- 847.
899     DO 170 K=1,30 848.
900     170 MLGAS(K)=0 849.
901     IF(LAPGAS.LT.1) GO TO 174 850.
902     DO 172 L=1,3 851.
903     DO 171 K=ILGAS1,ILGAS2 852.
904     M=KGAS(K,L) 853.
905     IF(M.GT.3) MLGAS(M)=1 854.
906     171 CONTINUE 855.
907     172 CONTINUE 856.
908     DO 173 K=1,15 857.
909     173 MLGAS(15+K)=MLGAS(K) 858.
910     174 CONTINUE 859.
911     C 860.
912     C ---------------------------------------------------------------- 861.
913     C TAULAP=OVERLAP ABSORPTION KEPT AS INITIALIZED (NO CHANGES LATER) 862.
914     C ---------------------------------------------------------------- 863.
915     C 864.
916     DO 180 I=1,1000 865.
917     TAULAP(I)=0. 866.
918     180 TAUN(I)=0. 867.
919     C 868.
920     C-------------------------------- 869.
921     IF(LAPGAS.GT.0) CALL TAUGAS 870.
922     C-------------------------------- 871.
923     C 872.
924     DO 181 I=1,NLNKTR 873.
925     181 TAULAP(I)=TAUN(I) 874.
926     C 875.
927     C ---------------------------------------------------------- 876.
928     C MAIN GAS (IMGAS1,IMGAS2) ABSORPTION INTERPOLATED AS NEEDED 877.
929     C ---------------------------------------------------------- 878.
930     C 879.
931     DO 191 L=1,3 880.
932     DO 190 K=IMGAS1,IMGAS2 881.
933     M=KGAS(K,L) 882.
934     IF(M.GT.0) MLGAS(M)=1 883.
935     190 CONTINUE 884.
936     191 CONTINUE 885.
937     DO 192 K=1,13 886.
938     192 MLGAS(K)=MLGAS(K)*(MLGAS(K)-MLGAS(K+15)) 887.
939     IF(IMGAS1.EQ.1) MLGAS(14)=1 888.
940     IF(KWVCON.EQ.1) MLGAS(15)=1 889.
941     DO 193 K=1,30 890.
942     193 MLLAP(K)=MLGAS(K) 891.
943     C 892.
944     RETURN 893.
945     C 894.
946     C----------------------------------------------------------------------- 895.
947     C REDEFINE TAULAP TABLE: GET ABSORPTION FROM TAUGAS TABLE 896.
948     ENTRY SETLAP 897.
949     C----------------------------------------------------------------------- 898.
950     C 899.
951     IF(LAPGAS.EQ.1) RETURN 900.
952     C 901.
953     DO 200 I=1,1000 902.
954     200 TAULAP(I)=0. 903.
955     IF(LAPGAS.EQ.0) RETURN 904.
956     C 905.
957     DO 210 K=1,15 906.
958     210 MLGAS(K)=MLLAP(K+15) 907.
959     C 908.
960     DO 220 I=1,NLNKTR 909.
961     220 TAUN(I)=TAULAP(I) 910.
962     C 911.
963     DO 230 L=1,NL 912.
964     DPL(L)=PLB0(L)-PLB0(L+1) 912.11
965     PL(L)=(PLB0(L)+PLB0(L+1))*0.5 912.12
966     TLM(L)=TLM0(L) 912.13
967     U0GAS(L,3)=U0GAS3(L) 912.14
968     C 912.15
969     ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 913.
970     ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 914.
971     230 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 915.
972     C 916.
973     c
974     tropmass = 28.97296245*1.e-3*0.8/P0
975     trpm=tropmass*1.e3
976     DO 240 L=1,nlev
977     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
978    
979     #ifdef PREDICTED_GASES
980     pxxx = dpl(l)
981    
982     ULGAS(L,2)=glbgas(l,1)*tropmass/44.0098
983     & *pxxx
984     ULGAS(L,6)=glbgas(l,2)*tropmass/44.0000
985     & *pxxx
986     ULGAS(L,7)=glbgas(l,3)*tropmass/16.0426
987     & *pxxx
988     ULGAS(L,8)=glbgas(l,4)*tropmass/137.3675
989     & *pxxx
990     ULGAS(L,9)=glbgas(l,5)*tropmass/120.9054
991     & *pxxx
992     #else
993     !
994     !prescribed greenhouse
995     ! gas profiles
996     !
997     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2) 918.
998     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6) 920.
999     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7) 921.
1000     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8) 922.
1001     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1002     #endif
1003     240 continue
1004     ll=nlev
1005     do 2240 l=nlev+1,NL
1006     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
1007     #ifdef PREDICTED_GASES
1008     pxxx = dpl(l)
1009    
1010     ULGAS(L,2)=glbgas(ll,1)*tropmass/44.0098
1011     & *pxxx
1012     ULGAS(L,6)=glbgas(ll,2)*tropmass/44.0000
1013     & *pxxx
1014     ULGAS(L,7)=glbgas(ll,3)*tropmass/16.0426
1015     & *pxxx
1016     ULGAS(L,8)=glbgas(ll,4)*tropmass/137.3675
1017     & *pxxx
1018     ULGAS(L,9)=glbgas(ll,5)*tropmass/120.9054
1019     & *pxxx
1020     #else
1021     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)
1022     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)
1023     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)
1024     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)
1025     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1026     #endif
1027     2240 continue
1028     C PRINT
1029     c print *,' after 240'
1030     c print *,(ULGAS(n,2),n=1,nl)
1031     C PRINT
1032     C 924.
1033     C----------------- 925.
1034     CALL TAUGAS 926.
1035     C----------------- 927.
1036     C 928.
1037     DO 250 I=1,NLNKTR 929.
1038     250 TAULAP(I)=TAUN(I) 930.
1039     C 931.
1040     DO 260 K=1,15 932.
1041     260 MLGAS(K)=MLLAP(K) 933.
1042     C 934.
1043     RETURN 935.
1044     C 936.
1045     C----------------------------------------------------------------------- 937.
1046     C SPECIFY ULGAS: GET MAINGAS ABSORPTION FROM TAUGAS TABLE 938.
1047     ENTRY GETGAS 939.
1048     C----------------------------------------------------------------------- 940.
1049     C 941.
1050     C----------------- 942.
1051     CALL O3DLON 943.
1052     C----------------- 944.
1053     C 945.
1054     DO 300 L=1,NL 946.
1055     DPL(L)=PLB(L)-PLB(L+1) 947.
1056     300 PL(L)=(PLB(L)+PLB(L+1))*0.5 948.
1057     C 949.
1058     IF(KEEPRH.EQ.1) GO TO 311 950.
1059     DO 310 L=1,NL 951.
1060     310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 952.
1061     C$310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 953.
1062     GO TO 313 954.
1063     311 CONTINUE 955.
1064     DO 312 L=1,NL 956.
1065     ES=10.0**(9.4051-2353.0/TLM(L)) 957.
1066     SHL(L)=0.622*(RHL(L)*ES)/(PL(L)-0.378*(RHL(L)*ES)) 958.
1067     312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 959.
1068     C$312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 960.
1069     313 CONTINUE 961.
1070     C 962.
1071     DO 320 I=1,NLNKTR 963.
1072     320 TAUN(I)=TAULAP(I) 964.
1073     C 965.
1074     DO 330 L=1,NL 966.
1075     ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 967.
1076     ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 968.
1077     330 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 969.
1078     C 970.
1079     PART=(PLB(1)-PTOP)/(PS0-PTOP) 971.
1080    
1081     !
1082     ! --- Chemistry model patch 080895
1083     !
1084     ! --- Note: most of the modifications in following
1085     ! sections were made originally as a part of chemistry
1086     ! module ( PREDICTED_GASES == CPL_CHEM ). However,
1087     ! they can be used by non-interactive
1088     ! chemistry-climate runs now, as far as the prescribed
1089     ! profiles of chemical species and aerosols are
1090     ! available.
1091     !
1092     ! Chien Wang
1093     ! 080100
1094     !
1095    
1096     c ===
1097     c Prescribed gaseous profiles:
1098     c
1099     c DO 340 L=1,NL 972.
1100     c IF(L.EQ.NLMOD) PART=1. 973.
1101     c ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART 974.
1102     c ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART 975.
1103     c ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART 976.
1104     c ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART 977.
1105     c ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART 978.
1106     c ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART 979.
1107     c340 continue
1108     c goto 9341
1109     c
1110     c ===
1111    
1112     !
1113     ! --- Use predicted gaseous profiles:
1114     !
1115     tropmass = 28.97296245*1.e-3*0.8/P0
1116     trpm=tropmass*1.e3
1117    
1118     !
1119     ! --- Use internal point to avoid possible unstable
1120     ! --- problem related to LBC:
1121     !
1122     jyyy = max(3, min(nlat2,JLAT))
1123     !
1124    
1125     do 2340 l=1,nlev
1126     IF(L.EQ.NLMOD) PART=1.
1127    
1128     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1129    
1130     #ifdef PREDICTED_GASES
1131     !
1132     ! --- predicted greenhouse gas profiles
1133     !
1134     pxxx = dpl(l)*part
1135    
1136     c if (JLAT.eq.12) then
1137     c print *,'zco2=',zco2(1,jlat,l)
1138     c endif
1139     ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,l))/44.0098
1140     & *pxxx*tropmass
1141     c if (JLAT.eq.12) then
1142     c print *,'l=',L,' ULGAS(L,2)=',ULGAS(L,2)
1143     c endif
1144    
1145     #ifdef O3_RAD
1146     !
1147     ! === Chien Wang 121797 then 062498 ===
1148     ! === add to use predicted ozone ===
1149     ! === in troposphere only ===
1150     if(l.le.n_tropopause)
1151     & ULGAS(L,3)=dmax1(0.0,o3(ILON,jyyy,l))/48.0
1152     & *pxxx*tropmass
1153     #endif
1154    
1155     !
1156     ! --- Chem adjustmen of N2O and CH4 concentrations
1157     !
1158     xxxo=dmax1(0.0,xn2o(ILON,jyyy,l))
1159     & *tropmass/44.0000*1.25*P0
1160     yyyo=dmax1(0.0,ch4(ILON,jyyy,l))
1161     & *tropmass/16.0426*1.25*P0
1162     call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1163    
1164     ULGAS(L,6)=xxxn*0.8*pxxx/P0
1165     ULGAS(L,7)=yyyn*0.8*pxxx/P0
1166    
1167     #ifdef INC_3GASES
1168     !
1169     ! === if hfc, pfc, and sf6 are included:
1170     !
1171     ! === 032698
1172     ! === add hfc134a, pfc and sf6 to equivilent f11:
1173     ! ===
1174     equi_cfc11 = cfc11(ILON,jyyy,l)
1175     & + hfc134a(ilon,jyyy,l)*dhfc134a_df11
1176     & + pfc (ilon,jyyy,l)*dpfmethane_df11
1177     & + sf6 (ilon,jyyy,l)*dsf6_df11
1178     #else
1179     equi_cfc11 = cfc11(ILON,jyyy,l)
1180     #endif
1181     ! ===
1182     ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1183     & *tropmass/137.3675
1184     & *pxxx
1185     ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,l))
1186     & *tropmass/120.9054
1187     & *pxxx
1188    
1189     #else
1190     !
1191     ! --- prescribed greenhouse gas profiles
1192     !
1193     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1194     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1195     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1196     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1197     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1198     #endif
1199    
1200     #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1201     C-- Added ozone forcing from external source.
1202     C-- changed 18Mar98 CEForest
1203     C NB. ozone is updated daily
1204     C o3 = ppb(m)
1205     C 48 = mol weight of o3
1206     C ULGAS = cm^3 (STP)/cm^2
1207     C
1208     C 15JAN03 CEForest
1209     C changed to use total ozone, rather than anomalies, from GISS data
1210     C
1211     pxxx = dpl(l)*part
1212     ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1213     & *pxxx*tropmass
1214     C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1215     C-- end of change 18Mar98
1216     #endif
1217    
1218     2340 continue
1219    
1220     ll=nlev
1221     do 2342 l=nlev+1,NL
1222     IF(L.EQ.NLMOD) PART=1.
1223    
1224     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1225    
1226     #ifdef PREDICTED_GASES
1227     !
1228     ! --- predicted greenhouse gas profiles
1229     !
1230     pxxx = dpl(l)*part
1231    
1232     ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,ll))
1233     & *tropmass/44.0098
1234     & *pxxx
1235     !
1236     ! --- Chem adjustmen of N2O and CH4 concentrations
1237     !
1238     xxxo=dmax1(0.0,xn2o(ILON,jyyy,ll))
1239     & *tropmass/44.0000*1.25*P0
1240     yyyo=dmax1(0.0,ch4(ILON,jyyy,ll))
1241     & *tropmass/16.0426*1.25*P0
1242     call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1243    
1244     ULGAS(L,6)=xxxn*0.8*pxxx/P0
1245     ULGAS(L,7)=yyyn*0.8*pxxx/P0
1246    
1247     #ifdef INC_3GASES
1248     !
1249     ! === if hfc, pfc, and sf6 are included:
1250     !
1251     ! === 032698
1252     ! === add hfc134a, pfc and sf6 to equivilent f11:
1253     ! ===
1254     equi_cfc11 = cfc11(ILON,jyyy,ll)
1255     & + hfc134a(ilon,jyyy,ll)*dhfc134a_df11
1256     & + pfc (ilon,jyyy,ll)*dpfmethane_df11
1257     & + sf6 (ilon,jyyy,ll)*dsf6_df11
1258     #else
1259     equi_cfc11 = cfc11(ILON,jyyy,ll)
1260     #endif
1261     ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1262     & *tropmass/137.3675
1263     & *pxxx
1264     ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,ll))
1265     & *tropmass/120.9054
1266     & *pxxx
1267     #else
1268     !
1269     ! --- prescribed greenhouse gas profiles
1270     !
1271     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1272     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1273     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1274     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1275     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1276     #endif
1277    
1278     #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1279     C-- Added ozone forcing from external source.
1280     C-- changed 18Mar98 CEForest
1281     C NB. ozone is updated daily
1282     C o3 = ppb(m)
1283     C 48 = mol weight of o3
1284     C ULGAS = cm^3 (STP)/cm^2
1285     C
1286     C 15JAN03 CEForest
1287     C changed to use total ozone, rather than anomalies, from GISS data
1288     C
1289     C added adjustment to layers (nlev+1:nlev+3) above dynamics layers
1290     pxxx = dpl(l)*part
1291     ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1292     & *pxxx*tropmass
1293     C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1294     C-- end of change 18Mar98
1295     #endif
1296    
1297    
1298     2342 continue
1299    
1300     c
1301     c-------------------------------------------------------
1302    
1303     C----------------- 981.
1304     CALL TAUGAS 982.
1305     C----------------- 983.
1306     C 984.
1307     RETURN 985.
1308     C 986.
1309     C----------------------------------------------------------------------- 987.
1310     C IF(KGASSR.GT.0) REDEFINE ULGAS FOR SOLAR FULGAS VALUES 988.
1311     ENTRY SOLGAS 989.
1312     C----------------------------------------------------------------------- 990.
1313     C 991.
1314     C 992.
1315     DO 400 L=1,NL 993.
1316     ULGAS(L,1)=U0GAS(L,1)*FULGAS(1+9) 994.
1317     ULGAS(L,3)=U0GAS(L,3)*FULGAS(3+9) 995.
1318     400 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5+9) 996.
1319     C 997.
1320     PART=(PLB(1)-PTOP)/(PS0-PTOP) 998.
1321     DO 410 L=1,NL 999.
1322     IF(L.EQ.NLMOD) PART=1. 1000.
1323     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2+9)*PART 1001.
1324     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4+9)*PART 1002.
1325     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6+9)*PART 1003.
1326     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7+9)*PART 1004.
1327     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8+9)*PART 1005.
1328     410 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9+9)*PART 1006.
1329     C 1007.
1330     C 1008.
1331     RETURN 1009.
1332     END 1010.
1333     SUBROUTINE SETAER 1011.
1334    
1335     #include "chem_para"
1336     #include "chem_com"
1337     #include "B83XX.COM" 1012.
1338    
1339     C 1073.
1340     EQUIVALENCE (FEMTRA(1),ECLTRA) 1074.
1341     EQUIVALENCE (ISPARE(2),NEWAQA) 1074.1
1342     EQUIVALENCE (ISPARE(3),NEWCQA) 1074.2
1343     C 1075.
1344     DIMENSION SRAX(40,6,5),SRAS(40,6,5),SRAC(40,6,5) 1076.
1345     C 1077.
1346     C-----------------------------------------------------------------------1078.
1347     C THERMAL: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1079.
1348     C-----------------------------------------------------------------------1080.
1349     C 1081.
1350     DO 100 J=1,NGOLDH 1082.
1351     DO 100 K=1,NKTR 1083.
1352     DO 100 L=1,NL 1084.
1353     100 TRAX(L,K,J)=0. 1085.
1354     C 1086.
1355     DO 103 I=1,NAERO 1087.
1356     DO 103 J=1,NGOLDH 1088.
1357     IF(AGOLDH(I,J).LT.1.E-06) GO TO 103 1089.
1358     C=CGOLDH(I,J) 1090.
1359     BC=EXP(-BGOLDH(I,J)/C) 1091.
1360     ABC=AGOLDH(I,J)*(1.0+BC) 1092.
1361     C 1093.
1362     DO 102 L=1,NL 1094.
1363     C AMIN
1364     ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1365     + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1366     C AMIN
1367     DO 101 K=1,NKTR 1097.
1368     TRANEW=TRACOS(K,I) 1097.5
1369     IF(NEWAQA.GT.0) TRANEW=1.0 1097.6
1370     101 TRAX(L,K,J)=TRAX(L,K,J)+ABCD*(TRAQEX(K,I)-TRANEW*TRAQSC(K,I)) 1098.
1371     102 CONTINUE 1099.
1372     103 CONTINUE 1100.
1373     C 1101.
1374     DO 104 J=1,2 1102.
1375     DO 104 K=1,NKTR 1103.
1376     TRCNEW=TRCCOS(K,J) 1103.5
1377     IF(NEWCQA.GT.0) TRCNEW=1.0 1103.6
1378     104 TRCX(K,J)=TRCQEX(K,J)-TRCNEW*TRCQSC(K,J) 1104.
1379     C 1105.
1380     C-----------------------------------------------------------------------1106.
1381     C SOLAR: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1107.
1382     C-----------------------------------------------------------------------1108.
1383     C 1109.
1384     DO 110 J=1,NGOLDH 1110.
1385     DO 110 K=1,NKSR 1111.
1386     DO 110 L=1,NL 1112.
1387     SRAX(L,K,J)=1.E-30 1113.
1388     SRAS(L,K,J)=1.E-31 1114.
1389     110 SRAC(L,K,J)=0. 1115.
1390     C 1116.
1391     DO 113 I=1,NAERO 1117.
1392     DO 113 J=1,NGOLDH 1118.
1393     IF(AGOLDH(I,J).LT.1.E-06) GO TO 113 1119.
1394     C=CGOLDH(I,J) 1120.
1395     BC=EXP(-BGOLDH(I,J)/C) 1121.
1396     ABC=AGOLDH(I,J)*(1.0+BC) 1122.
1397     C 1123.
1398     DO 112 L=1,NL 1124.
1399     C AMIN
1400     ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1401     + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1402     C AMIN
1403     DO 111 K=1,NKSR 1127.
1404     SRAX(L,K,J)=SRAX(L,K,J)+ABCD*SRAQEX(K,I) 1128.
1405     SRAS(L,K,J)=SRAS(L,K,J)+ABCD*SRAQSC(K,I) 1129.
1406     111 SRAC(L,K,J)=SRAC(L,K,J)+ABCD*SRACOS(K,I)*SRAQSC(K,I) 1130.
1407     112 CONTINUE 1131.
1408     113 CONTINUE 1132.
1409     C 1133.
1410     DO 114 J=1,NGOLDH 1134.
1411     DO 114 K=1,NKSR 1135.
1412     DO 114 L=1,NL 1136.
1413     114 SRAC(L,K,J)=SRAC(L,K,J)/SRAS(L,K,J) 1137.
1414     C 1138.
1415     C----------------- 1139.
1416     ENTRY GETAER 1140.
1417     C----------------- 1141.
1418     C 1142.
1419     C-----------------------------------------------------------------------1143.
1420     C GET CLOUD & AEROSOL AMOUNTS & DISTRIBUTIONS1144.
1421     C-----------------------------------------------------------------------1145.
1422     LBOTCL=0 1146.
1423     LTOPCL=0 1147.
1424     DO 203 L=1,NL 1148.
1425     KCLD=1 1149.
1426     IF(TLM(L).LT.TKCICE) KCLD=2 1150.
1427     IF(CLDTAU(NLP-L).GT.0.1) LTOPCL=NLP-L 1151.
1428     C$ IF(CLDTAU(NLP-L).GT.0.1) LBOTCL=NLP-L *******************CORRECT1152.
1429     IF(CLDTAU( L).GT.0.1) LBOTCL=L 1153.
1430     C$ IF(CLDTAU( L).GT.0.1) LTOPCL=L ***********************CORRECT1154.
1431     C (THERMAL) 1155.
1432     C --------- 1156.
1433     DO 202 K=1,NKTR 1157.
1434     SUMEXT=1.E-30 1158.
1435     DO 201 J=1,NGOLDH 1159.
1436     201 SUMEXT=SUMEXT+FGOLDH(J)*TRAX(L,K,J) 1160.
1437     TRAEXT(L,K)=SUMEXT+CLDTAU(L)*TRCX(K,KCLD)*FCLDTR 1161.
1438     202 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+TRAEXT(L,K) 1162.
1439     203 CONTINUE 1163.
1440     C 1164.
1441     C-----------------------------------------------------------------------1165.
1442     C CLOUD ALBEDO & SURFACE LAYER FOG SPECIFICATION1166.
1443     C-----------------------------------------------------------------------1167.
1444     C 1168.
1445     DO 204 K=1,NKTR 1169.
1446     204 FTAUSL(K)=FOGTSL*TRCX(K,1)*FCLDTR 1170.
1447     IF(LTOPCL.GT.0) GO TO 206 1171.
1448     DO 205 K=1,NKTR 1172.
1449     205 TRCALB(K)=0. 1173.
1450     GO TO 210 1174.
1451     206 KCLD=1 1175.
1452     IF(TLM(LTOPCL).LT.TKCICE) KCLD=2 1176.
1453     DO 207 K=1,NKTR 1177.
1454     207 TRCALB(K)=(1.0-EXP(-CLDTAU(LTOPCL)*TRCX(K,KCLD)))*CLDALB(K,KCLD) 1178.
1455     + *ECLTRA*FCLDTR 1179.
1456     210 CONTINUE 1180.
1457     C (SOLAR) 1181.
1458     C ------- 1182.
1459     KSR=9*KAERSR 1183.
1460     DO 9212 K=1,NKSR 1184.
1461     DO 212 L=1,NL 1185.
1462     EXTSUM=1.E-30 1186.
1463     SCTSUM=1.E-31 1187.
1464     COSSUM=0. 1188.
1465     DO 211 J=1,NGOLDH 1189.
1466     EXTSUM=EXTSUM+FGOLDH(J+KSR)*SRAX(L,K,J) 1190.
1467     SCTSUM=SCTSUM+FGOLDH(J+KSR)*SRAS(L,K,J) 1191.
1468     211 COSSUM=COSSUM+FGOLDH(J+KSR)*SRAS(L,K,J)*SRAC(L,K,J) 1192.
1469    
1470     #if ( defined PREDICTED_BC || defined PREDICTED_AEROSOL)
1471     !
1472     ! --- Chemistry model patch, 092901
1473     !
1474     ! === Chien Wang
1475     ! === (1) add to type 3 aerosol with
1476     ! === chemistry model predicted S(VI);
1477     ! === (2) add type 11 aerosol with
1478     ! === chemistry model predicted bcarbon
1479     ! ===
1480     if ( L .le. nlev1 ) then
1481     !
1482     ! === add as global aerosol
1483     ! Note: if needed the AGOLDH for prescribed
1484     ! tropospheric S(VI), SLFT1 & SLFT2, can be
1485     ! set to zero in later part of the code
1486     !
1487     ! FAERSOL/svi_intensity is added for using
1488     ! FAERSOL to switch between diagnostic/prognostic loops
1489     ! while normalize it to 1 in prognostic loop
1490     ! FBC added for black carbon 7/22/04
1491     !
1492     dsviod = 0.0
1493     dbcod = 0.0
1494    
1495     #if ( defined PREDICTED_AEROSOL )
1496     dsviod = max(0.0,
1497     & (sviod(1,jlat,L) - sviod(1,jlat,L+1))
1498     & *FAERSOL )
1499     #endif
1500    
1501     #if ( defined PREDICTED_BC)
1502     dbcod = max(0.0,
1503     & (bcod(1,jlat,L) - bcod(1,jlat,L+1))
1504     & *FBC )
1505     #endif
1506    
1507     EXTSUM = EXTSUM
1508     & + dsviod*SRAQEX(K,3)
1509     & + dbcod*SRAQEX(K,11)
1510     SCTSUM = SCTSUM
1511     & + dsviod*SRAQSC(K,3)
1512     & + dbcod*SRAQSC(K,11)
1513     COSSUM = COSSUM
1514     & + dsviod*SRAQSC(K,3)*SRACOS(K,3)
1515     & + dbcod*SRAQSC(K,11)*SRACOS(K,11)
1516    
1517     if(jlat.eq.-22.or.jlat.eq.-33)then
1518     if(L.eq.1.and.k.eq.1)then
1519     print *,'From r95 jlat=',jlat,' L=',L
1520     c print *,' LATHEM=',LATHEM, ' JNORTH=',JNORTH
1521     c print *,'FAERSOL=',FAERSOL,' FBC=',FBC
1522     print *,sviod(1,jlat,L),sviod(1,jlat,L+1)
1523     c print *,dsviod,SRAQEX(K,3)
1524     print *,bcod(1,jlat,L),bcod(1,jlat,L+1)
1525     c print *,dbcod,SRAQEX(K,11)
1526     c print *,SRAQSC(K,11),SRACOS(K,11)
1527     endif
1528     endif
1529     end if
1530     #endif
1531    
1532     EXTAER(L,K)=EXTSUM 1193.
1533     SCTAER(L,K)=SCTSUM 1194.
1534     COSAER(L,K)=COSSUM/SCTSUM 1195.
1535    
1536     212 continue
1537     9212 continue
1538     c
1539     c ======================================================
1540    
1541     IF(NTRACE.GT.0) GO TO 300 1196.
1542     C 1197.
1543     C----------- 1198.
1544     RETURN 1199.
1545     C----------- 1200.
1546     C 1201.
1547     300 CONTINUE 1202.
1548     C-----------------------------------------------------------------------1203.
1549     C ADD TRACER AEROSOL THERMAL & SOLAR CONTRIBUTIONS 1204.
1550     C-----------------------------------------------------------------------1205.
1551     DO 303 JJ=1,NTRACE 1206.
1552     J=NGOLDH+JJ 1207.
1553     I=ITR(JJ) 1208.
1554     C (THERMAL) 1209.
1555     C --------- 1210.
1556     DO 302 K=1,NKTR 1211.
1557     C$ SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRACOS(K,I)*TRAQSC(K,I)) 1212.
1558     SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRAQSC(K,I)) 1212.11
1559     DO 301 L=1,NL 1213.
1560     301 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+SUMEXT*TRACER(L,JJ) 1214.
1561     302 CONTINUE 1215.
1562     303 CONTINUE 1216.
1563     C 1217.
1564     C (SOLAR) 1218.
1565     C ------- 1219.
1566     DO 305 K=1,NKSR 1220.
1567     DO 305 L=1,NL 1221.
1568     EXTSUM=EXTAER(L,K) 1222.
1569     SCTSUM=SCTAER(L,K) 1223.
1570     COSSUM=COSAER(L,K)*SCTAER(L,K) 1224.
1571     DO 304 JJ=1,NTRACE 1225.
1572     J=NGOLDH+JJ 1226.
1573     I=ITR(JJ) 1227.
1574     EXTSUM=EXTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQEX(K,I) 1228.
1575     SCTSUM=SCTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I) 1229.
1576     304 COSSUM=COSSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I)*SRACOS(K,I) 1230.
1577     EXTAER(L,K)=EXTSUM 1231.
1578     SCTAER(L,K)=SCTSUM 1232.
1579     305 COSAER(L,K)=COSSUM/SCTSUM 1233.
1580     RETURN 1234.
1581     END 1235.
1582     SUBROUTINE TAUGAS 1236.
1583    
1584     #include "B83XX.COM"
1585    
1586     C TAUGAS INPUT REQUIRES: NL,TLM,ULGAS,TRACEG,PL,DPL,TAUTBL,MLGAS 1295.11
1587     C TAUGAS OUTPUT DATA IS: TAUN 1295.12
1588     C 1296.
1589     DIMENSION IGASX(11),KGX(11),NUX(11),IGUX(11),NGX(3),IG1X(3) 1297.
1590     DIMENSION ULOX(165),DUX(165),PX(15),H2OCON(25) 1298.
1591     C 1299.
1592     DATA NTX/8/, TLOX/181./,DTX/23./ 1300.
1593     DATA NPX/15/, PX/1000., 975., 910., 800., 645., 1301.
1594     * 480., 330., 205., 110., 40., 1302.
1595     * 7.5, 3.5, 1.0, 0.1, .001/ 1303.
1596     C 1304.
1597     DATA NGUX/652/, NPUX/15/ 1305.
1598     DATA NGX/10,10,04/, IG1X/2,12,22/ 1306.
1599     DATA 1307.
1600     * IGASX/ 1, 2, 3, 1, 1, 2, 2, 3, 6, 6, 7/, 1308.
1601     * KGX/ 1, 2, 3, 2, 3, 1, 3, 2, 1, 2, 1/, 1309.
1602     * NUX/ 25, 9, 9, 9, 9, 5, 5, 5, 1, 1, 1/, 1310.
1603     * IGUX/ 0,250,340,376,466,502,552,572,622,632,642/ 1311.
1604     C 1312.
1605     C 1313.
1606     DATA ULOX/ .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1,.10E+1, 1314.
1607     *.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1315.
1608     *.50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+1,.10E+2,.80E+1, 1316.
1609     *.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3, 1317.
1610     *.40E-3,.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2, 1318.
1611     *.40E-2,.10E-4,.80E-7,.40E-7, .25E+2,.25E+2,.50E+2,.50E+2, 1319.
1612     *.25E+2,.50E+1,.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3, 1320.
1613     *.10E-5,.10E-5, .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1, 1321.
1614     *.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1322.
1615     * .50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2, 1323.
1616     *.80E+1,.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .50E+1, 1324.
1617     *.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2,.80E+1,.10E+1, 1325.
1618     *.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3,.40E-3, 1326.
1619     *.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2,.40E-2, 1327.
1620     *.10E-4,.80E-7,.40E-7, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1, 1328.
1621     *.35E-1,.31E-1,.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4, 1329.
1622     *.44E-6, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1,.35E-1,.31E-1, 1330.
1623     *.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4,.44E-6, 1331.
1624     *.64E-1,.64E-1,.10E+0,.18E+0,.22E+0,.20E+0,.18E+0,.14E+0,.10E+0, 1332.
1625     *.77E-1,.64E-2,.38E-2,.26E-2,.26E-3,.26E-5/ 1333.
1626     C 1334.
1627     DATA DUX/ .75E+2,.75E+2,.10E+3,.10E+3,.75E+2,.50E+2,.10E+2, 1335.
1628     *.20E+1,.20E+0,.10E+0,.50E-1,.10E-1,.40E-2,.40E-3,.40E-4, 1336.
1629     *.50E+1,.50E+1,.80E+1,.10E+2,.10E+2,.10E+2,.10E+2,.10E+2,.80E+1, 1337.
1630     *.50E+1,.35E+1,.25E+0,.25E+0,.10E+0,.10E-1, .30E-3,.30E-3, 1338.
1631     *.50E-3,.80E-3,.10E-2,.16E-2,.64E-2,.16E-2,.25E-1,.25E-1,.25E-1, 1339.
1632     *.45E-2,.25E-2,.10E-2,.25E-4, .24E+3,.24E+3,.30E+3,.30E+3, 1340.
1633     *.24E+3,.15E+3,.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1, 1341.
1634     *.12E-2,.12E-3, .24E+3,.24E+3,.30E+3,.30E+3,.24E+3,.15E+3, 1342.
1635     *.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1,.12E-2,.12E-3, 1343.
1636     * .10E+2,.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2, 1344.
1637     *.16E+2,.10E+2,.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .10E+2, 1345.
1638     *.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2,.16E+2,.10E+2, 1346.
1639     *.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .60E-3,.60E-3,.10E-2, 1347.
1640     *.16E-2,.20E-2,.32E-2,.13E-1,.32E-1,.50E-1,.50E-1,.50E-1,.90E-2, 1348.
1641     *.50E-2,.20E-2,.50E-4, 45*0./ 1349.
1642     C 1350.
1643     DATA H2OCON/ .767116, .322401, .572299,.58537, .48869, 1351.
1644     * .43539, .44322, .64072, .89293, 1.12733,1.65550, .865210, 1352.
1645     * 1.38403,1.80159,1.99196, 2.03403, 2.20561,2.42859,2.56883, 1353.
1646     * 2.67157,2.71888, .45534, .44735, .44534, .44365/ 1354.
1647     C 1355.
1648     C-------------------------------------------------------------------- 1356.
1649     C ABSORPTION (TAU) INTERPOLATION FOR GAS AMOUNTS IN ULGAS(N,K) 1357.
1650     C-------------------------------------------------------------------- 1358.
1651     C 1359.
1652     IPX=2 1360.
1653     DO 100 IP=1,NL 1361.
1654     C 1362.
1655     20 WPB = (PL(IP)-PX(IPX))/(PX(IPX-1)-PX(IPX)) 1363.
1656     IF(WPB.GE.0. .OR. IPX.GE.NPX) GO TO 30 1364.
1657     IPX = IPX+1 1365.
1658     GO TO 20 1366.
1659     C 1367.
1660     30 WTB = (TLM(IP)-TLOX)/DTX 1368.
1661     ITX = MIN0(MAX0(INT(WTB),0),NTX-2) 1369.
1662     WTB = WTB-FLOAT(ITX) 1370.
1663     C 1371.
1664     WBB = WPB*WTB 1372.
1665     WBA = WPB-WBB 1373.
1666     WAB = WTB-WBB 1374.
1667     WAA = 1.-(WBB+WBA+WAB) 1375.
1668     C 1376.
1669     IAA = NGUX*(ITX+NTX*(IPX-1)) 1377.
1670     IBA = IAA-NGUX*NTX 1378.
1671     C 1379.
1672     DO 90 IGAS=1,11 1380.
1673     IF(MLGAS(IGAS).LT.1) GO TO 90 1381.
1674     C 1382.
1675     UGAS = ULGAS(IP,IGASX(IGAS)) 1383.
1676     IF(UGAS.LT.1.E-10) GO TO 90 1384.
1677     C 1385.
1678     IU = IPX + NPUX*(IGAS-1) 1386.
1679     NU = NUX(IGAS) 1387.
1680     IF(NU.GT.1) GO TO 40 1388.
1681     XUA = 0. 1389.
1682     XUB = 0. 1390.
1683     GO TO 50 1391.
1684     40 XUA = (UGAS-ULOX(IU))/DUX(IU) 1392.
1685     XUB = (UGAS-ULOX(IU-1))/DUX(IU-1) 1393.
1686     50 IUA = INT(XUA) 1394.
1687     IUB = INT(XUB) 1395.
1688     C 1396.
1689     QAA = 1. 1397.
1690     QAB = 1. 1398.
1691     IF(XUA.GT.0. .AND. IUA.LT.NU-1) GO TO 60 1399.
1692     c XUA = DMIN1(DMAX1(XUA,0.),FLOAT(NU-1)) 1400.
1693     XUA = DMIN1(DMAX1(XUA,0.),dble(NU-1)) 1400.
1694     IUA = MIN0(INT(XUA),NU-2) 1401.
1695     QAA = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA)) 1402.
1696     QAB = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA+1)) 1403.
1697     C 1404.
1698     60 QBA = 1. 1405.
1699     QBB = 1. 1406.
1700     IF(XUB.GT.0. .AND. IUB.LT.NU-1) GO TO 70 1407.
1701     c XUB = DMIN1(DMAX1(XUB,0.),FLOAT(NU-1)) 1408.
1702     XUB = DMIN1(DMAX1(XUB,0.),dble(NU-1)) 1408.
1703     IUB = MIN0(INT(XUB),NU-2) 1409.
1704     QBA = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB)) 1410.
1705     QBB = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB+1)) 1411.
1706     C 1412.
1707     70 UAB = XUA-FLOAT(IUA) 1413.
1708     UBB = XUB-FLOAT(IUB) 1414.
1709     UAA = 1.-UAB 1415.
1710     UBA = 1.-UBB 1416.
1711     C 1417.
1712     C 1418.
1713     WAAA = WAA*UAA*QAA 1419.
1714     WAAB = WAA*UAB*QAB 1420.
1715     WABA = WAB*UAA*QAA 1421.
1716     WABB = WAB*UAB*QAB 1422.
1717     WBAA = WBA*UBA*QBA 1423.
1718     WBAB = WBA*UBB*QBB 1424.
1719     WBBA = WBB*UBA*QBA 1425.
1720     WBBB = WBB*UBB*QBB 1426.
1721     C 1427.
1722     NG = NGX(KGX(IGAS)) 1428.
1723     IAAA = IAA+IGUX(IGAS) + NG*IUA 1429.
1724     IAAB = IAAA+NG 1430.
1725     IABA = IAAA+NGUX 1431.
1726     IABB = IABA+NG 1432.
1727     IBAA = IBA+IGUX(IGAS) + NG*IUB 1433.
1728     IBAB = IBAA+NG 1434.
1729     IBBA = IBAA+NGUX 1435.
1730     IBBB = IBBA+NG 1436.
1731     C 1437.
1732     C 1438.
1733     IPG = IP+NL*(IG1X(KGX(IGAS))-1) 1439.
1734     DO 80 IG=1,NG 1440.
1735     TAUN(IPG) = TAUN(IPG) 1441.
1736     * + WAAA*TAUTBL(IAAA+IG) 1442.
1737     * + WAAB*TAUTBL(IAAB+IG) 1443.
1738     * + WABA*TAUTBL(IABA+IG) 1444.
1739     * + WABB*TAUTBL(IABB+IG) 1445.
1740     * + WBAA*TAUTBL(IBAA+IG) 1446.
1741     * + WBAB*TAUTBL(IBAB+IG) 1447.
1742     * + WBBA*TAUTBL(IBBA+IG) 1448.
1743     * + WBBB*TAUTBL(IBBB+IG) 1449.
1744     80 IPG = IPG+NL 1450.
1745     90 CONTINUE 1451.
1746     100 CONTINUE 1452.
1747     C 1453.
1748     IF(MLGAS(12).LT.1) GO TO 110 1454.
1749     C------------------------------------------------------------------- 1455.
1750     C PICK UP CCL3F1 (F11) ABSORPTION 1456.
1751     C------------------------------------------------------------------- 1457.
1752     C 1458.
1753     DO 102 K=1,25 1459.
1754     XKPCMA=TRACEG(K,1) 1460.
1755     IF(XKPCMA.LT.1.E-10) GO TO 102 1461.
1756     DO 101 N=1,NL 1462.
1757     NK=N+(K-1)*NL 1463.
1758     101 TAUN(NK)=TAUN(NK)+ULGAS(N,8)*XKPCMA 1464.
1759     102 CONTINUE 1465.
1760     C 1466.
1761     110 IF(MLGAS(13).LT.1) GO TO 120 1467.
1762     C------------------------------------------------------------------- 1468.
1763     C PICK UP CCL2F2 (F12) ABSORPTION 1469.
1764     C------------------------------------------------------------------- 1470.
1765     C 1471.
1766     DO 112 K=1,25 1472.
1767     XKPCMA=TRACEG(K,2) 1473.
1768     IF(XKPCMA.LT.1.E-10) GO TO 112 1474.
1769     DO 111 N=1,NL 1475.
1770     NK=N+(K-1)*NL 1476.
1771     111 TAUN(NK)=TAUN(NK)+ULGAS(N,9)*XKPCMA 1477.
1772     112 CONTINUE 1478.
1773     C 1479.
1774     120 IF(MLGAS(14).LT.1) GO TO 130 1480.
1775     C------------------------------------------------------------------- 1481.
1776     C PICK UP WINDOW H2O GASEOUS ABSORPTION 1482.
1777     C------------------------------------------------------------------- 1483.
1778     C 1484.
1779     DO 121 N=1,NL 1485.
1780     TAUN(N) = TAUN(N) 1486.
1781     121 CONTINUE 1487.
1782     130 CONTINUE 1488.
1783     C------------------------------------------------------------------- 1489.
1784     C PICK UP H2O CONTINUUM ABSORPTION 1490.
1785     C------------------------------------------------------------------- 1491.
1786     C 1492.
1787     IF(MLGAS(15).LT.1) GO TO 140 1493.
1788     DO 131 N=1,NL 1494.
1789     TAUN(N) = TAUN(N) + 2.21866E-11* 1495.
1790     * PL(N)*ULGAS(N,1)*EXP(1800./TLM(N))* 1496.
1791     * (ULGAS(N,1)/DPL(N)+.808563) 1497.
1792     131 CONTINUE 1498.
1793     C 1499.
1794     C$ ********************************REMOVE FOLLOWING STATEMENT TO CORRECT1500.
1795     IF(NL.GT.0) RETURN 1501.
1796     DO 133 N=1,NL 1502.
1797     PH2O=12.38E-4*ULGAS(N,1)*PL(N)/DPL(N) 1503.
1798     TH2O=EXP(1800./TLM(N)-6.081081) 1504.
1799     COEC=PH2O*TH2O+.0015*(PL(N)-PH2O) 1505.
1800     DO 132 K=2,25 1506.
1801     COEF=H2OCON(K)*1.E-5 1507.
1802     NK=N+(K-1)*NL 1508.
1803     132 TAUN(NK)=TAUN(NK)+ULGAS(N,1)*COEC*COEF 1509.
1804     133 CONTINUE 1510.
1805     140 CONTINUE 1511.
1806     C 1512.
1807     RETURN 1513.
1808     END 1514.
1809     SUBROUTINE THERML 1515.
1810    
1811     #include "B83XX.COM"
1812     #if ( defined CLM )
1813 jscott 1.2 #include "CLM.h"
1814 jscott 1.1 #endif
1815    
1816     DATA R6,R24/.1666667,4.166667E-02/ 1577.
1817     DATA A,B,C/0.3825,0.5742,0.0433/ 1578.
1818     C 1579.
1819     C-----------------------------------------------------------------------1580.
1820     C LAYER EDGE TEMPERATURE INTERPOLATION1581.
1821     C-----------------------------------------------------------------------1582.
1822     IF(TLGRAD.LT.0.) GO TO 103 1583.
1823     TA=TLM(1) 1584.
1824     TB=TLM(2) 1585.
1825     P1=PLB(1) 1586.
1826     P2=PLB(2) 1587.
1827     P3=PLB(3) 1588.
1828     DT1CPT=0.5*TA*(EXPBYK(PLB(1))-EXPBYK(PLB(2)))/EXPBYK(PL(1)) 1589.
1829     DTHALF=(TA-TB)*(P1-P2)/(P1-P3) 1590.
1830     IF(DTHALF.GT.DT1CPT) DTHALF=DT1CPT 1591.
1831     TLB(1)=TA+DTHALF*TLGRAD 1592.
1832     TLT(1)=TA-DTHALF*TLGRAD 1593.
1833     DO 101 L=3,NL 1594.
1834     TC=TLM(L) 1595.
1835     P4=PLB(L+1) 1596.
1836     DTHALF=0.5*((TA-TB)/(P1-P3)+(TB-TC)/(P2-P4))*(P2-P3)*TLGRAD 1597.
1837     TLB(L-1)=TB+DTHALF 1598.
1838     TLT(L-1)=TB-DTHALF 1599.
1839     TA=TB 1600.
1840     TB=TC 1601.
1841     P1=P2 1602.
1842     P2=P3 1603.
1843     101 P3=P4 1604.
1844     DTHALF=(TA-TB)*(P2-P3)/(P1-P3)*TLGRAD 1605.
1845     TLB(NL)=TC+DTHALF 1606.
1846     TLT(NL)=TC-DTHALF 1607.
1847     L=NLP 1608.
1848     DO 102 N=1,NL 1609.
1849     L=L-1 1610.
1850     IF(PLB(L).GT.PTLISO) GO TO 103 1611.
1851     TLT(L)=TLM(L) 1612.
1852     102 TLB(L)=TLM(L) 1613.
1853     103 CONTINUE 1614.
1854     C-----------------------------------------------------------------------1615.
1855     C WEIGHT ASSIGNMENTS FOR PLANCK FUNCTION INTERPOLATION1616.
1856     C-----------------------------------------------------------------------1617.
1857     DO 104 L=1,NL 1618.
1858     ITL=TLB(L) 1619.
1859     WTLB(L)=TLB(L)-ITL 1620.
1860     ITLB(L)=ITL-IT0 1621.
1861     ITL=TLT(L) 1622.
1862     WTLT(L)=TLT(L)-ITL 1623.
1863     104 ITLT(L)=ITL-IT0 1624.
1864     ITS=TSL 1625.
1865     WTS=TSL-ITS 1626.
1866     ITS=ITS-IT0 1627.
1867     C 1628.
1868     C ------------------------------------------------------------------1629.
1869     C WINDOW REGION FLUX COMPUTATION1630.
1870     C ------------------------------------------------------------------1631.
1871     C DOWNWARD FLUX1632.
1872     C ------------------------------------------------------------------1633.
1873     K=1 1634.
1874     BG=BGFEMT(K) 1635.
1875     c print *,'1635 K=',k,' PEARTH=',PEARTH
1876     c print *,'BG=',BG
1877     WTS1=1.-WTS 1636.
1878     TRSLTS=0. 1637.
1879     TRSLTG=0. 1638.
1880     TRSLWV=0. 1639.
1881     TRSLBS=0. 1640.
1882     DNA=0. 1641.
1883     DNB=0. 1642.
1884     DNC=0. 1643.
1885     NLK0=0 1644.
1886     NLK=NL 1645.
1887     TRDFLB(NLP)=0. 1646.
1888     100 TAUA=TAUN(NLK) 1647.
1889     IF(TAUA.GT.1.E-05) GO TO 120 1648.
1890     TRDFLB(NLK)=0. 1649.
1891     NLK=NLK-1 1650.
1892     IF(NLK.GT.NLK0) GO TO 100 1651.
1893     110 NLK=NLK+1 1652.
1894     TRUFLB(NLK)=BG 1653.
1895     IF(NLK.LT.NLP) GO TO 110 1654.
1896     TRUFG=BG 1655.
1897     TRDFG=0. 1656.
1898     TRUFGW=BG 1657.
1899     TRUFGW=0. 1658.
1900     TRUFTW=TRUFLB(NLP) 1659.
1901     GO TO 200 1660.
1902     120 N=NLK 1661.
1903     130 ITL=ITLT(N) 1662.
1904     BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1663.
1905     ITL=ITLB(N) 1664.
1906     BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1665.
1907     TAUA=TAUN(N) 1666.
1908     TAUB=TAUA+TAUA 1667.
1909     TAUC=10.*TAUA 1668.
1910     IF(TAUA.GT.1.E-01) GO TO 140 1669.
1911     IF(TAUA.LT.1.E-03) GO TO 135 1670.
1912     TAU2=TAUA*TAUA 1671.
1913     BDIF=BBOT-BTOP 1672.
1914     BBTA=BDIF/TAUA 1673.
1915     BBTB=BDIF/TAUB 1674.
1916     BBTC=BDIF/TAUC 1675.
1917     TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1676.
1918     GO TO 145 1677.
1919     135 BDIF=.5*(BTOP+BBOT) 1678.
1920     TRA(N)=1.-TAUA 1679.
1921     ENA(N)=BDIF*TAUA 1680.
1922     DNA=DNA*TRA(N)+ENA(N) 1681.
1923     TRB(N)=1.-TAUB 1682.
1924     ENB(N)=BDIF*TAUB 1683.
1925     DNB=DNB*TRB(N)+ENB(N) 1684.
1926     TRC(N)=1.-TAUC 1685.
1927     ENC(N)=BDIF*TAUC 1686.
1928     DNC=DNC*TRC(N)+ENC(N) 1687.
1929     GO TO 160 1688.
1930     140 BDIF=BBOT-BTOP 1689.
1931     BBTA=BDIF/TAUA 1690.
1932     BBTB=BDIF/TAUB 1691.
1933     BBTC=BDIF/TAUC 1692.
1934     IF(TAUA.GT.7.) GO TO 150 1693.
1935     TRAN=EXP(-TAUA) 1694.
1936     145 TRA(N)=TRAN 1695.
1937     ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1696.
1938     DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1697.
1939     TRBN=TRAN*TRAN 1698.
1940     TRB(N)=TRBN 1699.
1941     ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1700.
1942     DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1701.
1943     TRCN=(TRBN*TRBN*TRAN)**2 1702.
1944     TRC(N)=TRCN 1703.
1945     ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1704.
1946     DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1705.
1947     GO TO 160 1706.
1948     150 TRA(N)=0. 1707.
1949     TRB(N)=0. 1708.
1950     TRC(N)=0. 1709.
1951     ENA(N)=BTOP+BBTA 1710.
1952     ENB(N)=BTOP+BBTB 1711.
1953     ENC(N)=BTOP+BBTC 1712.
1954     DNA=BBOT-BBTA 1713.
1955     DNB=BBOT-BBTB 1714.
1956     DNC=BBOT-BBTC 1715.
1957     160 TRDFLB(N)=A*DNA+B*DNB+C*DNC 1716.
1958     N=N-1 1717.
1959     IF(N.GT.0) GO TO 130 1718.
1960     IF(LTOPCL.LT.1) GO TO 165 1719.
1961     ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1720.
1962     ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1721.
1963     ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1722.
1964     165 CONTINUE 1723.
1965     C ------------------------------------------------------------------1724.
1966     C SURFACE LAYER FLUX COMPUTATION1725.
1967     C ------------------------------------------------------------------1726.
1968     N=1 1727.
1969     TRDFG=TRDFLB(1) 1728.
1970     TAUA=TAUSL(1)+FTAUSL(1) 1729.
1971     IF(TAUA.GT.1.E-05) GO TO 170 1730.
1972     BG=BG+TRDFG*TRGALB(K) 1731.
1973     UNB=BG 1733.
1974     UNC=BG 1734.
1975     FUNABC=BG 1735.
1976     GO TO 180 1736.
1977     170 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1737.
1978     TA=EXP(-TAUA) 1738.
1979     TB=TA*TA 1739.
1980     TC=(TB*TB*TA)**2 1740.
1981     DNA=(DNA-BS)*TA+BS 1741.
1982     DNB=(DNB-BS)*TB+BS 1742.
1983     DNC=(DNC-BS)*TC+BS 1743.
1984     TRDFG=A*DNA+B*DNB+C*DNC 1744.
1985     BG=BG+TRDFG*TRGALB(K) 1745.
1986     UNA=(BG-BS)*TA+BS 1746.
1987     UNB=(BG-BS)*TB+BS 1747.
1988     UNC=(BG-BS)*TC+BS 1748.
1989     FUNABC=A*UNA+B*UNB+C*UNC 1749.
1990     BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1750.
1991     BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1751.
1992     SLABS=1.-A*TA-B*TB-C*TC 1752.
1993     TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1753.
1994     TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1754.
1995     TRSLBS=TRSLBS+BS*SLABS 1755.
1996     C ------------------------------------------------------------------1756.
1997     C UPWARD FLUX COMPUTATION1757.
1998     C ------------------------------------------------------------------1758.
1999     180 TRUFLB(N)=FUNABC 1759.
2000     IF(N.GT.NLK) GO TO 190 1760.
2001     UNA=UNA*TRA(N)+ENA(N) 1761.
2002     UNB=UNB*TRB(N)+ENB(N) 1762.
2003     UNC=UNC*TRC(N)+ENC(N) 1763.
2004     FUNABC=A*UNA+B*UNB+C*UNC 1764.
2005     190 N=N+1 1765.
2006     IF(N.LT.NLP) GO TO 180 1766.
2007     TRUFLB(N)=FUNABC 1767.
2008     TRUFTW=FUNABC 1768.
2009     TRDFGW=TRDFG 1769.
2010     TRUFGW=BG 1770.
2011     TRUFG=BG 1771.
2012     DO 195 L=1,NLP 1772.
2013     DFLB(L,1)=TRDFLB(L) 1773.
2014     195 UFLB(L,1)=TRUFLB(L) 1774.
2015     DFSL(1)=TRDFLB(1) 1775.
2016     UFSL(1)=TRUFLB(1) 1776.
2017     DFLB(1,1)=TRDFGW 1777.
2018     UFLB(1,1)=TRUFGW 1778.
2019     c print *,' 1778 TRUFLB(1)=',TRUFLB(1)
2020     C ------------------------------------------------------------------1779.
2021     C END WINDOW REGION FLUX COMPUTATION; CONTINUE INTEGRATION1780.
2022     C ------------------------------------------------------------------1781.
2023     C ------------------------------------------------------------------1782.
2024     C DOWNWARD FLUX COMPUTATION 1783.
2025     C ------------------------------------------------------------------1784.
2026     200 ITK0=K*ITNEXT 1785.
2027     K=K+1 1786.
2028     IF(K.GT.NKTR) GO TO 300 1787.
2029     DFLB(NLP,K)=0. 1788.
2030     BG=BGFEMT(K) 1789.
2031     ITS=ITS+ITNEXT 1790.
2032     NLK0=NLK0+NL 1791.
2033     NLK=NLK0+NL 1792.
2034     NLL=NL 1793.
2035     210 TAUA=TAUN(NLK) 1794.
2036     IF(TAUA.GT.1.E-05) GO TO 220 1795.
2037     DFLB(NLL,K)=0. 1796.
2038     NLK=NLK-1 1797.
2039     NLL=NLL-1 1798.
2040     IF(NLL.GT.0) GO TO 210 1799.
2041     TRUFG=TRUFG+BG 1800.
2042     DO 215 N=1,NLP 1801.
2043     UFLB(N,K)=BG 1802.
2044     215 TRUFLB(N)=TRUFLB(N)+BG 1803.
2045     GO TO 200 1804.
2046     220 N=NLL 1805.
2047     DNA=0. 1806.
2048     DNB=0. 1807.
2049     DNC=0. 1808.
2050     230 ITL=ITLT(N)+ITK0 1809.
2051     BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1810.
2052     ITL=ITLB(N)+ITK0 1811.
2053     BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1812.
2054     TAUA=TAUN(NLK) 1813.
2055     TAUB=TAUA+TAUA 1814.
2056     TAUC=10.*TAUA 1815.
2057     IF(TAUA.GT.1.E-01) GO TO 240 1816.
2058     IF(TAUA.LT.1.E-03) GO TO 235 1817.
2059     TAU2=TAUA*TAUA 1818.
2060     BDIF=BBOT-BTOP 1819.
2061     BBTA=BDIF/TAUA 1820.
2062     BBTB=BDIF/TAUB 1821.
2063     BBTC=BDIF/TAUC 1822.
2064     TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1823.
2065     GO TO 245 1824.
2066     235 BDIF=.5*(BTOP+BBOT) 1825.
2067     TRA(N)=1.-TAUA 1826.
2068     ENA(N)=BDIF*TAUA 1827.
2069     DNA=DNA*TRA(N)+ENA(N) 1828.
2070     TRB(N)=1.-TAUB 1829.
2071     ENB(N)=BDIF*TAUB 1830.
2072     DNB=DNB*TRB(N)+ENB(N) 1831.
2073     TRC(N)=1.-TAUC 1832.
2074     ENC(N)=BDIF*TAUC 1833.
2075     DNC=DNC*TRC(N)+ENC(N) 1834.
2076     GO TO 260 1835.
2077     240 BDIF=BBOT-BTOP 1836.
2078     BBTA=BDIF/TAUA 1837.
2079     BBTB=BDIF/TAUB 1838.
2080     BBTC=BDIF/TAUC 1839.
2081     IF(TAUA.GT.7.) GO TO 250 1840.
2082     TRAN=EXP(-TAUA) 1841.
2083     245 TRA(N)=TRAN 1842.
2084     ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1843.
2085     DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1844.
2086     TRBN=TRAN*TRAN 1845.
2087     TRB(N)=TRBN 1846.
2088     ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1847.
2089     DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1848.
2090     TRCN=(TRBN*TRBN*TRAN)**2 1849.
2091     TRC(N)=TRCN 1850.
2092     ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1851.
2093     DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1852.
2094     GO TO 260 1853.
2095     250 TRA(N)=0. 1854.
2096     TRB(N)=0. 1855.
2097     TRC(N)=0. 1856.
2098     ENA(N)=BTOP+BBTA 1857.
2099     ENB(N)=BTOP+BBTB 1858.
2100     ENC(N)=BTOP+BBTC 1859.
2101     DNA=BBOT-BBTA 1860.
2102     DNB=BBOT-BBTB 1861.
2103     DNC=BBOT-BBTC 1862.
2104     260 FDNABC=A*DNA+B*DNB+C*DNC 1863.
2105     TRDFLB(N)=TRDFLB(N)+FDNABC 1864.
2106     DFLB(N,K)=FDNABC 1865.
2107     N=N-1 1866.
2108     NLK=NLK-1 1867.
2109     IF(N.GT.0) GO TO 230 1868.
2110     DFSL(K)=FDNABC 1869.
2111     IF(LTOPCL.LT.1) GO TO 265 1870.
2112     ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1871.
2113     ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1872.
2114     ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1873.
2115     265 CONTINUE 1874.
2116     C ------------------------------------------------------------------1875.
2117     C SURFACE LAYER FLUX COMPUTATION1876.
2118     C ------------------------------------------------------------------1877.
2119     N=1 1878.
2120     TAUA=TAUSL(K)+FTAUSL(K) 1879.
2121     IF(TAUA.GT.1.E-05) GO TO 270 1880.
2122     BG=BG+FDNABC*TRGALB(K) 1881.
2123     UNA=BG 1882.
2124     UNB=BG 1883.
2125     UNC=BG 1884.
2126     FUNABC=BG 1885.
2127     GO TO 280 1886.
2128     270 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1887.
2129     TA=EXP(-TAUA) 1888.
2130     TB=TA*TA 1889.
2131     TC=(TB*TB*TA)**2 1890.
2132     DNA=(DNA-BS)*TA+BS 1891.
2133     DNB=(DNB-BS)*TB+BS 1892.
2134     DNC=(DNC-BS)*TC+BS 1893.
2135     FDNABC=A*DNA+B*DNB+C*DNC 1894.
2136     BG=BGFEMT(K)+FDNABC*TRGALB(K) 1895.
2137     UNA=(BG-BS)*TA+BS 1896.
2138     UNB=(BG-BS)*TB+BS 1897.
2139     UNC=(BG-BS)*TC+BS 1898.
2140     FUNABC=A*UNA+B*UNB+C*UNC 1899.
2141     BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1900.
2142     BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1901.
2143     SLABS=1.-A*TA-B*TB-C*TC 1902.
2144     TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1903.
2145     TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1904.
2146     TRSLBS=TRSLBS+BS*SLABS 1905.
2147     C ------------------------------------------------------------------1906.
2148     C UPWARD FLUX COMPUTATION1907.
2149     C ------------------------------------------------------------------1908.
2150     280 TRUFLB(N)=TRUFLB(N)+FUNABC 1909.
2151     UFLB(N,K)=FUNABC 1910.
2152     IF(N.GT.NLL) GO TO 290 1911.
2153     UNA=UNA*TRA(N)+ENA(N) 1912.
2154     UNB=UNB*TRB(N)+ENB(N) 1913.
2155     UNC=UNC*TRC(N)+ENC(N) 1914.
2156     FUNABC=A*UNA+B*UNB+C*UNC 1915.
2157     290 N=N+1 1916.
2158     IF(N.LT.NLP) GO TO 280 1917.
2159     TRUFLB(NLP)=TRUFLB(NLP)+FUNABC 1918.
2160     UFLB(NLP,K)=FUNABC 1919.
2161     UFSL(K)=UFLB(1,K) 1920.
2162     TRDFG=TRDFG+FDNABC 1921.
2163     DFLB(1,K)=FDNABC 1922.
2164     TRUFG=TRUFG+BG 1923.
2165     UFLB(1,K)=BG 1924.
2166     IF(K.EQ.11) TRSLWV=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1925.
2167     GO TO 200 1926.
2168     300 CONTINUE 1927.
2169     c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2170     c print * ,'1927 JLAT=',JLAT,PEARTH,PLICE
2171     c print *,' TRUFLB(1)=',TRUFLB(1),' TRUFG=',TRUFG
2172     c endif
2173    
2174     #if ( defined CLM)
2175     c if(ncallclm.ge.1)then
2176     c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2177     c TRUFG=-lwuclm(ILON,JLAT)
2178     c print *,' CLM TRUFG=',TRUFG
2179     c endif
2180     c endif
2181     #endif
2182     C ------------------------------------------------------------------1928.
2183     C END FLUX COMPUTATION1929.
2184     C ------------------------------------------------------------------1930.
2185     TRSLCR=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1931.
2186     TRDFSL=TRDFLB(1) 1932.
2187     TRDFLB(1)=TRDFG 1933.
2188     TRUFSL=TRUFLB(1) 1934.
2189     TRUFLB(1)=TRUFG 1935.
2190     DO 310 L=1,NLP 1936.
2191     310 TRNFLB(L)=TRUFLB(L)-TRDFLB(L) 1937.
2192     DO 320 L=1,NL 1938.
2193     320 TRFCRL(L)=TRNFLB(L+1)-TRNFLB(L) 1939.
2194     PFW=10.*TRUFTW 1940.
2195     IPF=PFW 1941.
2196     IF(IPF.LT.10) GO TO 330 1942.
2197     DPF=PFW-IPF 1943.
2198     IPF=IPF+180 1944.
2199     GO TO 350 1945.
2200     330 PFW=10.*PFW 1946.
2201     IPF=PFW 1947.
2202     IF(IPF.LT.10) GO TO 340 1948.
2203     DPF=PFW-IPF 1949.
2204     IPF=IPF+90 1950.
2205     GO TO 350 1951.
2206     340 PFW=10.*PFW 1952.
2207     IPF=PFW 1953.
2208     IF(IPF.LT.1) IPF=1 1954.
2209     350 BTEMPW=TKPFW(IPF)+DPF*(TKPFW(IPF+1)-TKPFW(IPF)) 1955.
2210     RETURN 1956.
2211     END 1957.
2212     SUBROUTINE SOLAR 1958.
2213     C-----------------------------------------------------------------------1959.
2214     C SOLAR RETURNS 1960.
2215     C-----------------------------------------------------------------------1961.
2216     C SRDFLB SOLAR DOWNWARD FLUX AT LAYER BOTTOM 1962.
2217     C SRUFLB SOLAR UPWARD FLUX AT LAYER BOTTOM EDGE 1963.
2218     C SRNFLB SOLAR NET (DOWNWARD) FLUX (WATTS/M**2) 1964.
2219     C SRFHRL SOLAR HEATING RATE : FLUX (WATTS/M**2) 1965.
2220     C SRRVIS VISALB OF ATMOSPHERE (AS IF RSURFX=0.) 1966.
2221     C SRTATM ATMOS. TRANSMISSIVITY (TOTAL SPECTRUM) 1967.
2222     C PLAVIS PLANETARY ALBEDO 0.2-0.7 MICRON REGION 1968.
2223     C ALBVIS ALBEDO AT GROUND 0.2-0.7 MICRON REGION 1969.
2224     C PLANIR PLANETARY ALBEDO WAV>0.7 MICRON REGION 1970.
2225     C ALBNIR ALBEDO AT GROUND WAV>0.7 MICRON REGION 1971.
2226     C-----------------------------------------------------------------------1972.
2227     C COMMENT 1973.
2228     C-----------------------------------------------------------------------1974.
2229     C SOLAR DATA IS RETURNED IN RADCOM LINES: N,O,P,Q1975.
2230     C NORMS0=1 FLUXES ARE NORMALIZED BY SOLAR CONSTANT1976.
2231     C VERTICAL FLUX DISTRIBUTIONS CONTAIN SOLAR ZENITH1977.
2232     C ANGLE (COSZ) DEPENDENCE 1978.
2233     C RETURNED SOLAR FLUX VALUES SHOULD BE MULTIPLIED 1979.
2234     C BY COSZ WHEN COMPUTING ATMOSPHERIC HEATING RATE 1980.
2235     C-----------------------------------------------------------------------1981.
2236    
2237     #include "B83XX.COM"
2238    
2239     DIMENSION PFR(52),PFRI(52), PI0C(14),DKS0(14) 2036.
2240     DATA PFR/ 2037.
2241     1.4144,.4917,.5265,.5530,.5757,.5966,.6159,.6345,.6522,.6689,.6849,2038.
2242     2.7003,.7152,.7293,.7428,.7557,.7680,.7796,.7905,.8008,.8105,.8198,2039.
2243     3.8286,.8368,.8444,.8515,.8581,.8642,.8699,.8750,.8798,.8843,.8886,2040.
2244     4.8928,.8968,.9005,.9040,.9072,.9101,.9129,.9153,.9174,.9193,.9212,2041.
2245     5.9227,.9242,.9254,.9266,.9275,.9284,.864245 ,.864245 / 2042.
2246     DATA PFRI/ 2043.
2247     1.4950,.5300,.5620,.5882,.6088,.6302,.6537,.6763,.6969,.7157,.7332,2044.
2248     2.7499,.7658,.7806,.7945,.8074,.8194,.8306,.8409,.8504,.8592,.8674,2045.
2249     3.8751,.8822,.8886,.8946,.9000,.9050,.9097,.9139,.9177,.9210,.9246,2046.
2250     4.9280,.9313,.9343,.9371,.9394,.9415,.9438,.9458,.9475,.9488,.9500,2047.
2251     5.9507,.9515,.9529,.9532,.9538,.9541,.876178 ,.876178 / 2048.
2252     DATA PI0C/.66,.91,.975,.99,.995,.999,.999,.999,.999,.999,.999, 2049.
2253     + .999,.9999,.99999/ 2050.
2254     DATA DKS0/.01,.03,.04,.04,.04,.002,.004,.013,.002,.003,.003, 2051.
2255     + .072,.20,.53/ 2052.
2256     DIMENSION DBLN(20), KSLAM(14), CPFFL(40) 2053.
2257     DATA DBLN/2.,4.,8.,16.,32.,64.,128.,256.,512.,1024.,2048.,4096., 2054.
2258     + 8192.,16384.,32768.,65536.,131072.,262144.,524288.,1048576./ 2055.
2259     DATA NKSLAM/14/, KSLAM/1,1,2,2,5,5,5,5,1,1,1,3,4,6/ 2056.
2260     DATA XCMNO2/5.465/ 2057.
2261     DATA XCMO3/.0399623/ 2058.
2262     DATA TOTRAY/0.000155/ 2059.
2263     C 2060.
2264     DIMENSION SRBALB(6),SRXALB(6) 2061.
2265     EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 2062.
2266     C 2063.
2267     EQUIVALENCE 2064.
2268     + (BXA(1),BOCVIS),(BXA(5),BEAVIS),(BXA( 9),BOIVIS),(BXA(13),BLIVIS)2065.
2269     +,(BXA(2),BOCNIR),(BXA(6),BEANIR),(BXA(10),BOINIR),(BXA(14),BLINIR)2066.
2270     +,(BXA(3),XOCVIS),(BXA(7),XEAVIS),(BXA(11),XOIVIS),(BXA(15),XLIVIS)2067.
2271     +,(BXA(4),XOCNIR),(BXA(8),XEANIR),(BXA(12),XOINIR),(BXA(16),XLINIR)2068.
2272     +, (BXA(17),EXPSNE),(BXA(18),EXPSNO),(BXA(19),EXPSNL)2069.
2273     +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 2070.
2274     +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 2071.
2275     C 2072.
2276     EQUIVALENCE (SRXATM(1),SRXVIS),(SRXATM(2),SRXNIR) 2073.
2277     EQUIVALENCE (SRXATM(3),XXAVIS),(SRXATM(4),XXANIR) 2074.
2278     C 2075.
2279     EQUIVALENCE (ISPARE(1),NEWASZ) 2075.5
2280     C 2076.
2281     C-----------------------------------------------------------------------2077.
2282     C SOLAR: NET FLUX AT GROUND FOR FRACTIONAL GRID SURFACE ALBEDOS 2078.
2283     C 2079.
2284     C PFNFG(DT,XA,RSA,RX,RB)=(DT*(1.-RB)-XA*(RX-RB)*(1.-RSA)) 2080.
2285     C + /(1.-RSA*RB) 2081.
2286     C-----------------------------------------------------------------------2082.
2287     C 2083.
2288     C 2084.
2289     C O3ABS(X)= 1.08173*X/(1.00+ 2085.
2290     C $ 138.57*X)**0.805 + 0.0658*X/(1.00+(103.63*X)**3) 2086.
2291     C 2087.
2292     S0COSZ=S0 2088.
2293     IF(NORMS0.EQ.0) S0COSZ=S0*COSZ 2089.
2294     C 2090.
2295     DO 10 N=1,NLP 2091.
2296     SRNFLB(N)=0. 2092.
2297     SRDFLB(N)=0. 2093.
2298     SRUFLB(N)=0. 2094.
2299     SRFHRL(N)=0. 2095.
2300     10 CONTINUE 2096.
2301     SRIVIS=0. 2097.
2302     SROVIS=0. 2098.
2303     SRINIR=0. 2099.
2304     SRONIR=0. 2100.
2305     SRDVIS=0. 2101.
2306     SRUVIS=0. 2102.
2307     SRDNIR=0. 2103.
2308     SRUNIR=0. 2104.
2309     SRTVIS=0. 2105.
2310     SRAVIS=0. 2106.
2311     SRTNIR=0. 2107.
2312     SRANIR=0. 2108.
2313     SRSLHR=0. 2109.
2314     PLAVIS=1. 2110.
2315     PLANIR=1. 2111.
2316     ALBVIS=1. 2112.
2317     ALBNIR=1. 2113.
2318     SRRVIS=1. 2114.
2319     SRRNIR=0. 2115.
2320     SRTNIR=0. 2116.
2321     SRXVIS=0. 2117.
2322     SRXNIR=0. 2118.
2323     C 2119.
2324     XXVIS=.53/(1.-SRBALB(6)) 2120.
2325     XXNIR=.47/(1.-SRBALB(5)) 2121.
2326     DO 20 N=1,4 2122.
2327     20 FSRNFG(N)=XXVIS*(1.-BXA(4*N-3))+XXNIR*(1.-BXA(4*N-2)) 2123.
2328     C 2124.
2329     IF(COSZ.LT.0.01) RETURN 2125.
2330     COSMAG=35.0/SQRT(1224.*COSZ*COSZ+1.0) 2126.
2331     TAURAY=TOTRAY*FRAYLE 2127.
2332     CPF=49.999/COSMAG 2128.
2333     IPF=CPF 2129.
2334     DPF=CPF-IPF 2130.
2335     IF(ISOSCT.EQ.1) IPF=51 2131.
2336     CPFF=(1.0-DPF)*PFR(IPF)+DPF*PFR(IPF+1) 2132.
2337     CPFFI=(1.0-DPF)*PFRI(IPF)+DPF*PFRI(IPF+1) 2133.
2338     SECZ=1./COSZ 2134.
2339     DO 100 N=1,NL 2135.
2340     CPFFL(N)=CPFF 2136.
2341     IF(TLM(N).LT.TKCICE) CPFFL(N)=CPFFI 2137.
2342     100 CONTINUE 2138.
2343     C 2139.
2344     K = 0 2140.
2345     300 K = K+1 2141.
2346     C 2142.
2347     KLAM=KSLAM(K) 2143.
2348     DKS0K=DKS0(K) 2144.
2349     DKS0X=DKS0K*S0COSZ 2145.
2350     RBNB=SRBALB(KLAM) 2146.
2351     RBNX=SRXALB(KLAM) 2147.
2352     RCNB=0.0 2148.
2353     RCNX=0.0 2149.
2354     C 2150.
2355     N = 0 2151.
2356     200 N = N+1 2152.
2357     C 2153.
2358     CPFF=CPFFL(N) 2154.
2359     SRB(N)=RBNB 2155.
2360     SRX(N)=RBNX 2156.
2361     TLN=TLM(N) 2157.
2362     PLN=PL(N) 2158.
2363     ULN=ULGAS(N,1) 2159.
2364     RTAU=1.E-06 2160.
2365     GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114),K 2161.
2366     101 CONTINUE 2162.
2367     C--------K=6-------H2O DS0=.01 2163.
2368     TERMA=(35.66+TLN*(.0416-.0004622*TLN+.001057*PLN))*(1.+.04286*PLN)2164.
2369     TERMB=(1.+.00171*ULN)*(1.+PLN*(189.088+.1316*PLN)) 2165.
2370     TAU1 =TERMA/TERMB 2166.
2371     IF(TAU1.GT.0.02343) TAU1=0.02343 2167.
2372     TAU=TAU1*ULN 2168.
2373     GO TO 120 2169.
2374     102 CONTINUE 2170.
2375     C--------K=5-------H2O DS0=.03 2171.
2376     TERMA=(2.792+TLN*(.0914-.0002848*TLN+.0003395*PLN)) 2172.
2377     + *(1.+.02964*PLN) 2173.
2378     TERMB=(1.0+.000657*ULN)*(1.+PLN*(240.70+.13847*PLN)) 2174.
2379     TAU1 =TERMA/TERMB 2175.
2380     IF(TAU1.GT.0.00520) TAU1=0.00520 2176.
2381     TAU=TAU1*ULN 2177.
2382     GO TO 120 2178.
2383     103 CONTINUE 2179.
2384     C--------K=4-------H2O DS0=.04 2180.
2385     TERMA=(.4768+.467E-04*PLN*TLN)*(1.+TLN*(.00191-.719E-05*TLN)) 2181.
2386     TERMB=(1.+.717E-04*ULN)*(1.+PLN*(130.56+.0876*PLN))/(1.+.0266*PLN)2182.
2387     TAU1 =TERMA/TERMB 2183.
2388     IF(TAU1.GT.0.00150) TAU1=0.0015 2184.
2389     TAU=TAU1*ULN 2185.
2390     GO TO 120 2186.
2391     104 CONTINUE 2187.
2392     C--------K=3-------H2O DS0=.04 2188.
2393     TERMA=(.000247*TLN-.091+PLN*(.00035+.78E-06*TLN))*(1.+.2847*PLN) 2189.
2394     TERMB=(1.+.2066E-04*ULN)*(1.+PLN*(137.17+.16132*PLN)) 2190.
2395     TAU =(TERMA/TERMB)*ULN 2191.
2396     GO TO 120 2192.
2397     105 CONTINUE 2193.
2398     C--------K=2-------H2O DS0=.04 2194.
2399     TERMA=(PLN*(1.974/TLN+.0001117*TLN)-10.713)*(1.+.005788*TLN) 2195.
2400     + *(1.+.001517*PLN) 2196.
2401     TERMB=(1.+.3218E-04*ULN)*(1.+PLN*(863.44+.2048*PLN)) 2197.
2402     TAU =(TERMA/TERMB)*ULN 2198.
2403     GO TO 120 2199.
2404     106 CONTINUE 2200.
2405     C--------K=4-------O2 DS0=.002 2201.
2406     ULN=ULGAS(N,4) 2202.
2407     TERMA=(.2236E-05-.1181E-09*TLN)*(1.+PLN*(.6364E-05*PLN+.001168)) 2203.
2408     TERMB=1.+.1521E-05*ULN 2204.
2409     TAU =(TERMA/TERMB)*ULN 2205.
2410     GO TO 120 2206.
2411     107 CONTINUE 2207.
2412     C--------K=3-------O2 DS0=.004 2208.
2413     ULN=ULGAS(N,4) 2209.
2414     TERMA=(.3179E-06-.9263E-11*TLN)*(1.+PLN*(.8832E-05*PLN+.0005292)) 2210.
2415     TERMB=1.+.1968E-06*ULN 2211.
2416     TAU =(TERMA/TERMB)*ULN 2212.
2417     GO TO 120 2213.
2418     108 CONTINUE 2214.
2419     C--------K=2-------O2 DS0=.013 2215.
2420     ULN=ULGAS(N,4) 2216.
2421     TERMA=(.2801E-07-.1638E-12*TLN)*(1.+PLN*(.1683E-04*PLN-.001721)) 2217.
2422     TERMB=1.+.8097E-07*ULN 2218.
2423     TAU =(TERMA/TERMB)*ULN 2219.
2424     GO TO 120 2220.
2425     109 CONTINUE 2221.
2426     C--------K=4-------CO2 DS0=.002 2222.
2427     ULN=ULGAS(N,2) 2223.
2428     TERMA=(50.73-.03155*TLN-PLN*(.5543+.00091*TLN))*(1.-.1004*PLN) 2224.
2429     TERMB=(1.+.006468*ULN)*(1.+PLN*(49.51+.8285*PLN)) 2225.
2430     TAU =(TERMA/TERMB)*ULN 2226.
2431     IF(PLN.LT.175.0) TAU=(.00018*PLN+0.00001)*ULN 2227.
2432     GO TO 120 2228.
2433     110 CONTINUE 2229.
2434     C--------K=3-------CO2 DS0=.003 2230.
2435     ULN=ULGAS(N,2) 2231.
2436     TERMA=(1.+.01319*TLN)*(PLN*(.008001*ULN+.4589E-03)-.8396*ULN) 2232.
2437     TERMB=ULN*(PLN+295.7+1.967*ULN)+.15126*PLN 2233.
2438     TAU =(TERMA/TERMB)*ULN 2234.
2439     GO TO 120 2235.
2440     111 CONTINUE 2236.
2441     C--------K=2-------CO2 DS0=.003 2237.
2442     ULN=ULGAS(N,2) 2238.
2443     TERMA=(1.+.02257*TLN)*(PLN*(.002295*ULN-.5489E-04)-.7571*ULN) 2239.
2444     TERMB=ULN*(PLN+803.9+2.477*ULN)-.09899*PLN 2240.
2445     TAU =(TERMA/TERMB)*ULN 2241.
2446     GO TO 120 2242.
2447     112 CONTINUE 2243.
2448     TAU=0.0 2244.
2449     GO TO 120 2245.
2450     113 CONTINUE 2246.
2451     TAU=0.0 2247.
2452     GO TO 120 2248.
2453     114 CONTINUE 2249.
2454     TAU=XCMNO2*ULGAS(N,5)+XCMO3*ULGAS(N,3) 2250.
2455     RTAU=TAURAY*(PLB(N)-PLB(N+1)) 2251.
2456     120 CONTINUE 2252.
2457     IF(TAU.LT.0.0) TAU=0.0 2253.
2458     CTAU=CLDTAU(N)*FCLDSR 2254.
2459     CPI0=PI0C(K) 2255.
2460     ATAU=EXTAER(N,KLAM) 2256.
2461     TAU=TAU+CTAU+ATAU+RTAU 2257.
2462     IF(TAU.LT.TAUMIN) GO TO 180 2258.
2463     CTAUSC=CPI0*CTAU 2259.
2464     ATAUSC=SCTAER(N,KLAM) 2260.
2465     TAUSCT=CTAUSC+ATAUSC+RTAU 2261.
2466     PIZERO=TAUSCT/TAU 2262.
2467     IF(PIZERO.GT.0.001) GO TO 130 2263.
2468     GO TO 180 2264.
2469     130 CONTINUE 2265.
2470     APFF=COSAER(N,KLAM) 2266.
2471     APFF0=APFF 2266.1
2472     IF(NEWASZ.GT.0) CALL HGAER1(COSZ,ATAUSC,APFF0,APFF) 2266.2
2473     PFF=(CPFF*CTAUSC+APFF*ATAUSC)/TAUSCT 2267.
2474     IF(ISOSCT.GT.1) GO TO 131 2268.
2475     GO TO 132 2269.
2476     131 TAU=TAU-TAUSCT*PFF 2270.
2477     PIZERO=PIZERO*(1.-PFF)/(1.-PIZERO*PFF) 2271.
2478     PFF=0. 2272.
2479     132 CONTINUE 2273.
2480     PR=1.0-PFF 2274.
2481     PT=1.0+PFF 2275.
2482     IF(TAU.LT.0.015625) GO TO 140 2276.
2483     C ALOG
2484     DBLS=7.001+1.44269*LOG(TAU) 2277.
2485     C ALOG
2486     NDBLS=DBLS 2278.
2487     TAU=TAU/DBLN(NDBLS) 2279.
2488     GO TO 150 2280.
2489     140 XANB=EXP(-TAU-TAU) 2281.
2490     XANX=EXP(-TAU*SECZ) 2282.
2491     TANB=PT*XANB 2283.
2492     XXT=(SECZ-2.0)*TAU 2284.
2493     TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2285.
2494     RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2286.
2495     XXT=(SECZ+2.0)*TAU 2287.
2496     RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2288.
2497     BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2289.
2498     XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2290.
2499     RASB=RASB*BNORM 2291.
2500     RASX=RASX*XNORM 2292.
2501     TANB=TANB*BNORM 2293.
2502     TANX=TANX*XNORM 2294.
2503     GO TO 170 2295.
2504     150 XANB=EXP(-TAU-TAU) 2296.
2505     XANX=EXP(-TAU*SECZ) 2297.
2506     TANB=PT*XANB 2298.
2507     XXT=(SECZ-2.0)*TAU 2299.
2508     TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2300.
2509     RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2301.
2510     XXT=(SECZ+2.0)*TAU 2302.
2511     RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2303.
2512     BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2304.
2513     XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2305.
2514     RASB=RASB*BNORM 2306.
2515     RASX=RASX*XNORM 2307.
2516     TANB=TANB*BNORM 2308.
2517     TANX=TANX*XNORM 2309.
2518     DO 160 NN=1,NDBLS 2310.
2519     RARB=RASB*RASB 2311.
2520     RARX=XANX*RASX 2312.
2521     XATB=XANB+TANB 2313.
2522     DENOM=1.0-RARB 2314.
2523     DB=(TANB+XANB*RARB)/DENOM 2315.
2524     DX=(TANX+RARX*RASB)/DENOM 2316.
2525     UB=RASB*(XANB+DB) 2317.
2526     UX=RARX+RASB*DX 2318.
2527     RASB=RASB+XATB*UB 2319.
2528     RASX=RASX+XATB*UX 2320.
2529     TANB=XANB*TANB+XATB*DB 2321.
2530     TANX=XANX*TANX+XATB*DX 2322.
2531     XANB=XANB*XANB 2323.
2532     XANX=XANX*XANX 2324.
2533     160 CONTINUE 2325.
2534     170 RARB=RASB*RBNB 2326.
2535     RARX=RASB*RBNX 2327.
2536     XATB=XANB+TANB 2328.
2537     DENOM=1.0-RARB 2329.
2538     DB=(TANB+XANB*RARB)/DENOM 2330.
2539     DX=(TANX+XANX*RARX)/DENOM 2331.
2540     UB=RBNB*(XANB+DB) 2332.
2541     UX=RBNX*XANX+RBNB*DX 2333.
2542     RBNB=RASB+XATB*UB 2334.
2543     RBNX=RASX+XATB*UX 2335.
2544     XATC=XATB/(1.0-RASB*RCNB) 2336.
2545     RCNX=RASX+(XANX*RCNX+TANX*RCNB)*XATC 2337.
2546     RCNB=RASB+RCNB*XATB*XATC 2338.
2547     GO TO 190 2339.
2548     180 RASB=0.0 2340.
2549     RASX=0.0 2341.
2550     TANB=0.0 2342.
2551     TANX=0.0 2343.
2552     XANB=EXP(-TAU-TAU) 2344.
2553     XANX=EXP(-TAU*SECZ) 2345.
2554     DX=0.0 2346.
2555     UX=RBNX*XANX 2347.
2556     RBNB=RBNB*XANB*XANB 2348.
2557     RBNX=UX*XANB 2349.
2558     RCNB=RCNB*XANB*XANB 2350.
2559     RCNX=RCNX*XANX*XANB 2351.
2560     190 RNB(N)=RASB 2352.
2561     RNX(N)=RASX 2353.
2562     TNB(N)=TANB 2354.
2563     TNX(N)=TANX 2355.
2564     XNB(N)=XANB 2356.
2565     XNX(N)=XANX 2357.
2566     IF(N.LT.NL) GO TO 200 2358.
2567     C 2359.
2568     IF(K.EQ.NKSLAM) GO TO 301 2360.
2569     SRDFLB(NLP)=SRDFLB(NLP)+DKS0X 2361.
2570     SRUFLB(NLP)=SRUFLB(NLP)+DKS0X*RBNX 2362.
2571     SRDFLB(NL)=SRDFLB(NL)+DKS0X*(XANX+DX) 2363.
2572     SRUFLB(NL)=SRUFLB(NL)+DKS0X*UX 2364.
2573     RMEAN=RBNX 2365.
2574     DO 230 M=2,NL 2366.
2575     N=NLP-M 2367.
2576     XBNB=XNB(N) 2368.
2577     XBNX=XNX(N) 2369.
2578     RBNX=RNX(N) 2370.
2579     IF(RBNX.GT.1.E-05) GO TO 210 2371.
2580     RASB=RASB*XBNB*XBNB 2372.
2581     TANX=TANX*XBNB 2373.
2582     GO TO 220 2374.
2583     210 RBNB=RNB(N) 2375.
2584     TBNB=TNB(N) 2376.
2585     TBNX=TNX(N) 2377.
2586     RARB=RASB*RBNB 2378.
2587     XBTB=XBNB+TBNB 2379.
2588     DENOM=1.0-RARB 2380.
2589     TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2381.
2590     RASB=RBNB+XBTB*XBTB*RASB/DENOM 2382.
2591     220 XANX=XANX*XBNX 2383.
2592     RBNB=SRB(N) 2384.
2593     RBNX=SRX(N) 2385.
2594     DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2386.
2595     UX=RBNX*XANX+RBNB*DX 2387.
2596     SRUFLB(N)=SRUFLB(N)+DKS0X*UX 2388.
2597     230 SRDFLB(N)=SRDFLB(N)+DKS0X*(XANX+DX) 2389.
2598     SRRNIR=SRRNIR+DKS0K*RCNX 2390.
2599     SRTNIR=SRTNIR+DKS0K*(TANX+XANX) 2391.
2600     SRXNIR=SRXNIR+DKS0K*XANX 2392.
2601     GO TO 300 2393.
2602     C 2394.
2603     301 CONTINUE 2395.
2604     SRTNIR=SRTNIR/0.459 2396.
2605     SRRNIR=SRRNIR/0.459 2397.
2606     SRXNIR=SRXNIR/0.459 2398.
2607     SRANIR=1.0-SRTNIR-SRRNIR 2399.
2608     C 2400.
2609     VRD(NLP)=DKS0X 2401.
2610     VRU(NLP)=DKS0X*RBNX 2402.
2611     O3PATH=(1.9+XANX*(COSMAG-1.9))*ULGAS(NL,3) 2403.
2612     ATOP=0. 2404.
2613     ABOT=O3ABS(O3PATH) 2405.
2614     ASUM=(ABOT-ATOP)*XANX 2406.
2615     O3A(NL)=ASUM*S0COSZ 2407.
2616     ATOP=ABOT 2408.
2617     VRD(NL)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2409.
2618     VRU(NL)=DKS0X*UX 2410.
2619     FAC(NL)=UX 2411.
2620     RMEAN=RBNX 2412.
2621     N=NL 2413.
2622     305 N=N-1 2414.
2623     XBNB=XNB(N) 2415.
2624     XBNX=XNX(N) 2416.
2625     RBNX=RNX(N) 2417.
2626     IF(RBNX.GT.1.E-05) GO TO 310 2418.
2627     RASB=RASB*XBNB*XBNB 2419.
2628     TANX=TANX*XBNB 2420.
2629     GO TO 320 2421.
2630     310 RBNB=RNB(N) 2422.
2631     TBNB=TNB(N) 2423.
2632     TBNX=TNX(N) 2424.
2633     RARB=RASB*RBNB 2425.
2634     XBTB=XBNB+TBNB 2426.
2635     DENOM=1.0-RARB 2427.
2636     TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2428.
2637     RASB=RBNB+XBTB*XBTB*RASB/DENOM 2429.
2638     320 XANX=XANX*XBNX 2430.
2639     RBNB=SRB(N) 2431.
2640     RBNX=SRX(N) 2432.
2641     DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2433.
2642     UX=RBNX*XANX+RBNB*DX 2434.
2643     FAC(N)=UX 2435.
2644     VRU(N)=DKS0X*UX 2436.
2645     O3PATH=O3PATH+(1.9+XANX*(COSMAG-1.9))*ULGAS(N,3) 2437.
2646     ABOT=O3ABS(O3PATH) 2438.
2647     ASUM=ASUM+(ABOT-ATOP)*XANX 2439.
2648     ATOP=ABOT 2440.
2649     VRD(N)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2441.
2650     O3A(N)=ASUM*S0COSZ 2442.
2651     IF(N.GT.1) GO TO 305 2443.
2652     C 2444.
2653     O3SUM=0. 2445.
2654     DO 324 I=1,NL 2446.
2655     324 O3SUM=O3SUM+ULGAS(I,3) 2447.
2656     SRXVIS=XANX*(1.-O3ABS(COSMAG*O3SUM)/0.53) 2448.
2657     SRTVIS=TANX+XANX-ASUM/DKS0K 2449.
2658     RGRND=UX/(XANX+DX+1.E-05) 2450.
2659     IF(RGRND.GT.1.0) RGRND=1.0 2451.
2660     ASUM=ASUM*RGRND 2452.
2661     VRU(N)=VRU(N)-ASUM*S0COSZ 2453.
2662     325 CONTINUE 2454.
2663     O3PATH=O3PATH+1.9*ULGAS(N,3) 2455.
2664     ATOP=O3ABS(O3PATH) 2456.
2665     ASUM=ASUM+(ATOP-ABOT)*FAC(N) 2457.
2666     ABOT=ATOP 2458.
2667     N=N+1 2459.
2668     VRU(N)=VRU(N)-ASUM*S0COSZ 2460.
2669     IF(N.LT.NLP) GO TO 325 2461.
2670     SRRVIS=RCNX-ASUM/DKS0K 2462.
2671     SRAVIS=1.0-SRRVIS-SRTVIS 2463.
2672     TFU=VRU(NLP) 2464.
2673     BFU=VRU(1) 2465.
2674     IF(BFU.GE.0.) GO TO 327 2466.
2675     DO 326 N=1,NLP 2467.
2676     326 VRU(N)=(VRU(N)-BFU)*(TFU/(TFU-BFU)) 2468.
2677     BFU=VRU(1) 2469.
2678     327 BFD=VRD(1) 2470.
2679     IF(BFD.GT.BFU) GO TO 329 2471.
2680     TFD=VRD(NLP) 2472.
2681     BFUD=BFU/TFD 2473.
2682     TFDD=TFD/(TFD-BFD) 2474.
2683     DO 328 N=1,NLP 2475.
2684     328 VRD(N)=(VRD(N)*(1.-BFUD)-BFD+BFUD*TFD)*TFDD 2476.
2685     329 SRDVIS=VRD(1) 2477.
2686     SRUVIS=VRU(1) 2478.
2687     ALBVIS=SRUVIS/(SRDVIS+1.E-10) 2479.
2688     TAU1=0. 2480.
2689     SRIVIS=VRD(NLP) 2481.
2690     SROVIS=VRU(NLP) 2482.
2691     PLAVIS=SROVIS/SRIVIS 2483.
2692     C 2484.
2693     TAU2=0. 2485.
2694     TAU3=0. 2486.
2695     TRN1=0. 2487.
2696     TRN2=0. 2488.
2697     TRN3=0. 2489.
2698     N=NLP 2490.
2699     C 2491.
2700     C THE FOLLOWING IS CONSIDERED PART OF THE NEAR-IR SPECTRUM 2492.
2701     C -------------------------------------------------------- 2493.
2702     DO 330 M=1,NL 2494.
2703     N=N-1 2495.
2704     PLN=PL(N) 2496.
2705     ULN=ULGAS(N,2)*SECZ 2497.
2706     ULX=ULN 2498.
2707     IF(ULN.GT.7.0) ULN=7.0 2499.
2708     C--------K=5-------CO2 DS0=.002 2500.
2709     TERMA=.003488*PLN*(1.+39.59*EXP(-8.769*ULN/(1.+4.419*ULN))) 2501.
2710     + *(1.+ULN*(.001938*PLN-.00503*ULN)) 2502.
2711     TERMB=(1.+.04712*PLN*(1.+.4877*ULN)) 2503.
2712     TAU=TERMA/TERMB 2504.
2713     IF(TAU.LT.1.E-06) TAU=1.E-06 2505.
2714     TAU1=TAU1+TAU*ULX 2506.
2715     ULN=ULGAS(N,1)*SECZ 2507.
2716     C--------K=7-------H2O DS0=.01(DS0=.008 + DS0=.002 CO2 OVERLAP) 2508.
2717     TERMA=.001582*PLN*(1.+6.769*EXP(-9.59*ULN/(1.+5.026*ULN))) 2509.
2718     + *(1.+ULN*(.2757E-03*PLN+.001429*ULN)) 2510.
2719     TERMB=(1.+.003683*PLN*(1.+1.187*ULN)) 2511.
2720     TAU2=TAU2+(TERMA/TERMB)*ULN 2512.
2721     ULN=ULGAS(N,4)*SECZ 2513.
2722     C--------K=5-------O2 DS0=.001 2514.
2723     TERMA=(.1366E-03-.2203E-07*TLN)*(1.+PLN*(.1497E-06*ULN+.001261)) 2515.
2724     TERMB=(1.+.3867E-03*ULN)/(1.+.2075E-04*ULN) 2516.
2725     TAU3=TAU3+(TERMA/TERMB)*ULN 2517.
2726     IF(TAU1.LT.10.0) TRN1=EXP(-TAU1) 2518.
2727     IF(TAU2.LT.10.0) TRN2=EXP(-TAU2) 2519.
2728     IF(TAU3.LT.10.0) TRN3=EXP(-TAU3) 2520.
2729     FAC(N)=.004358*TRN1+.01743*TRN2+.00218*TRN3 2521.
2730     330 SRDFLB(N)=SRDFLB(N)+SRDFLB(N)*FAC(N) 2522.
2731     FAC(NLP)=.023968 2523.
2732     SRDFLB(NLP)=SRDFLB(NLP)+SRDFLB(NLP)*FAC(NLP) 2524.
2733     DO 340 N=1,NLP 2525.
2734     340 SRUFLB(N)=SRUFLB(N)+SRUFLB(N)*FAC(1) 2526.
2735     SRINIR=SRDFLB(NLP) 2527.
2736     SRONIR=SRUFLB(NLP) 2528.
2737     PLANIR=SRONIR/SRINIR 2529.
2738     SRDNIR=SRDFLB(1) 2530.
2739     SRUNIR=SRUFLB(1) 2531.
2740     ALBNIR=SRUNIR/(SRDNIR+1.E-10) 2532.
2741     DO 350 N=1,NLP 2533.
2742     SRDFLB(N)=SRDFLB(N)+VRD(N) 2534.
2743     SRUFLB(N)=SRUFLB(N)+VRU(N) 2535.
2744     350 SRNFLB(N)=SRDFLB(N)-SRUFLB(N) 2536.
2745     DO 360 N=1,NL 2537.
2746     360 SRFHRL(N)=SRNFLB(N+1)-SRNFLB(N) 2538.
2747     SRSLHR=FRACSL*SRFHRL(1) 2539.
2748     C 2540.
2749     C--------------------------------- 2541.
2750     CALL O2HEAT(FAC,COSZ,S0COSZ) 2542.
2751     C--------------------------------- 2543.
2752     C 2544.
2753     DO 500 L=1,NL 2545.
2754     500 SRFHRL(L)=SRFHRL(L)+FAC(L) 2546.
2755     L=NLP 2547.
2756     DO 510 N=1,NL 2548.
2757     L=L-1 2549.
2758     IF(PLB(L).GT.0.09) GO TO 520 2550.
2759     510 SRFHRL(L)=FAC(L)+O3A(L) 2551.
2760     520 CONTINUE 2552.
2761     C I=NLP+1-II 2553.
2762     C 2554.
2763     C-----------------------------------------------------------------------2555.
2764     C SOLAR NET FLUX (SRNFLB(1)) DISTRIBUTION ACCORDING TO SURFACE TYPE 2556.
2765     CR NOT USED AND NOT SAFE (CAUSES DIVIDE CHECKS) 2556.1
2766     C-----------------------------------------------------------------------2557.
2767     CR FSRVIS=0.53 2558.
2768     CR FSRNIR=0.47 2559.
2769     C 2560.
2770     CR RASVIS=0. 2561.
2771     CR IF(SRUVIS.GT.1.E-03) RASVIS=(SRDVIS-SRTVIS*SRIVIS)/SRUVIS 2562.
2772     CR XXAVIS=0. 2563.
2773     CR DENOM=SRIVIS*(SRXALB(6)-SRBALB(6)) 2564.
2774     CR IF(ABS(DENOM).GT.1.E-03) XXAVIS=(SRUVIS-SRDVIS*SRBALB(6))/DENOM 2565.
2775     C$ PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.
2776     CR IF(SRIVIS.GT.1.E-03) PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.11
2777     CR RASNIR=0. 2567.
2778     CR IF(PNFVIS.LT.1.E-03) RETURN 2568.
2779     CR IF(SRUNIR.GT.1.E-03) RASNIR=(SRDNIR-SRTNIR*SRINIR)/SRUNIR 2569.
2780     CR XXANIR=0. 2570.
2781     CR DENOM=SRINIR*(SRXALB(5)-SRBALB(5)) 2571.
2782     CR IF(ABS(DENOM).GT.1.E-03) XXANIR=(SRUNIR-SRDNIR*SRBALB(5))/DENOM 2572.
2783     C$ PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.
2784     CR IF(SRINIR.GT.1.E-03) PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.11
2785     CR IF(PNFNIR.LT.1.E-03) RETURN 2574.
2786     C 2575.
2787     CR FNSROC=0. 2576.
2788     CR IF(POCEAN.LT.1.E-04) GO TO 601 2577.
2789     CR POCVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOCVIS,BOCVIS) 2578.
2790     CR POCNIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOCVIS,BOCVIS) 2579.
2791     CR FNSROC=(FSRVIS*POCVIS/PNFVIS+FSRNIR*POCNIR/PNFNIR) 2580.
2792     C 2581.
2793     CR601 FNSREA=0. 2582.
2794     CR IF(PEARTH.LT.1.E-04) GO TO 602 2583.
2795     CR PEAVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XEAVIS,BEAVIS) 2584.
2796     CR PEANIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XEANIR,BEANIR) 2585.
2797     CR FNSREA=(FSRVIS*PEAVIS/PNFVIS+FSRNIR*PEANIR/PNFNIR) 2586.
2798     C 2587.
2799     CR602 FNSROI=0. 2588.
2800     CR IF(POICE .LT.1.E-04) GO TO 603 2589.
2801     CR POIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOIVIS,BOIVIS) 2590.
2802     CR POINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOINIR,BOINIR) 2591.
2803     CR FNSROI=(FSRVIS*POIVIS/PNFVIS+FSRNIR*POINIR/PNFNIR) 2592.
2804     C 2593.
2805     CR603 FNSRLI=0. 2594.
2806     CR IF(PLICE .LT.1.E-04) GO TO 604 2595.
2807     CR PLIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XLIVIS,BLIVIS) 2596.
2808     CR PLINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XLINIR,BLINIR) 2597.
2809     CR FNSRLI=(FSRVIS*PLIVIS/PNFVIS+FSRNIR*PLINIR/PNFNIR) 2598.
2810     C 2599.
2811     CR604 FNORM=FNSROC*POCEAN+FNSREA*PEARTH+FNSROI*POICE+FNSRLI*PLICE 2600.
2812     C 2601.
2813     CR FSRNFG(1)=FNSROC/FNORM 2602.
2814     CR FSRNFG(2)=FNSREA/FNORM 2603.
2815     CR FSRNFG(3)=FNSROI/FNORM 2604.
2816     CR FSRNFG(4)=FNSRLI/FNORM 2605.
2817     C 2606.
2818     RETURN 2607.
2819     END 2608.
2820     SUBROUTINE SETAO2(O2CMA,NL) 2609.
2821     DIMENSION O2CMA(40),O2FHRL(40) 2610.
2822     DIMENSION SFWM2(18),SIGMA(18,6) 2611.
2823     DATA SFWM2/ 2612.
2824     A 2.196E-03, 0.817E-03, 1.163E-03, 1.331E-03, 1.735E-03, 1.310E-03,2613.
2825     B 1.311E-03, 2.584E-03, 2.864E-03, 4.162E-03, 5.044E-03, 6.922E-03,2614.
2826     C 6.906E-03,10.454E-03, 5.710E-03, 6.910E-03,14.130E-03,18.080E-03/2615.
2827     DATA SIGMA/ 2616.
2828     A 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2617.
2829     B 4.33E-21, 4.89E-21, 6.63E-21, 1.60E-20, 7.20E-20, 1.59E-18, 2618.
2830     C 2.10E-21, 2.32E-21, 3.02E-21, 6.30E-21, 3.46E-20, 7.52E-19, 2619.
2831     D 5.95E-22, 9.72E-22, 2.53E-21, 7.57E-21, 7.38E-20, 7.44E-19, 2620.
2832     E 3.33E-22, 1.02E-22, 4.09E-21, 1.63E-20, 8.79E-20, 3.81E-19, 2621.
2833     F 1.09E-21, 1.16E-21, 1.45E-21, 3.32E-21, 2.00E-20, 4.04E-19, 2622.
2834     G 1.15E-21, 1.30E-21, 1.90E-21, 4.89E-21, 2.62E-20, 4.08E-19, 2623.
2835     H 3.90E-22, 4.90E-22, 9.49E-22, 3.33E-21, 2.14E-20, 2.39E-19, 2624.
2836     I 1.29E-22, 2.18E-22, 8.28E-22, 3.46E-21, 1.94E-20, 1.06E-19, 2625.
2837     J 6.26E-23, 7.80E-23, 2.62E-22, 1.83E-21, 1.25E-20, 3.95E-20, 2626.
2838     K 2.74E-23, 3.58E-23, 8.64E-23, 4.03E-22, 2.13E-21, 1.95E-20, 2627.
2839     L 1.95E-23, 2.44E-23, 4.89E-23, 2.87E-22, 1.95E-21, 1.36E-20, 2628.
2840     M 1.84E-23, 1.96E-23, 2.71E-23, 8.52E-23, 6.48E-22, 3.89E-21, 2629.
2841     N 1.80E-23, 1.81E-23, 1.87E-23, 2.69E-23, 1.34E-22, 1.52E-21, 2630.
2842     O 1.80E-23, 1.80E-23, 1.82E-23, 2.40E-23, 5.71E-23, 5.70E-22, 2631.
2843     P 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 3.50E-23, 2632.
2844     Q 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 2.68E-23, 2633.
2845     R 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23/ 2634.
2846     REAL WTKO2(6)/0.05,0.20,0.25,0.25,0.20,0.05/ 2635.
2847     C 2636.
2848     DATA STPMOL/2.68714E+19/,S00/1367.0/ 2637.
2849     DATA NW/18/,NZ/11/,NKO2/6/ 2638.
2850     DIMENSION ZTABLE(40,11) 2639.
2851     DIMENSION ZCOSJ(11) 2640.
2852     NLP=NL+1 2641.
2853     FSUM=0.0 2642.
2854     DO 100 I=1,NW 2643.
2855     100 FSUM=FSUM+SFWM2(I) 2644.
2856     DO 110 J=1,NZ 2645.
2857     110 ZTABLE(NLP,J)=FSUM 2646.
2858     SUMMOL=0.0 2647.
2859     DO 150 N=1,NL 2648.
2860     L=NLP-N 2649.
2861     SUMMOL=SUMMOL+O2CMA(L)*STPMOL 2650.
2862     DO 140 J=1,NZ 2651.
2863     ZCOS=0.01*(1/J)+0.1*(J-1) 2652.
2864     ZCOSJ(J)=ZCOS 2653.
2865     FSUM=0.0 2654.
2866     DO 130 I=1,NW 2655.
2867     WSUM=0.0 2656.
2868     DO 120 K=1,NKO2 2657.
2869     TAU=SIGMA(I,K)*SUMMOL/ZCOS 2658.
2870     IF(TAU.GT.30.0) TAU=30.0 2659.
2871     120 WSUM=WSUM+WTKO2(K)*EXP(-TAU) 2660.
2872     130 FSUM=FSUM+WSUM*SFWM2(I) 2661.
2873     140 ZTABLE(L,J)=FSUM 2662.
2874     150 CONTINUE 2663.
2875     DO 170 J=1,NZ 2664.
2876     DO 160 L=1,NL 2665.
2877     160 ZTABLE(L,J)=ZTABLE(L+1,J)-ZTABLE(L,J) 2666.
2878     170 CONTINUE 2667.
2879     RETURN 2668.
2880     C 2669.
2881     C--------------------------------- 2670.
2882     ENTRY O2HEAT(O2FHRL,COSZ,S0) 2671.
2883     C--------------------------------- 2672.
2884     C 2673.
2885     ZCOS=1.0+10.0*COSZ 2674.
2886     JI=ZCOS 2675.
2887     IF(JI.GT.10) JI=10 2676.
2888     JJ=JI+1 2677.
2889     WTJ=ZCOS-JI 2678.
2890     WTI=1.0-WTJ 2679.
2891     DO 200 L=1,NLP-1 2680.
2892     200 O2FHRL(L)=(WTI*ZTABLE(L,JI)+WTJ*ZTABLE(L,JJ))*S0/S00 2681.
2893     RETURN 2682.
2894     END 2683.
2895     FUNCTION O3ABS(OCM) 2684.
2896     c DOUBLE PRECISION O3UVAB 2684.1
2897     DIMENSION AO3(460) 2685.
2898     C 2686.
2899     IP=0 2687.
2900     XX=OCM*1.E+04 2688.
2901     IX=XX 2689.
2902     IF(IX.GT.99) GO TO 110 2690.
2903     IF(IX.LT.1 ) GO TO 130 2691.
2904     GO TO 120 2692.
2905     110 IP=IP+90 2693.
2906     XX=XX*0.1 2694.
2907     IX=XX 2695.
2908     IF(IX.GT.99) GO TO 110 2696.
2909     120 DX=XX-IX 2697.
2910     IX=IX+IP 2698.
2911     O3ABS=AO3(IX)+DX*(AO3(IX+1)-AO3(IX)) 2699.
2912     RETURN 2700.
2913     130 O3ABS=XX*AO3(1) 2701.
2914     RETURN 2702.
2915     C 2703.
2916     C---------------------- 2704.
2917     ENTRY SETAO3(OCM) 2705.
2918     C---------------------- 2706.
2919     C 2707.
2920     ! print *,'After 2707'
2921     DO 140 I=1,460 2708.
2922     II=(I-10)/90-4 2709.
2923     XX=I-((I-10)/90)*90 2710.
2924     ! print *,i,ii,xx
2925     ! OCM=XX*10.**II 2711.
2926     ! 05/14/2006
2927     OCM=XX*10.**float(II)
2928     ! print *,ocm
2929     ! 05/14/2006
2930     140 AO3(I)=O3UVAB(OCM) 2712.
2931     ! print *,'After 2712'
2932     O3ABS=1. 2713.
2933     RETURN 2714.
2934     END 2715.
2935     FUNCTION O3UVAB(OCM) 2716.
2936     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 2717.
2937     c REAL OCM 2718.
2938     C-----------------------------------------------------------------------2719.
2939     C**** OZONE ABSORPTION COEFFICIENT DATA FROM HANDBOOK OF GEOPHYSICS 19612720.
2940     C**** T = -44 DEG CENTR. 2721.
2941     C-----------------------------------------------------------------------2722.
2942     DIMENSION X(226),F(226) 2723.
2943     DIMENSION OWMUV2(115),OWMUV3(111),OKEUV2(115),OKEUV3(111) 2724.
2944     EQUIVALENCE (X(1),OWMUV2(1)),(X(116),OWMUV3(1)), 2725.
2945     *(F(1),OKEUV2(1)),(F(116),OKEUV3(1)) 2726.
2946     DATA OWMUV2/.2002,.2012,.2022,.2032,.2042,.2052,.2062,.2072,.2082,2727.
2947     $.2092,.2102,.2112,.2122,.2132,.2142,.2152,.2162,.2172,.2182,.2192,2728.
2948     $.2202,.2212,.2222,.2232,.2242,.2252,.2262,.2272,.2282,.2292,.2302,2729.
2949     $.2312,.2322,.2332,.2342,.2352,.2362,.2372,.2382,.2392,.2400,.2402,2730.
2950     $.2412,.2422,.2432,.2438,.2444,.2452,.2458,.2463,.2472,.2478,.2482,2731.
2951     $.2490,.2492,.2500,.2508,.2519,.2527,.2539,.2543,.2553,.2562,.2566,2732.
2952     $.2571,.2575,.2579,.2587,.2597,.2604,.2617,.2624,.2635,.2643,.2650,2733.
2953     $.2654,.2662,.2669,.2675,.2682,.2692,.2695,.2702,.2712,.2718,.2722,2734.
2954     $.2732,.2742,.2746,.2752,.2762,.2772,.2782,.2792,.2802,.2812,.2822,2735.
2955     $.2830,.2842,.2852,.2862,.2872,.2882,.2892,.2902,.2912,.2922,.2932,2736.
2956     $.2942,.2952,.2962,.2972,.2982,.2992,.2998/ 2737.
2957     DATA OWMUV3/.3004,.3016,.3021,.3029,.3036,.3037,.3051,.3053,.3059,2738.
2958     $.3061,.3066,.3075,.3077,.3083,.3085,.3092,.3098,.3100,.3104,.3106,2739.
2959     $.3109,.3112,.3130,.3135,.3146,.3148,.3151,.3154,.3167,.3170,.3173,2740.
2960     $.3176,.3190,.3194,.3199,.3200,.3209,.3210,.3216,.3220,.3223,.3226,2741.
2961     $.3239,.3242,.3245,.3248,.3253,.3255,.3269,.3272,.3275,.3279,.3292,2742.
2962     $.3295,.3299,.3303,.3309,.3312,.3328,.3332,.3334,.3338,.3357,.3365,2743.
2963     $.3369,.3372,.3391,.3395,.3398,.3401,.3417,.3421,.3426,.3430,.3437,2744.
2964     $.3439,.3451,.3455,.3460,.3463,.3466,.3472,.3481,.3485,.3489,.3493,2745.
2965     $.3499,.3501,.3506,.3514,.3521,.3523,.3546,.3550,.3554,.3556,.3561,2746.
2966     $.3567,.3572,.3573,.3588,.3594,.3599,.3600,.3604,.3606,.3639,.3647,2747.
2967     $.3650,.3654,.3660/ 2748.
2968     DATA OKEUV2/ 8.3, 8.3, 8.1, 8.3, 8.6, 9.0, 9.7, 10.8, 11.7,2749.
2969     $ 13.0, 14.3, 16.0, 18.0, 20.6, 23.0, 26.1, 29.3, 32.6, 36.9, 40.8,2750.
2970     $ 46.9, 51.4, 56.7, 63.4, 69.1, 76.6, 84.0, 91.4, 99.9,110.0,118.0,2751.
2971     $126.0,136.0,145.0,154.0,164.0,175.0,186.0,192.0,201.0,210.0,212.0,2752.
2972     $221.0,230.0,239.0,248.0,250.0,259.0,264.0,264.0,273.0,277.0,275.0,2753.
2973     $283.0,283.0,290.0,283.0,297.0,290.0,300.0,290.0,302.0,295.0,283.0,2754.
2974     $293.0,290.0,286.0,297.0,281.0,280.0,271.0,275.0,254.0,264.0,250.0,2755.
2975     $248.0,242.0,228.0,230.0,216.0,213.0,211.0,199.0,188.0,188.0,178.0,2756.
2976     $169.0,153.0,155.0,148.0,136.0,127.0,117.0,108.0, 97.0, 88.7, 81.3,2757.
2977     $ 78.7, 67.9, 61.4, 54.3, 49.6, 43.1, 38.9, 34.6, 30.2, 27.5, 23.9,2758.
2978     $ 21.0, 18.6, 16.2, 14.2, 12.3, 10.7, 9.5/ 2759.
2979     DATA OKEUV3/8.880,7.520,6.960,6.160,5.810,5.910,4.310,4.430,4.130,2760.
2980     $4.310,4.020,3.330,3.390,3.060,3.100,2.830,2.400,2.490,2.330,2.320,2761.
2981     $2.120,2.200,1.436,1.595,1.074,1.138,1.068,1.262,0.818,0.948,0.860,2762.
2982     $1.001,0.543,0.763,0.665,0.781,0.382,0.406,0.373,0.608,0.484,0.601,2763.
2983     $0.209,0.276,0.259,0.470,0.319,0.354,0.131,0.223,0.185,0.339,0.080,2764.
2984     $0.093,0.079,0.184,0.139,0.214,0.053,0.074,0.068,0.152,0.038,0.070,2765.
2985     $.0540000,.1030000,.0240000,.0382500,.0292500,.0550000,.0135000, 2766.
2986     $.0155250,.0127500,.0188250,.0167250,.0262500,.0115500,.0140250, 2767.
2987     $.0099750,.0115500,.0081000,.0104250,.0050100,.0057000,.0046650, 2768.
2988     $.0073425,.0051825,.0055275,.0040575,.0077700,.0048900,.0054600, 2769.
2989     $.0015375,.0017775,.0013275,.0014100,.0011550,.0023325,.0018825, 2770.
2990     $.0019650,.0009600,.0013650,.0011925,.0013200,.0008925,.0009825, 2771.
2991     $.0001350,.0006300,.0004500,.0006225,0.0/ 2772.
2992     C 2773.
2993     C THEKAERAKA SOLAR FLUX 2774.
2994     C 2775.
2995     DIMENSION Y(190),H(190) 2776.
2996     DATA H/.007,.900,.007,.007,.030,.070,.230,.630,1.25,2.71,10.7,2777.
2997     1 22.9,57.5,64.9,66.7,59.3,63.0,72.3,70.4,104.,130.,185.,232.,204.,2778.
2998     2 222.,315.,482.,584.,514.,603.,689.,764.,830.,975.,1059.,1081.,2779.
2999     31074.,1069.,1093.,1083.,1068.,1132.,1181.,1157.,1120.,1098.,1098.,2780.
3000     41189.,1429.,1644.,1751.,1774.,1747.,1693.,1639.,1663.,1810.,1922.,2781.
3001     52006.,2057.,2066.,2048.,2033.,2044.,2074.,1976.,1950.,1960.,1942.,2782.
3002     61920.,1882.,1833.,1833.,1852.,1842.,1818.,1783.,1754.,1725.,1720.,2783.
3003     71695.,1705.,1712.,1719.,1715.,1712.,1700.,1682.,1666.,1647.,1635.,2784.
3004     81602.,1570.,1544.,1511.,1486.,1456.,1427.,1402.,1389.,1344.,1314.,2785.
3005     91290.,1260.,1235.,1211.,1185.,1159.,1134.,1109.,1085.,1060.,1036.,2786.
3006     A1013.,990.,968.,947.,926.,908.,891.,880.,869.,858.,847.,837.,820.,2787.
3007     B 803.,785.,767.,748.,668.,593.,535.,485.,438.,397.,358.,337.,312.,2788.
3008     C 288.,267.,245.,223.,202.,180.,159.,142.,126.,114.,103., 90., 79.,2789.
3009     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.
3010     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.
3011     F 4.11,3.79,1.82,0.99,.585,.367,.241,.165,.117,.0851,.0634,.0481/2792.
3012     DATA Y/.115,.120,.125,.130,.140,.150,.160,.170,.180,.190,.200,2793.
3013     1 .210,.220,.225,.230,.235,.240,.245,.250,.255,.260,.265,.270,.275,2794.
3014     2 .280,.285,.290,.295,.300,.305,.310,.315,.320,.325,.330,.335,2795.
3015     3 .340,.345,.350,.355,.360,.365,.370,.375,.380,.385,.390,2796.
3016     4 .395,.400,.405,.410,.415,.420,.425,.430,.435,.440,.445,2797.
3017     5 .450,.455,.460,.465,.470,.475,.480,.485,.490,.495,.500,2798.
3018     6 .505,.510,.515,.520,.525,.530,.535,.540,.545,.550,.555,2799.
3019     7 .560,.565,.570,.575,.580,.585,.590,.595,.600,.605,.610,2800.
3020     8 .620,.630,.640,.650,.660,.670,.680,.690,.700,.710,.720,2801.
3021     9 .730,.740,.750,.760,.770,.780,.790,.800,.810,.820,.830,2802.
3022     A .840,.850,.860,.870,.880,.890,.900,.910,.920,.930,.940,.950,.960,2803.
3023     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.
3024     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.
3025     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.
3026     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.
3027     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.
3028     NH=190 2809.
3029     NG=226 2810.
3030     XA=X(1) 2811.
3031     XB=X(NG) 2812.
3032     SOLCON=0.1353D0 2813.
3033     ABINT=0.D0 2814.
3034     X2=DMIN1(X(NG),Y(NH)) 2815.
3035     IF(XA.GE.X2) GO TO 160 2816.
3036     X1=DMAX1(X(1),Y(1)) 2817.
3037     IF(XB.LE.X1) GO TO 160 2818.
3038     YA=XA 2819.
3039     IF(XA.LT.X1) YA=X1 2820.
3040     YB=XB 2821.
3041     IF(YB.GT.X2) YB=X2 2822.
3042     DO 100 JG=2,NG 2823.
3043     XJ=X(JG) 2824.
3044     IF(XJ.GT.YA) GO TO 110 2825.
3045     100 CONTINUE 2825.1
3046     JG=NG+1 2825.2
3047     110 IG=JG-1 2826.
3048     XI=X(IG) 2827.
3049     TAU=F(IG)*OCM 2828.
3050     IF(TAU.GT.35.D0) TAU=35.D0 2829.
3051     GI=1.D0-DEXP(-TAU) 2830.
3052     TAU=F(JG)*OCM 2831.
3053     IF(TAU.GT.35.D0) TAU=35.D0 2832.
3054     GJ=1.D0-DEXP(-TAU) 2833.
3055     B=(GJ-GI)/(XJ-XI) 2834.
3056     A=GJ-B*XJ 2835.
3057     DO 120 JH=2,NH 2836.
3058     YJ=Y(JH) 2837.
3059     IF(YJ.GT.YA) GO TO 130 2838.
3060     120 CONTINUE 2838.1
3061     JH=NH+1 2838.2
3062     130 IH=JH-1 2839.
3063     YI=Y(IH) 2840.
3064     HI=H(IH)/10000.D0 2841.
3065     HJ=H(JH)/10000.D0 2842.
3066     D=(HJ-HI)/(YJ-YI) 2843.
3067     C=HJ-D*YJ 2844.
3068     X2=YA 2845.
3069     140 X1=X2 2846.
3070     X2=DMIN1(XJ,YJ) 2847.
3071     DELTA=(XJ-YJ)/(XJ+YJ) 2848.
3072     IF(X2.GT.YB) X2=YB 2849.
3073     DINT=(X2-X1)*(A*C+0.5D0*(B*C+A*D)*(X2+X1)+B*D*(X2*(X2+X1)+X1*X1)/ 2850.
3074     $3.D0) 2851.
3075     ABINT=ABINT+DINT 2852.
3076     IF(X2.GE.YB) GO TO 160 2853.
3077     IF(DELTA.GT.1.D-14) GO TO 150 2854.
3078     XI=XJ 2855.
3079     GI=GJ 2856.
3080     JG=JG+1 2857.
3081     XJ=X(JG) 2858.
3082     TAU=F(JG)*OCM 2859.
3083     IF(TAU.GT.35.D0) TAU=35.D0 2860.
3084     GJ=1.D0-DEXP(-TAU) 2861.
3085     B=(GJ-GI)/(XJ-XI) 2862.
3086     A=GJ-B*XJ 2863.
3087     IF(DABS(DELTA).LE.1.D-14) GO TO 150 2864.
3088     GO TO 140 2865.
3089     150 YI=YJ 2866.
3090     HI=HJ 2867.
3091     JH=JH+1 2868.
3092     YJ=Y(JH) 2869.
3093     HJ=H(JH)/10000.D0 2870.
3094     D=(HJ-HI)/(YJ-YI) 2871.
3095     C=HJ-D*YJ 2872.
3096     GO TO 140 2873.
3097     160 O3UVAB=ABINT/SOLCON 2874.
3098     RETURN 2875.
3099     END 2876.
3100     SUBROUTINE SETO3D 2877.
3101    
3102     #include "B83XX.COM"
3103    
3104     C-----------------------------------------------------------------------2915.
3105     C 2916.
3106     C LONDON ET AL (1976) JUL,1957-DEC,1970 NCAR ATLAS OF TOTAL OZONE2917.
3107     C 2918.
3108     C AVERAGE GLOBAL COLUMN AMOUNT -- O3AVE(MONTH,LATITUDE,LONGITUDE)2919.
3109     C 2920.
3110     C MONTH=1-12 JAN,FEB,...,DEC 2921.
3111     C LAT =1-18 -85,-75,..., 85 2922.
3112     C 2923.
3113     C-----------------------------------------------------------------------2924.
3114     REAL O3AVEA(216),O3AVEB(216),O3AVEC(216),O3AVED(216),O3AVEE(216) 2925.
3115     REAL O3AVEF(216),O3AVEG(216),O3AVEH(216),O3AVEI(216),O3AVEJ(216) 2926.
3116     REAL O3AVEK(216),O3AVEL(216),O3AVEM(216),O3AVEN(216),O3AVEO(216) 2927.
3117     REAL O3AVEP(216),O3AVEQ(216),O3AVER(216),O3AVE(12,18,18) 2928.
3118     EQUIVALENCE (O3AVE(1,1,10),O3AVEA(1)),(O3AVE(1,1,11),O3AVEB(1)) 2929.
3119     1 ,(O3AVE(1,1,12),O3AVEC(1)),(O3AVE(1,1,13),O3AVED(1)) 2930.
3120     2 ,(O3AVE(1,1,14),O3AVEE(1)),(O3AVE(1,1,15),O3AVEF(1)) 2931.
3121     3 ,(O3AVE(1,1,16),O3AVEG(1)),(O3AVE(1,1,17),O3AVEH(1)) 2932.
3122     4 ,(O3AVE(1,1,18),O3AVEI(1)),(O3AVE(1,1,01),O3AVEJ(1)) 2933.
3123     5 ,(O3AVE(1,1,02),O3AVEK(1)),(O3AVE(1,1,03),O3AVEL(1)) 2934.
3124     6 ,(O3AVE(1,1,04),O3AVEM(1)),(O3AVE(1,1,05),O3AVEN(1)) 2935.
3125     7 ,(O3AVE(1,1,06),O3AVEO(1)),(O3AVE(1,1,07),O3AVEP(1)) 2936.
3126     8 ,(O3AVE(1,1,08),O3AVEQ(1)),(O3AVE(1,1,09),O3AVER(1)) 2937.
3127     DATA O3AVEA/ 2938.
3128     A .317,.295,.291,.292,.293,.298,.300,.305,.313,.324,.369,.355, 2939.
3129     B .319,.300,.296,.292,.291,.300,.301,.304,.314,.322,.358,.350, 2940.
3130     C .312,.301,.295,.287,.286,.298,.302,.305,.316,.322,.343,.335, 2941.
3131     D .299,.291,.285,.280,.279,.290,.295,.300,.307,.319,.327,.316, 2942.
3132     E .281,.275,.279,.268,.266,.278,.282,.290,.295,.306,.306,.296, 2943.
3133     F .266,.261,.259,.256,.252,.261,.267,.277,.280,.289,.285,.277, 2944.
3134     G .252,.249,.248,.246,.240,.249,.252,.262,.264,.273,.265,.258, 2945.
3135     H .240,.238,.240,.242,.237,.242,.240,.249,.252,.258,.251,.245, 2946.
3136     I .232,.230,.238,.241,.240,.238,.234,.241,.241,.245,.239,.236, 2947.
3137     J .235,.235,.244,.252,.253,.244,.236,.237,.232,.230,.230,.232, 2948.
3138     K .249,.256,.264,.269,.267,.261,.245,.245,.238,.234,.233,.237, 2949.
3139     L .278,.289,.294,.300,.294,.284,.265,.265,.256,.249,.248,.261, 2950.
3140     M .318,.338,.343,.351,.342,.324,.300,.296,.287,.275,.279,.299, 2951.
3141     N .347,.368,.383,.383,.370,.351,.335,.319,.304,.288,.296,.321, 2952.
3142     O .364,.394,.418,.410,.402,.371,.358,.340,.312,.298,.302,.325, 2953.
3143     P .356,.388,.421,.414,.394,.360,.337,.319,.299,.285,.292,.313, 2954.
3144     Q .364,.403,.431,.426,.398,.358,.328,.303,.292,.287,.297,.324, 2955.
3145     R .373,.421,.447,.440,.408,.355,.323,.295,.289,.291,.305,.329/ 2956.
3146     DATA O3AVEB/ 2957.
3147     A .318,.295,.291,.293,.293,.299,.301,.305,.314,.326,.372,.358, 2958.
3148     B .321,.300,.295,.293,.291,.301,.301,.306,.314,.326,.361,.353, 2959.
3149     C .315,.302,.296,.291,.288,.300,.303,.306,.318,.328,.348,.340, 2960.
3150     D .307,.296,.291,.284,.278,.298,.299,.305,.314,.326,.335,.324, 2961.
3151     E .294,.285,.286,.272,.270,.286,.288,.296,.302,.315,.315,.304, 2962.
3152     F .278,.271,.265,.260,.258,.270,.273,.283,.287,.298,.293,.284, 2963.
3153     G .262,.259,.254,.250,.247,.255,.259,.268,.270,.282,.274,.266, 2964.
3154     H .247,.246,.244,.245,.239,.245,.247,.255,.255,.266,.257,.250, 2965.
3155     I .235,.235,.239,.244,.240,.238,.236,.244,.244,.249,.244,.239, 2966.
3156     J .233,.234,.243,.251,.249,.240,.234,.235,.232,.231,.231,.231, 2967.
3157     K .247,.254,.263,.267,.262,.253,.242,.240,.237,.232,.232,.237, 2968.
3158     L .279,.287,.296,.282,.286,.275,.260,.257,.253,.246,.246,.258, 2969.
3159     M .320,.336,.345,.348,.325,.309,.293,.282,.279,.267,.272,.294, 2970.
3160     N .346,.369,.379,.377,.348,.330,.317,.299,.286,.280,.288,.312, 2971.
3161     O .368,.406,.412,.401,.373,.345,.332,.312,.293,.284,.293,.316, 2972.
3162     P .366,.409,.423,.418,.386,.349,.326,.307,.290,.278,.295,.312, 2973.
3163     Q .366,.407,.428,.429,.396,.352,.323,.296,.287,.282,.298,.318, 2974.
3164     R .372,.420,.446,.441,.407,.352,.320,.292,.286,.290,.305,.327/ 2975.
3165     DATA O3AVEC/ 2976.
3166     A .319,.296,.292,.294,.294,.299,.302,.306,.316,.328,.372,.359, 2977.
3167     B .321,.300,.295,.297,.293,.303,.305,.309,.319,.332,.367,.359, 2978.
3168     C .322,.309,.302,.297,.293,.309,.309,.314,.326,.338,.362,.353, 2979.
3169     D .324,.313,.303,.294,.295,.314,.311,.318,.330,.342,.353,.343, 2980.
3170     E .315,.308,.296,.286,.287,.305,.306,.314,.326,.335,.338,.326, 2981.
3171     F .294,.290,.281,.271,.273,.287,.290,.299,.307,.319,.312,.303, 2982.
3172     G .274,.272,.264,.258,.258,.268,.272,.281,.286,.297,.290,.281, 2983.
3173     H .254,.254,.251,.248,.248,.254,.257,.263,.267,.276,.271,.262, 2984.
3174     I .240,.239,.241,.245,.241,.243,.244,.250,.251,.256,.250,.246, 2985.
3175     J .230,.231,.238,.249,.246,.237,.234,.233,.234,.233,.230,.228, 2986.
3176     K .238,.244,.251,.258,.253,.244,.236,.235,.233,.228,.228,.230, 2987.
3177     L .259,.269,.276,.279,.268,.254,.246,.241,.238,.235,.237,.246, 2988.
3178     M .289,.305,.312,.306,.289,.270,.261,.255,.249,.246,.252,.268, 2989.
3179     N .321,.347,.354,.343,.315,.291,.281,.273,.262,.259,.268,.285, 2990.
3180     O .351,.394,.396,.384,.353,.315,.300,.288,.275,.271,.282,.296, 2991.
3181     P .363,.414,.422,.415,.382,.333,.313,.292,.281,.276,.292,.306, 2992.
3182     Q .366,.415,.430,.433,.398,.346,.313,.288,.282,.280,.299,.317, 2993.
3183     R .372,.421,.445,.441,.406,.348,.316,.289,.285,.289,.306,.327/ 2994.
3184     DATA O3AVED/ 2995.
3185     A .320,.296,.293,.294,.295,.300,.303,.308,.317,.330,.374,.361, 2996.
3186     B .322,.300,.297,.299,.296,.307,.310,.314,.323,.339,.373,.366, 2997.
3187     C .329,.313,.310,.304,.302,.320,.318,.326,.338,.352,.373,.367, 2998.
3188     D .343,.330,.318,.306,.315,.333,.329,.337,.354,.366,.370,.366, 2999.
3189     E .334,.324,.311,.299,.312,.326,.329,.333,.352,.357,.354,.342, 3000.
3190     F .304,.300,.291,.279,.285,.302,.308,.315,.324,.328,.325,.312, 3001.
3191     G .277,.276,.268,.262,.266,.279,.283,.289,.296,.303,.299,.283, 3002.
3192     H .256,.257,.253,.249,.252,.259,.266,.269,.274,.278,.273,.263, 3003.
3193     I .242,.243,.243,.248,.247,.251,.255,.256,.258,.260,.253,.249, 3004.
3194     J .231,.234,.238,.250,.255,.251,.250,.246,.248,.244,.237,.229, 3005.
3195     K .235,.241,.248,.257,.259,.257,.248,.246,.245,.244,.233,.230, 3006.
3196     L .256,.261,.267,.270,.269,.262,.251,.247,.247,.248,.239,.248, 3007.
3197     M .293,.304,.306,.302,.288,.272,.259,.256,.256,.256,.254,.269, 3008.
3198     N .327,.344,.356,.346,.319,.291,.272,.270,.264,.267,.270,.285, 3009.
3199     O .356,.392,.402,.388,.359,.312,.289,.281,.276,.281,.285,.297, 3010.
3200     P .368,.416,.424,.415,.388,.328,.304,.285,.279,.284,.295,.309, 3011.
3201     Q .370,.418,.436,.436,.402,.338,.306,.283,.278,.284,.301,.320, 3012.
3202     R .373,.422,.446,.441,.407,.345,.312,.286,.275,.291,.307,.328/ 3013.
3203     DATA O3AVEE/ 3014.
3204     A .319,.295,.293,.295,.296,.300,.304,.309,.318,.332,.375,.362, 3015.
3205     B .325,.301,.300,.302,.300,.309,.313,.319,.328,.345,.378,.370, 3016.
3206     C .332,.314,.312,.310,.310,.327,.329,.335,.347,.362,.381,.375, 3017.
3207     D .348,.334,.324,.312,.328,.346,.366,.352,.372,.381,.377,.373, 3018.
3208     E .337,.327,.318,.303,.322,.335,.342,.347,.363,.366,.358,.344, 3019.
3209     F .301,.297,.292,.282,.291,.307,.314,.321,.331,.332,.324,.309, 3020.
3210     G .275,.271,.269,.264,.270,.279,.286,.292,.299,.301,.293,.281, 3021.
3211     H .255,.253,.252,.251,.253,.258,.265,.269,.275,.277,.268,.262, 3022.
3212     I .245,.244,.246,.250,.249,.253,.254,.257,.259,.260,.252,.249, 3023.
3213     J .240,.239,.245,.255,.256,.260,.256,.253,.253,.251,.243,.237, 3024.
3214     K .247,.248,.252,.263,.270,.268,.258,.256,.256,.252,.244,.238, 3025.
3215     L .263,.263,.268,.277,.282,.276,.261,.259,.259,.258,.251,.251, 3026.
3216     M .299,.304,.309,.309,.302,.291,.269,.266,.268,.269,.269,.275, 3027.
3217     N .346,.358,.365,.353,.335,.307,.276,.272,.276,.283,.289,.300, 3028.
3218     O .379,.400,.414,.401,.373,.319,.286,.280,.283,.293,.303,.314, 3029.
3219     P .382,.421,.437,.427,.398,.323,.293,.280,.280,.293,.308,.321, 3030.
3220     Q .375,.424,.444,.440,.405,.334,.298,.278,.276,.290,.306,.326, 3031.
3221     R .374,.424,.448,.443,.406,.345,.310,.284,.281,.292,.309,.328/ 3032.
3222     DATA O3AVEF/ 3033.
3223     A .318,.294,.294,.295,.298,.301,.304,.311,.320,.333,.377,.361, 3034.
3224     B .324,.298,.300,.304,.305,.310,.315,.323,.331,.348,.383,.371, 3035.
3225     C .337,.311,.314,.313,.317,.330,.333,.344,.354,.369,.386,.377, 3036.
3226     D .350,.330,.324,.317,.332,.349,.351,.362,.378,.390,.380,.372, 3037.
3227     E .333,.322,.314,.307,.323,.339,.345,.358,.369,.372,.357,.340, 3038.
3228     F .300,.292,.286,.284,.294,.307,.316,.327,.335,.334,.323,.307, 3039.
3229     G .275,.269,.264,.263,.269,.277,.285,.292,.300,.303,.290,.279, 3040.
3230     H .254,.251,.250,.251,.254,.256,.261,.267,.271,.276,.266,.261, 3041.
3231     I .243,.242,.242,.247,.248,.250,.247,.251,.252,.258,.253,.247, 3042.
3232     J .237,.239,.243,.253,.255,.255,.246,.243,.244,.245,.239,.236, 3043.
3233     K .246,.247,.253,.263,.265,.265,.253,.245,.247,.247,.239,.238, 3044.
3234     L .265,.265,.276,.283,.284,.280,.261,.254,.253,.258,.250,.250, 3045.
3235     M .306,.309,.321,.316,.318,.292,.273,.259,.265,.271,.273,.277, 3046.
3236     N .365,.369,.381,.363,.347,.313,.278,.264,.275,.290,.302,.307, 3047.
3237     O .396,.416,.431,.415,.405,.322,.282,.271,.288,.303,.321,.328, 3048.
3238     P .397,.433,.455,.436,.404,.322,.287,.273,.276,.302,.320,.333, 3049.
3239     Q .382,.429,.451,.442,.408,.331,.297,.274,.273,.295,.311,.333, 3050.
3240     R .375,.427,.450,.445,.407,.343,.309,.283,.280,.295,.311,.330/ 3051.
3241     DATA O3AVEG/ 3052.
3242     A .317,.293,.293,.295,.299,.299,.305,.311,.320,.335,.378,.360, 3053.
3243     B .323,.296,.300,.304,.306,.310,.317,.325,.334,.353,.385,.367, 3054.
3244     C .335,.307,.310,.312,.318,.328,.335,.347,.357,.376,.390,.372, 3055.
3245     D .346,.324,.320,.317,.332,.349,.354,.367,.384,.393,.384,.368, 3056.
3246     E .331,.318,.311,.305,.324,.339,.349,.365,.378,.377,.360,.339, 3057.
3247     F .301,.293,.286,.285,.296,.309,.321,.334,.344,.339,.325,.309, 3058.
3248     G .276,.270,.266,.267,.271,.280,.287,.295,.303,.308,.294,.282, 3059.
3249     H .257,.253,.250,.252,.254,.257,.261,.266,.271,.279,.268,.261, 3060.
3250     I .240,.241,.241,.246,.246,.250,.246,.249,.253,.259,.254,.248, 3061.
3251     J .234,.238,.245,.256,.258,.259,.244,.243,.241,.243,.237,.235, 3062.
3252     K .244,.249,.259,.271,.274,.274,.257,.251,.248,.248,.238,.237, 3063.
3253     L .270,.272,.289,.297,.298,.294,.277,.267,.260,.262,.251,.254, 3064.
3254     M .329,.338,.353,.338,.333,.313,.296,.275,.273,.282,.281,.296, 3065.
3255     N .401,.414,.424,.392,.369,.329,.298,.272,.282,.303,.321,.341, 3066.
3256     O .420,.451,.461,.432,.389,.331,.291,.272,.279,.313,.343,.358, 3067.
3257     P .411,.451,.468,.447,.403,.320,.289,.271,.277,.308,.334,.349, 3068.
3258     Q .386,.434,.456,.443,.404,.332,.297,.273,.273,.300,.317,.339, 3069.
3259     R .378,.430,.453,.446,.407,.342,.310,.282,.279,.296,.314,.332/ 3070.
3260     DATA O3AVEH/ 3071.
3261     A .315,.292,.293,.295,.299,.297,.303,.311,.320,.334,.378,.358, 3072.
3262     B .320,.294,.298,.303,.306,.308,.316,.325,.337,.355,.387,.362, 3073.
3263     C .330,.304,.307,.311,.315,.323,.334,.345,.360,.381,.389,.366, 3074.
3264     D .339,.318,.312,.314,.328,.344,.355,.368,.388,.401,.384,.360, 3075.
3265     E .325,.313,.302,.300,.318,.339,.354,.369,.381,.380,.360,.337, 3076.
3266     F .299,.291,.285,.284,.296,.313,.326,.340,.350,.343,.328,.312, 3077.
3267     G .277,.271,.269,.269,.272,.281,.288,.296,.308,.311,.298,.289, 3078.
3268     H .257,.253,.252,.254,.253,.257,.262,.267,.272,.281,.272,.265, 3079.
3269     I .241,.241,.241,.246,.245,.248,.246,.248,.253,.260,.255,.250, 3080.
3270     J .234,.236,.242,.256,.260,.260,.246,.244,.240,.241,.237,.237, 3081.
3271     K .243,.246,.257,.273,.279,.276,.261,.258,.251,.246,.238,.238, 3082.
3272     L .270,.269,.288,.299,.308,.299,.283,.276,.269,.263,.252,.257, 3083.
3273     M .327,.339,.358,.349,.351,.337,.313,.292,.288,.280,.284,.302, 3084.
3274     N .407,.419,.432,.407,.390,.356,.324,.298,.300,.304,.327,.368, 3085.
3275     O .421,.455,.459,.439,.393,.333,.306,.287,.289,.311,.345,.377, 3086.
3276     P .408,.452,.465,.443,.399,.323,.296,.276,.279,.309,.338,.362, 3087.
3277     Q .387,.437,.459,.444,.404,.334,.301,.276,.277,.302,.320,.345, 3088.
3278     R .379,.433,.455,.447,.408,.343,.313,.282,.279,.298,.315,.336/ 3089.
3279     DATA O3AVEI/ 3090.
3280     A .313,.291,.291,.293,.299,.296,.302,.310,.319,.333,.379,.354, 3091.
3281     B .316,.292,.295,.300,.307,.306,.315,.322,.333,.354,.384,.354, 3092.
3282     C .322,.302,.301,.307,.309,.319,.331,.340,.357,.379,.385,.356, 3093.
3283     D .328,.310,.301,.306,.316,.332,.347,.359,.380,.397,.379,.348, 3094.
3284     E .315,.304,.293,.296,.308,.328,.345,.360,.374,.376,.356,.329, 3095.
3285     F .292,.285,.277,.278,.288,.304,.318,.330,.340,.340,.324,.306, 3096.
3286     G .271,.266,.262,.263,.266,.277,.283,.291,.301,.307,.293,.284, 3097.
3287     H .253,.249,.249,.252,.250,.256,.261,.267,.271,.278,.267,.263, 3098.
3288     I .240,.238,.240,.247,.244,.248,.247,.250,.254,.258,.251,.249, 3099.
3289     J .233,.236,.243,.254,.259,.258,.248,.246,.241,.243,.238,.238, 3100.
3290     K .242,.246,.256,.268,.273,.271,.260,.255,.250,.244,.240,.239, 3101.
3291     L .258,.266,.278,.290,.295,.288,.277,.269,.265,.257,.253,.256, 3102.
3292     M .294,.308,.325,.326,.322,.308,.297,.284,.278,.271,.277,.287, 3103.
3293     N .338,.368,.383,.371,.357,.329,.316,.294,.287,.288,.303,.324, 3104.
3294     O .375,.420,.429,.411,.382,.328,.312,.293,.287,.299,.322,.354, 3105.
3295     P .388,.440,.454,.437,.396,.328,.307,.285,.282,.305,.330,.359, 3106.
3296     Q .386,.439,.457,.444,.404,.338,.309,.283,.280,.304,.321,.349, 3107.
3297     R .379,.435,.456,.448,.408,.345,.316,.286,.281,.300,.317,.337/ 3108.
3298     DATA O3AVEJ/ 3109.
3299     A .313,.290,.290,.291,.298,.294,.301,.309,.318,.331,.378,.353, 3110.
3300     B .313,.291,.291,.296,.304,.302,.311,.318,.330,.348,.382,.350, 3111.
3301     C .315,.297,.294,.300,.306,.310,.325,.334,.348,.364,.378,.346, 3112.
3302     D .316,.301,.292,.297,.305,.317,.334,.346,.360,.371,.366,.335, 3113.
3303     E .304,.293,.283,.286,.295,.313,.330,.344,.356,.359,.346,.316, 3114.
3304     F .284,.276,.268,.271,.279,.297,.309,.320,.325,.330,.317,.296, 3115.
3305     G .265,.258,.254,.257,.261,.273,.280,.288,.289,.296,.287,.274, 3116.
3306     H .250,.245,.244,.249,.247,.255,.260,.265,.268,.273,.263,.257, 3117.
3307     I .237,.235,.238,.246,.246,.249,.247,.249,.251,.257,.249,.247, 3118.
3308     J .234,.236,.245,.256,.259,.255,.248,.249,.244,.245,.242,.238, 3119.
3309     K .244,.249,.259,.271,.273,.270,.258,.256,.253,.247,.243,.242, 3120.
3310     L .261,.273,.283,.291,.292,.284,.271,.269,.263,.257,.254,.257, 3121.
3311     M .289,.305,.319,.321,.315,.301,.287,.281,.273,.268,.272,.282, 3122.
3312     N .321,.347,.364,.358,.344,.319,.305,.293,.282,.281,.291,.313, 3123.
3313     O .357,.400,.409,.397,.373,.332,.314,.295,.286,.293,.309,.333, 3124.
3314     P .377,.429,.442,.429,.396,.338,.317,.294,.287,.302,.321,.351, 3125.
3315     Q .385,.439,.458,.443,.407,.345,.318,.292,.284,.304,.322,.349, 3126.
3316     R .380,.437,.458,.449,.408,.348,.319,.289,.283,.301,.319,.340/ 3127.
3317     DATA O3AVEK/ 3128.
3318     A .311,.289,.289,.290,.298,.293,.300,.308,.317,.329,.377,.352, 3129.
3319     B .308,.290,.288,.291,.301,.296,.307,.315,.326,.340,.377,.344, 3130.
3320     C .305,.291,.287,.293,.297,.302,.315,.325,.335,.346,.369,.333, 3131.
3321     D .299,.289,.281,.287,.293,.302,.317,.327,.335,.344,.353,.318, 3132.
3322     E .287,.279,.272,.277,.281,.295,.309,.320,.325,.332,.331,.301, 3133.
3323     F .272,.264,.259,.262,.268,.281,.292,.300,.300,.309,.305,.282, 3134.
3324     G .257,.249,.246,.250,.254,.264,.271,.278,.279,.285,.278,.263, 3135.
3325     H .246,.239,.239,.245,.245,.252,.255,.261,.262,.267,.259,.250, 3136.
3326     I .234,.231,.239,.245,.245,.248,.245,.249,.248,.254,.246,.243, 3137.
3327     J .235,.237,.247,.258,.260,.257,.250,.250,.245,.246,.241,.240, 3138.
3328     K .248,.254,.264,.276,.276,.272,.262,.258,.255,.250,.248,.246, 3139.
3329     L .267,.278,.289,.300,.296,.286,.272,.270,.263,.258,.258,.262, 3140.
3330     M .292,.310,.325,.329,.319,.302,.288,.280,.273,.268,.274,.281, 3141.
3331     N .323,.346,.365,.365,.347,.320,.305,.291,.282,.281,.292,.305, 3142.
3332     O .352,.390,.405,.398,.378,.338,.316,.300,.290,.294,.309,.330, 3143.
3333     P .376,.424,.440,.431,.404,.350,.323,.303,.293,.303,.321,.349, 3144.
3334     Q .386,.442,.462,.448,.411,.354,.324,.298,.289,.306,.325,.349, 3145.
3335     R .381,.441,.459,.452,.410,.352,.322,.293,.286,.301,.320,.342/ 3146.
3336     DATA O3AVEL/ 3147.
3337     A .309,.290,.288,.288,.295,.292,.299,.307,.315,.327,.375,.350, 3148.
3338     B .306,.289,.287,.288,.298,.293,.304,.311,.320,.333,.372,.340, 3149.
3339     C .298,.286,.282,.288,.290,.294,.308,.316,.322,.332,.362,.325, 3150.
3340     D .289,.280,.274,.281,.282,.290,.304,.312,.317,.325,.342,.309, 3151.
3341     E .276,.269,.264,.268,.271,.281,.293,.300,.304,.313,.318,.290, 3152.
3342     F .262,.256,.253,.255,.258,.267,.278,.283,.283,.293,.294,.272, 3153.
3343     G .250,.245,.241,.245,.246,.255,.261,.267,.265,.282,.272,.256, 3154.
3344     H .240,.235,.236,.243,.240,.245,.249,.254,.253,.260,.254,.247, 3155.
3345     I .232,.229,.239,.245,.244,.247,.241,.245,.241,.246,.243,.241, 3156.
3346     J .235,.236,.247,.258,.258,.254,.246,.246,.239,.240,.238,.240, 3157.
3347     K .248,.253,.263,.273,.271,.267,.256,.253,.245,.243,.243,.244, 3158.
3348     L .265,.274,.287,.293,.290,.281,.267,.262,.256,.251,.253,.258, 3159.
3349     M .293,.307,.324,.323,.315,.298,.284,.275,.268,.263,.271,.278, 3160.
3350     N .326,.348,.370,.363,.347,.320,.304,.290,.281,.278,.291,.306, 3161.
3351     O .357,.391,.412,.404,.380,.347,.322,.303,.296,.296,.313,.334, 3162.
3352     P .381,.431,.447,.439,.412,.363,.331,.311,.301,.308,.331,.353, 3163.
3353     Q .389,.449,.470,.456,.417,.363,.329,.306,.296,.308,.331,.354, 3164.
3354     R .382,.441,.462,.454,.413,.354,.325,.296,.289,.301,.319,.343/ 3165.
3355     DATA O3AVEM/ 3166.
3356     A .309,.290,.288,.289,.293,.292,.299,.306,.313,.325,.374,.350, 3167.
3357     B .306,.289,.286,.285,.296,.291,.300,.308,.316,.326,.369,.339, 3168.
3358     C .297,.284,.281,.285,.288,.290,.302,.308,.315,.324,.355,.323, 3169.
3359     D .287,.278,.272,.275,.277,.284,.295,.300,.306,.316,.333,.304, 3170.
3360     E .273,.266,.261,.263,.267,.274,.284,.288,.292,.302,.311,.286, 3171.
3361     F .260,.253,.250,.252,.253,.261,.268,.273,.275,.284,.288,.269, 3172.
3362     G .247,.244,.241,.245,.243,.250,.254,.260,.260,.270,.268,.254, 3173.
3363     H .238,.234,.235,.242,.239,.243,.244,.250,.249,.255,.253,.245, 3174.
3364     I .231,.231,.238,.244,.242,.246,.238,.242,.239,.243,.242,.239, 3175.
3365     J .236,.238,.247,.257,.254,.253,.245,.244,.237,.235,.235,.236, 3176.
3366     K .250,.254,.263,.270,.266,.264,.254,.250,.244,.239,.237,.243, 3177.
3367     L .270,.279,.289,.290,.285,.279,.267,.261,.256,.250,.251,.258, 3178.
3368     M .301,.317,.329,.322,.314,.298,.285,.277,.270,.263,.270,.282, 3179.
3369     N .342,.367,.380,.369,.351,.326,.309,.294,.286,.284,.295,.314, 3180.
3370     O .380,.412,.424,.411,.388,.357,.331,.311,.303,.302,.325,.347, 3181.
3371     P .398,.448,.457,.449,.419,.373,.343,.318,.309,.314,.341,.366, 3182.
3372     Q .396,.456,.480,.466,.424,.370,.338,.311,.303,.311,.336,.363, 3183.
3373     R .384,.442,.464,.456,.414,.358,.327,.297,.290,.302,.322,.344/ 3184.
3374     DATA O3AVEN/ 3185.
3375     A .311,.291,.287,.288,.293,.292,.297,.305,.312,.325,.373,.350, 3186.
3376     B .307,.290,.286,.285,.293,.292,.300,.305,.315,.326,.366,.341, 3187.
3377     C .300,.287,.283,.282,.288,.292,.300,.306,.313,.324,.351,.323, 3188.
3378     D .290,.281,.274,.276,.279,.285,.293,.298,.303,.315,.330,.308, 3189.
3379     E .276,.272,.265,.264,.267,.274,.281,.287,.288,.302,.309,.289, 3190.
3380     F .263,.259,.254,.253,.257,.262,.267,.272,.274,.285,.287,.273, 3191.
3381     G .252,.247,.244,.248,.247,.252,.254,.260,.262,.270,.268,.259, 3192.
3382     H .243,.238,.239,.244,.241,.245,.245,.251,.251,.257,.253,.249, 3193.
3383     I .236,.233,.238,.244,.244,.246,.238,.243,.242,.245,.243,.242, 3194.
3384     J .237,.241,.247,.256,.255,.254,.245,.245,.242,.234,.234,.236, 3195.
3385     K .252,.259,.266,.271,.269,.269,.257,.256,.251,.242,.240,.245, 3196.
3386     L .277,.286,.296,.298,.292,.290,.276,.275,.267,.259,.259,.267, 3197.
3387     M .323,.342,.352,.339,.333,.319,.303,.298,.288,.280,.285,.296, 3198.
3388     N .374,.403,.413,.392,.376,.351,.332,.319,.306,.303,.317,.340, 3199.
3389     O .408,.448,.448,.433,.410,.375,.351,.330,.317,.318,.343,.368, 3200.
3390     P .418,.467,.473,.464,.426,.383,.347,.328,.316,.319,.347,.376, 3201.
3391     Q .402,.459,.482,.474,.426,.374,.343,.313,.306,.313,.338,.368, 3202.
3392     R .384,.440,.463,.458,.415,.360,.328,.299,.291,.301,.319,.344/ 3203.
3393     DATA O3AVEO/ 3204.
3394     A .313,.291,.288,.288,.292,.292,.298,.305,.312,.324,.364,.351, 3205.
3395     B .311,.294,.289,.286,.294,.293,.302,.306,.316,.326,.358,.345, 3206.
3396     C .308,.296,.291,.286,.294,.297,.303,.310,.316,.330,.354,.331, 3207.
3397     D .301,.292,.284,.282,.286,.295,.301,.307,.310,.326,.334,.318, 3208.
3398     E .290,.283,.274,.273,.276,.286,.291,.297,.299,.314,.314,.302, 3209.
3399     F .280,.272,.266,.263,.264,.272,.277,.283,.286,.297,.295,.286, 3210.
3400     G .267,.261,.256,.254,.255,.260,.263,.268,.272,.280,.276,.271, 3211.
3401     H .254,.250,.249,.249,.247,.251,.251,.256,.259,.264,.261,.258, 3212.
3402     I .242,.242,.243,.245,.244,.248,.242,.247,.248,.252,.248,.248, 3213.
3403     J .237,.242,.249,.256,.255,.255,.245,.244,.243,.237,.236,.236, 3214.
3404     K .253,.256,.267,.271,.270,.270,.259,.258,.252,.245,.242,.248, 3215.
3405     L .279,.283,.296,.296,.294,.292,.280,.279,.269,.260,.260,.268, 3216.
3406     M .327,.339,.357,.345,.338,.328,.319,.309,.293,.284,.285,.302, 3217.
3407     N .386,.409,.421,.405,.388,.363,.346,.332,.314,.311,.319,.348, 3218.
3408     O .419,.450,.459,.445,.418,.384,.361,.338,.322,.320,.340,.373, 3219.
3409     P .419,.461,.473,.468,.423,.358,.358,.331,.316,.319,.343,.376, 3220.
3410     Q .401,.453,.477,.469,.423,.375,.345,.314,.307,.312,.333,.361, 3221.
3411     R .382,.437,.461,.455,.415,.361,.329,.299,.291,.301,.316,.341/ 3222.
3412     DATA O3AVEP/ 3223.
3413     A .314,.293,.289,.290,.292,.294,.299,.305,.312,.323,.363,.352, 3224.
3414     B .315,.298,.293,.290,.294,.299,.303,.307,.316,.324,.365,.350, 3225.
3415     C .315,.303,.296,.291,.300,.306,.311,.316,.323,.336,.360,.341, 3226.
3416     D .308,.301,.293,.291,.297,.308,.312,.318,.324,.337,.345,.329, 3227.
3417     E .299,.292,.284,.283,.285,.299,.306,.311,.317,.326,.327,.314, 3228.
3418     F .285,.280,.272,.272,.274,.284,.293,.296,.301,.308,.306,.297, 3229.
3419     G .272,.266,.262,.261,.262,.269,.275,.280,.283,.289,.284,.280, 3230.
3420     H .256,.253,.251,.251,.251,.255,.256,.264,.266,.271,.267,.263, 3231.
3421     I .241,.242,.244,.245,.245,.248,.245,.251,.251,.255,.252,.251, 3232.
3422     J .236,.239,.247,.253,.253,.251,.242,.244,.239,.237,.235,.236, 3233.
3423     K .248,.250,.262,.267,.264,.262,.254,.250,.244,.240,.235,.239, 3234.
3424     L .268,.270,.286,.287,.284,.278,.267,.264,.256,.250,.245,.256, 3235.
3425     M .301,.308,.329,.322,.317,.300,.297,.281,.272,.264,.263,.279, 3236.
3426     N .351,.362,.380,.372,.360,.337,.320,.305,.295,.285,.287,.316, 3237.
3427     O .383,.406,.427,.415,.391,.365,.345,.324,.310,.304,.310,.342, 3238.
3428     P .393,.428,.450,.441,.404,.373,.353,.324,.310,.310,.321,.356, 3239.
3429     Q .387,.435,.461,.456,.412,.370,.341,.313,.303,.306,.321,.353, 3240.
3430     R .381,.432,.457,.452,.413,.361,.328,.299,.291,.298,.314,.338/ 3241.
3431     DATA O3AVEQ/ 3242.
3432     A .315,.293,.289,.291,.293,.295,.298,.305,.312,.323,.362,.354, 3243.
3433     B .316,.301,.295,.291,.294,.300,.303,.307,.316,.322,.361,.350, 3244.
3434     C .318,.305,.297,.292,.298,.306,.311,.314,.324,.334,.354,.340, 3245.
3435     D .309,.301,.292,.289,.295,.305,.312,.317,.326,.335,.343,.326, 3246.
3436     E .295,.288,.279,.279,.284,.297,.305,.305,.316,.321,.324,.310, 3247.
3437     F .279,.272,.266,.269,.272,.281,.289,.291,.299,.303,.305,.293, 3248.
3438     G .263,.259,.254,.257,.259,.266,.273,.276,.281,.285,.284,.277, 3249.
3439     H .247,.246,.244,.248,.247,.252,.253,.261,.265,.269,.267,.259, 3250.
3440     I .235,.236,.239,.244,.243,.246,.243,.247,.251,.253,.249,.246, 3251.
3441     J .231,.234,.243,.250,.251,.247,.240,.238,.233,.234,.232,.233, 3252.
3442     K .242,.244,.257,.262,.260,.255,.247,.243,.235,.235,.228,.233, 3253.
3443     L .257,.263,.278,.280,.275,.269,.258,.252,.242,.239,.235,.243, 3254.
3444     M .280,.288,.308,.307,.299,.287,.274,.267,.255,.250,.246,.259, 3255.
3445     N .309,.319,.348,.340,.332,.309,.293,.286,.273,.264,.261,.282, 3256.
3446     O .339,.357,.388,.376,.360,.334,.320,.305,.289,.282,.279,.306, 3257.
3447     P .365,.393,.424,.411,.386,.355,.340,.316,.300,.303,.297,.329, 3258.
3448     Q .375,.415,.445,.439,.404,.365,.336,.310,.298,.299,.306,.338, 3259.
3449     R .379,.428,.453,.447,.412,.360,.326,.298,.291,.296,.310,.335/ 3260.
3450     DATA O3AVER/ 3261.
3451     A .316,.295,.291,.292,.292,.296,.299,.305,.313,.323,.361,.355, 3262.
3452     B .317,.301,.296,.292,.292,.300,.302,.305,.314,.319,.358,.348, 3263.
3453     C .316,.303,.295,.289,.291,.301,.306,.307,.317,.324,.348,.336, 3264.
3454     D .303,.294,.286,.283,.285,.296,.304,.304,.313,.322,.333,.318, 3265.
3455     E .283,.277,.272,.272,.273,.284,.290,.296,.302,.309,.314,.299, 3266.
3456     F .265,.262,.259,.259,.259,.268,.274,.282,.286,.293,.293,.279, 3267.
3457     G .252,.249,.248,.249,.247,.253,.258,.265,.272,.277,.273,.265, 3268.
3458     H .241,.238,.240,.242,.241,.244,.246,.252,.257,.260,.256,.249, 3269.
3459     I .231,.229,.238,.241,.241,.242,.237,.242,.244,.247,.242,.239, 3270.
3460     J .231,.233,.242,.249,.251,.246,.237,.235,.230,.230,.229,.230, 3271.
3461     K .241,.250,.257,.265,.262,.257,.245,.243,.234,.230,.229,.231, 3272.
3462     L .260,.273,.281,.285,.280,.272,.257,.256,.245,.238,.237,.245, 3273.
3463     M .285,.302,.312,.314,.305,.294,.278,.277,.262,.252,.251,.262, 3274.
3464     N .310,.331,.347,.346,.336,.320,.303,.298,.281,.267,.267,.283, 3275.
3465     O .331,.354,.383,.378,.364,.342,.324,.315,.293,.278,.279,.297, 3276.
3466     P .350,.379,.414,.398,.381,.343,.335,.317,.299,.287,.285,.311, 3277.
3467     Q .367,.404,.436,.428,.399,.361,.332,.307,.295,.293,.298,.327, 3278.
3468     R .376,.424,.450,.442,.409,.358,.326,.296,.290,.294,.306,.332/ 3279.
3469     C 3280.
3470     DIMENSION AO3AVE(18,12),SO3JF(11,19),SO3SO(11,19) 3281.
3471     DATA AO3AVE/ .3148,.3160,.3171,.3159,.3027,.2824,.2645,3282.
3472     A.2493,.2376,.2344,.2455,.2667,.3038,.3467,.3753,.3842,.3817,.3780,3283.
3473     B.2926,.2959,.3008,.3035,.2943,.2763,.2600,.2463,.2366,.2366,.2500,3284.
3474     C.2735,.3166,.3661,.4076,.4270,.4310,.4309,.2904,.2937,.2974,.2959,3285.
3475     D.2869,.2704,.2561,.2454,.2403,.2443,.2590,.2844,.3293,.3803,.4210,3286.
3476     E.4439,.4534,.4539,.2918,.2943,.2965,.2940,.2834,.2687,.2561,.2476,3287.
3477     F.2450,.2538,.2676,.2888,.3259,.3692,.4077,.4325,.4454,.4476,.2951,3288.
3478     G.2979,.2994,.3001,.2904,.2731,.2575,.2467,.2441,.2548,.2675,.2873,3289.
3479     H.3181,.3517,.3828,.4002,.4080,.4096,.2960,.3012,.3084,.3132,.3044,3290.
3480     I.2852,.2660,.2515,.2465,.2521,.2641,.2802,.3023,.3257,.3417,.3457,3291.
3481     J.3521,.3517,.3008,.3070,.3153,.3211,.3127,.2934,.2714,.2545,.2437,3292.
3482     K.2440,.2528,.2665,.2875,.3064,.3191,.3222,.3210,.3201,.3074,.3126,3293.
3483     L.3221,.3276,.3211,.3015,.2783,.2603,.2478,.2431,.2499,.2624,.2784,3294.
3484     M.2928,.3024,.3017,.2954,.2914,.3156,.3224,.3326,.3391,.3300,.3071,3295.
3485     N.2827,.2632,.2489,.2399,.2455,.2566,.2720,.2854,.2939,.2931,.2889,3296.
3486     O.2854,.3282,.3354,.3456,.3504,.3368,.3124,.2899,.2692,.2532,.2389,3297.
3487     P.2415,.2521,.2672,.2844,.2967,.3003,.2986,.2966,.3723,.3713,.3661,3298.
3488     Q.3538,.3332,.3072,.2826,.2626,.2481,.2359,.2373,.2489,.2700,.2936,3299.
3489     R.3113,.3172,.3154,.3130,.3554,.3533,.3467,.3353,.3146,.2925,.2723,3300.
3490     S.2562,.2450,.2350,.2387,.2554,.2828,.3140,.3331,.3406,.3408,.3351/3301.
3491     C 3302.
3492     DATA SO3JF/ 3303.
3493     A 13.0,12.3,11.7,10.5,8.90,6.20,4.50,3.30,2.20,1.80,1.00, 3304.
3494     B 13.6,12.9,11.9,10.3,8.30,6.10,4.45,3.40,2.50,1.85,1.00, 3305.
3495     C 14.8,13.9,12.8,10.3,8.00,6.00,4.55,3.60,2.70,1.90,1.00, 3306.
3496     D 16.6,15.1,14.0,11.0,7.95,6.00,4.65,3.70,2.95,1.95,1.00, 3307.
3497     E 18.1,16.0,14.6,12.0,8.00,6.00,4.80,3.75,3.00,1.98,1.00, 3308.
3498     F 18.3,16.3,14.8,12.6,8.20,6.15,4.80,3.80,3.05,2.00,1.00, 3309.
3499     G 17.3,16.1,14.7,12.7,9.10,6.10,4.70,3.75,3.00,2.00,1.00, 3310.
3500     H 16.3,15.5,14.5,12.6,9.00,6.00,4.55,3.65,2.95,1.98,1.00, 3311.
3501     I 15.7,14.9,14.1,12.4,8.70,5.90,4.40,3.45,2.80,1.96,1.00, 3312.
3502     J 15.3,14.1,13.5,12.2,8.30,5.85,4.25,3.40,2.75,1.95,1.00, 3313.
3503     K 15.6,14.9,14.0,12.4,9.00,6.10,4.55,3.50,2.85,1.96,1.00, 3314.
3504     L 17.4,16.6,16.0,14.0,10.0,7.30,5.10,3.90,3.00,1.97,1.00, 3315.
3505     M 17.6,18.3,17.8,15.8,12.3,9.00,6.05,4.40,3.20,1.97,1.00, 3316.
3506     N 16.0,16.9,17.8,16.8,15.2,12.0,7.90,5.10,3.65,1.97,1.00, 3317.
3507     O 12.3,13.8,15.7,16.2,16.2,14.8,10.0,6.00,4.00,1.96,1.00, 3318.
3508     P 12.0,11.9,12.0,13.8,14.3,14.3,12.0,6.80,4.30,1.95,1.00, 3319.
3509     Q 11.9,11.8,11.7,11.6,11.8,12.0,10.3,7.20,4.50,1.90,1.00, 3320.
3510     R 11.6,11.5,11.4,11.2,11.0,10.4,9.00,7.20,4.15,1.85,1.00, 3321.
3511     S 11.2,10.9,10.7,10.5,10.0,9.75,8.60,7.00,3.80,1.80,1.00/ 3322.
3512     DATA SO3SO/ 3323.
3513     A 10.5,10.5,10.5,10.6,10.5,10.3,8.20,4.80,3.10,1.90,1.00, 3324.
3514     B 11.5,11.5,11.6,12.1,12.1,10.8,8.05,4.95,3.40,1.92,1.00, 3325.
3515     C 12.7,13.8,14.0,14.1,12.9,10.9,7.95,5.10,3.70,1.96,1.00, 3326.
3516     D 15.4,15.9,16.0,15.4,13.2,10.7,7.40,5.15,3.85,1.98,1.00, 3327.
3517     E 17.9,18.0,17.4,16.1,13.0,10.0,6.70,4.90,3.80,1.99,1.00, 3328.
3518     F 18.3,18.6,17.8,16.1,12.1,9.10,5.95,4.80,3.70,2.00,1.00, 3329.
3519     G 18.6,18.5,17.8,15.9,11.1,8.00,5.55,4.40,3.45,2.00,1.00, 3330.
3520     H 18.2,18.1,17.2,15.1,10.3,7.40,5.10,4.00,3.10,1.99,1.00, 3331.
3521     I 17.5,16.8,16.2,14.0,9.90,7.00,4.90,3.85,2.95,1.98,1.00, 3332.
3522     J 16.5,15.8,15.0,12.9,9.40,6.65,4.80,3.70,2.90,1.96,1.00, 3333.
3523     K 16.3,15.8,15.0,12.9,9.20,6.80,5.00,3.85,2.95,1.96,1.00, 3334.
3524     L 16.4,16.2,15.8,14.0,9.80,7.10,5.10,3.95,3.00,1.96,1.00, 3335.
3525     M 16.6,16.5,16.2,14.8,10.8,7.75,5.50,4.05,3.05,1.97,1.00, 3336.
3526     N 16.5,16.6,16.5,16.0,12.1,9.00,6.00,4.40,3.10,1.97,1.00, 3337.
3527     O 15.8,16.2,16.4,16.1,14.2,10.9,6.60,4.50,3.20,1.97,1.00, 3338.
3528     P 12.2,14.2,15.5,15.3,14.7,12.4,7.40,4.70,3.10,1.96,1.00, 3339.
3529     Q 11.6,11.9,12.1,14.0,13.9,12.3,8.00,4.40,2.95,1.90,1.00, 3340.
3530     R 11.2,11.2,11.4,11.6,11.8,10.9,8.00,3.95,2.60,1.87,1.00, 3341.
3531     S 11.0,10.8,10.5,10.3,10.1,9.70,7.00,3.65,2.20,1.80,1.00/ 3342.
3532     C 3343.
3533     DIMENSION XJDMO(14),HKMSPR(14),HKMAUT(14) 3344.
3534     DIMENSION CNCAUT(14),CNCSPR(14),DEGLAT(14) 3345.
3535     DATA DEGLAT/-85.0,-71.0,-59.0,-47.0,-35.0,-22.0,-9.0, 3346.
3536     + 9.0,22.0,35.0,47.0,59.0,71.0,85.0/ 3347.
3537     DATA XJDMO/-15.0,16.0,45.0,75.0,105.0,136.0,166.0,197.0,228.0 3348.
3538     + ,258.0,289.0,319.0,350.0,381.0/ 3349.
3539     DATA HKMSPR/18.5,18.5,19.0,23.5,24.0,24.5,26.5, 3350.
3540     + 26.5,25.0,22.5,21.0,20.0,18.5,16.5/ 3351.
3541     DATA HKMAUT/16.5,18.5,20.0,21.0,22.5,25.0,26.5, 3352.
3542     + 26.5,24.5,24.0,23.5,19.0,18.5,18.5/ 3353.
3543     DATA CNCSPR/0.0181,0.0212,0.0187,0.0167,0.0162,0.0183,0.0175, 3354.
3544     + 0.0187,0.0200,0.0196,0.0225,0.0291,0.0287,0.0300/ 3355.
3545     DATA CNCAUT/0.0300,0.0287,0.0291,0.0225,0.0196,0.0200,0.0187, 3356.
3546     + 0.0175,0.0183,0.0162,0.0167,0.0187,0.0212,0.0181/ 3357.
3547     C 3358.
3548     DIMENSION PLBSO3(11),SOJDAY(6),PMLAT(6) 3359.
3549     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.
3550     DATA SOJDAY/-91.,31.,92.,213.,274.,396./ 3361.
3551     DATA PMLAT/1.,1.,-1.,-1.,1.,1./ 3362.
3552     DIMENSION AO3JIM(144),O3LB(40),PLB0(40) 3363.
3553     DIMENSION CONCS(144),CONCA(144),BHKMS(144),BHKMA(144) 3364.
3554     DIMENSION WTJLAT(144),WTJLON(144),ILATIJ(144),ILONIJ(144) 3365.
3555     DIMENSION WTLSEP(144),WTLJAN(144),LSEPJ(144),LJANJ(144) 3366.
3556     DATA ACMMGG/2.37251E-4/,ACMPKM/7.1509E-4/,H10MB/31.05467/ 3367.
3557     DATA A,B,C,D/0.331,23.0,4.553,5.23/ 3368.
3558     LOGICAL SKIPI 3369.
3559     C 3370.
3560     C-----------------------------------------------------------------------3371.
3561     C----SET O3 VERTICAL PROFILE PARAMETERS FOR LATITUDE GCM GRID POINTS 3372.
3562     C-----------------------------------------------------------------------3373.
3563     SKIPI =.FALSE. 3374.
3564     IF(ABS(FLONO3).LT.1.E-04) SKIPI =.TRUE. 3375.
3565     DO 100 L=1,NL 3376.
3566     100 PLB0(L)=PLB(L) 3377.
3567     DO 103 J=1,JMLAT 3378.
3568     DLATJ=DLAT(J) 3379.
3569     ILATI=(DLATJ+95.001)/10. 3380.
3570     IF(ILATI.LT. 1) ILATI= 1 3381.
3571     IF(ILATI.GT.17) ILATI=17 3382.
3572     ILATIJ(J)=ILATI 3383.
3573     LATD=ILATI*10-95 3384.
3574     WTJL=(DLATJ-LATD)*0.1 3385.
3575     WTJLAT(J)=WTJL 3386.
3576     DO 101 JJ=2,14 3387.
3577     II=JJ-1 3388.
3578     IF(DLATJ.LE.DEGLAT(JJ)) GO TO 102 3389.
3579     101 CONTINUE 3389.1
3580     JJ=14 3390.
3581     102 WTJJ=(DLATJ-DEGLAT(II))/(DEGLAT(JJ)-DEGLAT(II)) 3391.
3582     WTII=1.-WTJJ 3392.
3583     CONCS(J)=WTII*CNCSPR(II)+WTJJ*CNCSPR(JJ) 3393.
3584     CONCA(J)=WTII*CNCAUT(II)+WTJJ*CNCAUT(JJ) 3394.
3585     BHKMS(J)=WTII*HKMSPR(II)+WTJJ*HKMSPR(JJ) 3395.
3586     103 BHKMA(J)=WTII*HKMAUT(II)+WTJJ*HKMAUT(JJ) 3396.
3587     C 3397.
3588     DO 104 I=1,IMLON 3398.
3589     DLONI=DLON(I) 3399.
3590     ILONG=DLONI/20.0 3400.
3591     WTJLG=(DLONI-ILONG*20)/20.0 3401.
3592     WTJLON(I)=WTJLG 3402.
3593     WTILG=1.-WTJLG 3403.
3594     ILONG=ILONG+1 3404.
3595     JLONG=ILONG+1 3405.
3596     IF(ILONG.GT.18) ILONG=18 3406.
3597     IF(ILONG.GT.17) JLONG=1 3407.
3598     104 ILONIJ(I)=ILONG 3408.
3599     NLAY=LASTVC/100000 3409.
3600     NATM=(LASTVC-NLAY*100000)/10000 3410.
3601     IF(NATM.GT.0) GO TO 106 3411.
3602     C 3412.
3603     O3B=0.343 3413.
3604     DO 105 L=1,NL 3414.
3605     HLT=HLB(L+1) 3415.
3606     O3T=A*(1.0+EXP(-B/C))/(1.0+EXP((HLT-B)/C))+(0.343-A)*EXP(-HLT/D) 3416.
3607     U0GAS(L,3)=(O3B-O3T) 3417.
3608     105 O3B=O3T 3418.
3609     C 3419.
3610     106 AO3J=0.0 3420.
3611     RETURN 3421.
3612     C-----------------------------------------------------------------------3422.
3613     ENTRY O3DDAY 3423.
3614     C-----------------------------------------------------------------------3424.
3615     XJDAY=JDAY 3425.
3616     WTAUT=(XJDAY-91.)/213. 3426.
3617     IF(XJDAY.LT. 91.) WTAUT=( 91.-XJDAY)/152. 3427.
3618     IF(XJDAY.GT.304.) WTAUT=(456.-XJDAY)/152. 3428.
3619     WTSPR=1.-WTAUT 3429.
3620     DO 200 JMO=1,14 3430.
3621     XJDMJ=XJDMO(JMO) 3431.
3622     IF(XJDAY.LT.XJDMJ) GO TO 201 3432.
3623     200 XJDMI=XJDMJ 3433.
3624     XJDMI=XJDMO(13) 3434.
3625     201 DAYMO=XJDMJ-XJDMI 3435.
3626     WTJM=(XJDAY-XJDMI)/DAYMO 3436.
3627     WTIM=1.-WTJM 3437.
3628     JMO=JMO-1 3438.
3629     IMO=JMO-1 3439.
3630     IF(IMO.LT.1) IMO=12 3440.
3631     IF(JMO.GT.12) JMO=1 3441.
3632     JJDAY=1 3442.
3633     SJDAY=SOJDAY(JJDAY) 3443.
3634     202 JJDAY=JJDAY+1 3444.
3635     SIDAY=SJDAY 3445.
3636     SJDAY=SOJDAY(JJDAY) 3446.
3637     IF(XJDAY.GT.SJDAY) GO TO 202 3447.
3638     WTJAN=(XJDAY-SIDAY)/(SJDAY-SIDAY) 3448.
3639     IF(JJDAY.EQ.3.OR.JJDAY.EQ.5) WTJAN=1.-WTJAN 3449.
3640     WTSEP=1.0-WTJAN 3450.
3641     DO 203 J=1,JMLAT 3451.
3642     DLATJ=DLAT(J) 3452.
3643     DLSEP=10.0+0.099999*DLATJ*PMLAT(JJDAY) 3453.
3644     DLJAN=10.0+0.099999*DLATJ*PMLAT(JJDAY-1) 3454.
3645     LSEP=DLSEP 3455.
3646     LJAN=DLJAN 3456.
3647     LJANJ(J)=LJAN 3457.
3648     LSEPJ(J)=LSEP 3458.
3649     WTLSEP(J)=DLSEP-LSEP 3459.
3650     203 WTLJAN(J)=DLJAN-LJAN 3460.
3651     IF(AO3J.GT.1.E-10) GO TO 400 3461.
3652     C 3462.
3653     C-----------------------------------------------------------------------3463.
3654     ENTRY O3DLAT 3464.
3655     C-----------------------------------------------------------------------3465.
3656     ILATI=ILATIJ(JLAT) 3466.
3657     WTJL=WTJLAT(JLAT) 3467.
3658     WTIL=1.-WTJL 3468.
3659     JLATI=ILATI+1 3469.
3660     LSEP=LSEPJ(JLAT) 3470.
3661     LJAN=LJANJ(JLAT) 3471.
3662     WTLS=WTLSEP(JLAT) 3472.
3663     WTLJ=WTLJAN(JLAT) 3473.
3664     AO3J=WTIM*(WTIL*AO3AVE(ILATI,IMO)+WTJL*AO3AVE(JLATI,IMO)) 3474.
3665     + +WTJM*(WTIL*AO3AVE(ILATI,JMO)+WTJL*AO3AVE(JLATI,JMO)) 3475.
3666     BHKMJ=WTSPR*BHKMS(JLAT)+WTAUT*BHKMA(JLAT) 3476.
3667     CONCJ=WTSPR*CONCS(JLAT)+WTAUT*CONCA(JLAT) 3477.
3668     AO3JJ=AO3J 3478.
3669     IF(SKIPI) GO TO 400 3479.
3670     DO 300 I=1,IMLON 3480.
3671     ILONG=ILONIJ(I) 3481.
3672     JLONG=ILONG+1 3482.
3673     IF(JLONG.GT.18) JLONG=1 3483.
3674     WTJLG=WTJLON(I) 3484.
3675     WTILG=1.0-WTJLG 3485.
3676     AO3J=WTIM*(WTIL*(WTILG*O3AVE(IMO,ILATI,ILONG) 3486.
3677     + +WTJLG*O3AVE(IMO,ILATI,JLONG)) 3487.
3678     + +WTJL*(WTILG*O3AVE(IMO,JLATI,ILONG) 3488.
3679     + +WTJLG*O3AVE(IMO,JLATI,JLONG))) 3489.
3680     + +WTJM*(WTIL*(WTILG*O3AVE(JMO,ILATI,ILONG) 3490.
3681     + +WTJLG*O3AVE(JMO,ILATI,JLONG)) 3491.
3682     + +WTJL*(WTILG*O3AVE(JMO,JLATI,ILONG) 3492.
3683     + +WTJLG*O3AVE(JMO,JLATI,JLONG))) 3493.
3684     300 AO3JIM(I)=AO3J 3494.
3685     AO3J=AO3JJ 3495.
3686     C 3496.
3687     C-----------------------------------------------------------------------3497.
3688     ENTRY O3DLON 3498.
3689     C-----------------------------------------------------------------------3499.
3690     C 3500.
3691     IF(SKIPI) RETURN 3501.
3692     AO3J=AO3JJ+ABS((AO3JIM(ILON)-AO3JJ))*FLONO3 3502.
3693     C 3503.
3694     400 CKMJ=0.25*AO3J/CONCJ 3504.
3695     GTOP=0.0 3505.
3696     POI=0.0 3506.
3697     FI=0.0 3507.
3698     L=NL 3508.
3699     PLL=PLB0(L) 3509.
3700     J=12 3510.
3701     401 J=J-1 3511.
3702     IF(J.LT.1) GO TO 404 3512.
3703     POJ=PLBSO3(J) 3513.
3704     FJ=WTSEP*(WTLS*SO3SO(J,LSEP+1)+(1.-WTLS)*SO3SO(J,LSEP)) 3514.
3705     + +WTJAN*(WTLJ*SO3JF(J,LJAN+1)+(1.-WTLJ)*SO3JF(J,LJAN)) 3515.
3706     402 DP=POJ-POI 3516.
3707     IF(POJ.GT.PLL) GO TO 403 3517.
3708     GTOP=GTOP+(FI+FJ)*DP*ACMMGG 3518.
3709     POI=POJ 3519.
3710     FI=FJ 3520.
3711     GO TO 401 3521.
3712     403 FF=(FJ-FI)/DP 3522.
3713     DP=PLL-POI 3523.
3714     FF=FI+FF*DP 3524.
3715     GTOP=GTOP+(FI+FF)*DP*ACMMGG 3525.
3716     POI=PLL 3526.
3717     FI=FF 3527.
3718     O3LB(L)=GTOP 3528.
3719     L=L-1 3529.
3720     PLL=PLB0(L) 3530.
3721     GO TO 402 3531.
3722     404 FI=FJ*ACMPKM 3532.
3723     HI=H10MB 3533.
3724     HJ=BHKMJ+CKMJ 3534.
3725     XPBC=EXP(-BHKMJ/CKMJ) 3535.
3726     XPHC=EXP(HJ/CKMJ) 3536.
3727     DTERM=1.0+XPHC*XPBC 3537.
3728     ATERM=(1.0+XPBC)/DTERM 3538.
3729     FTERM=ATERM/DTERM*XPHC*XPBC/CKMJ 3539.
3730     TTERM=AO3J-GTOP-FI*(HI-HJ)*0.5 3540.
3731     AA=TTERM/(FTERM*(HI-HJ)*0.5+1.0-ATERM) 3541.
3732     FJ=AA*FTERM 3542.
3733     GTOPBC=GTOP+(FI+FJ)*(HI-HJ)*0.5-AA*ATERM 3543.
3734     TOP=AA*(1.0+XPBC) 3544.
3735     GO TO 406 3545.
3736     405 DH=HI-HJ 3546.
3737     FF=(FJ-FI)/DH 3547.
3738     DH=HI-H 3548.
3739     FF=FI+FF*DH 3549.
3740     GTOP=GTOP+(FI+FF)*DH*0.5 3550.
3741     HI=H 3551.
3742     FI=FF 3552.
3743     O3LB(L)=GTOP 3553.
3744     L=L-1 3554.
3745     406 CONTINUE 3555.
3746     H=HLB(L) 3556.
3747     IF(H.GT.HJ) GO TO 405 3557.
3748     O3LB(L)=TOP/(1.+XPBC*EXP(H/CKMJ))+GTOPBC 3558.
3749     L=L-1 3559.
3750     IF(L.GT.0) GO TO 406 3560.
3751     O3LB(NLP)=0. 3561.
3752     DO 407 L=1,NL 3562.
3753     407 U0GAS(L,3)=(O3LB(L)-O3LB(L+1)) 3563.
3754     RETURN 3564.
3755     END 3565.
3756     BLOCK DATA 3566.
3757    
3758     #include "B83XX.COM"
3759    
3760     C-----------------------------------------------------------------------3597.
3761     C SEASONAL ALBEDOS FOR 11 VEGETATION TYPES 3598.
3762     C-----------------------------------------------------------------------3599.
3763     C 3600.
3764     EQUIVALENCE 3601.
3765     + (VADATA(1,1,1),ALVISK(1,1)),(VADATA(1,1,2),ALNIRK(1,1)) 3602.
3766     +, (VADATA(1,1,3),FIELDC(1,1)),(VADATA(1,4,3),VTMASK(1)) 3603.
3767     C$$ + (VADATA(1,1,1),ALMEAN(1,1)),(VADATA(1,1,2),RATIRV(1,1)) 3604.
3768     C$$ +, (VADATA(1,1,3),VTMASK(1)),(VADATA(1,2,3),FIELDC(1,1)) 3605.
3769     C 3606.
3770     EQUIVALENCE 3607.
3771     + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 3608.
3772     +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 3609.
3773     +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 3610.
3774     +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 3611.
3775     +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 3612.
3776     +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 3613.
3777     C 3614.
3778     EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 3615.
3779     EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 3616.
3780     C 3617.
3781     EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 3618.
3782     EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 3619.
3783     C 3620.
3784     EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 3621.
3785     + ,(FRC(4), FCLO),(FRC(5), FCOV) 3622.
3786     C 3623.
3787     DIMENSION ALVISK(11,4),ALNIRK(11,4) 3624.
3788     C$$ DIMENSION ALMEAN(11,4),RATIRV(11,4) 3625.
3789     DIMENSION FIELDC(11,3),VTMASK(11) 3626.
3790     C 3627.
3791     C 1 2 3 4 3628.
3792     C WINTER SPRING SUMMER AUTUMN 3629.
3793     C 3630.
3794     DATA ALVISK/ 3631.
3795     C 1 2 3 4 5 6 7 8 9 10 11 3632.
3796     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3633.
3797     1 .350, .067, .089, .089, .078, .100, .067, .061, .100, .070, .001,3634.
3798     2 .350, .063, .100, .100, .073, .055, .067, .061, .100, .070, .001,3635.
3799     3 .350, .085, .091, .139, .085, .058, .083, .061, .100, .070, .001,3636.
3800     4 .350, .080, .090, .111, .064, .055, .061, .061, .100, .070, .001/3637.
3801     C 3638.
3802     DATA ALNIRK/ 3639.
3803     C 1 2 3 4 5 6 7 8 9 10 11 3640.
3804     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3641.
3805     1 .350, .200, .267, .267, .233, .300, .200, .183, .100, .070, .001,3642.
3806     2 .350, .206, .350, .300, .241, .218, .200, .183, .100, .070, .001,3643.
3807     3 .350, .298, .364, .417, .298, .288, .250, .183, .100, .070, .001,3644.
3808     4 .350, .255, .315, .333, .204, .218, .183, .183, .100, .070, .001/3645.
3809     C 3646.
3810     C$$ DATA ALMEAN/ 3647.
3811     C 1 2 3 4 5 6 7 8 9 10 11 3648.
3812     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3649.
3813     C$$ 1 .350, .120, .160, .160, .140, .180, .120, .110, .100, .070, .001,3650.
3814     C$$ 2 .350, .120, .200, .180, .140, .120, .120, .110, .100, .070, .001,3651.
3815     C$$ 3 .350, .170, .200, .250, .170, .150, .150, .110, .100, .070, .001,3652.
3816     C$$ 4 .350, .150, .180, .200, .120, .120, .110, .110, .100, .070, .001/3653.
3817     C 3654.
3818     C$$ DATA RATIRV/ 3655.
3819     C 1 2 3 4 5 6 7 8 9 10 11 3656.
3820     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3657.
3821     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.
3822     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.
3823     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.
3824     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.
3825     C 3662.
3826     DATA FIELDC/ 3663.
3827     C (KG/M**2) 3664.
3828     C 1 2 3 4 5 6 7 8 9 10 11 3665.
3829     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3666.
3830     1 10.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 200., 10.0, 30.0, 999.,3667.
3831     2 10.0, 200., 200., 300., 300., 450., 450., 450., 10.0, 200., 999.,3668.
3832     3 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0/3669.
3833     C 3670.
3834     DATA VTMASK/ 3671.
3835     C (KG/M**2) 3672.
3836     C 1 2 3 4 5 6 7 8 9 10 11 3673.
3837     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3674.
3838     4 10.0, 20.0, 20.0, 50.0, 200., 500.,1000.,2500., 10.0, 30.0, .001/3676.
3839     C 3677.
3840     C 3678.
3841     DATA DLAT/ 3679.
3842     +-90.000000,-82.173913,-74.347826,-66.521739,-58.695652,-50.869565,3680.
3843     +-43.043478,-35.217391,-27.391304,-19.565217,-11.739130,- 3.913043,3681.
3844     + 3.913043, 11.739130, 19.565217, 27.391304, 35.217391, 43.043478,3682.
3845     + 50.869565, 58.695652, 66.521739, 74.347826, 82.173913, 90.000000,3683.
3846     + 22*0.0000/ 3684.
3847     C 3685.
3848     DATA DLON/ 3686.
3849     + 0.0, 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0, 3687.
3850     + 90.0, 100.0, 110.0, 120.0, 130.0, 140.0, 150.0, 160.0, 170.0, 3688.
3851     + 180.0, 190.0, 200.0, 210.0, 220.0, 230.0, 240.0, 250.0, 260.0, 3689.
3852     + 270.0, 280.0, 290.0, 300.0, 310.0, 320.0, 330.0, 340.0, 350.0, 3690.
3853     +36*0.0/ 3691.
3854     C 3692.
3855     C-----------------------------------------------------------------------3693.
3856     C TRACE GAS REFERENCE AMOUNTS & DISTRIBUTIONS ARE DEFINED IN SETGAS3694.
3857     C-----------------------------------------------------------------------3695.
3858     C 3696.
3859     C 3697.
3860     C H2O CO2 O3 O2 NO2 N2O CH4 F11 F12 3698.
3861     C 1 2 3 4 5 6 7 8 9 3699.
3862     DATA FULGAS/ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 3700.
3863     + , 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0/ 3701.
3864     C 3702.
3865     C GLOBAL OCEAN LAND DESERT HAZE TR1 TR2 TR3 TR4 3703.
3866     C 1 2 3 4 5 6 7 8 9 3704.
3867     C 3705.
3868     DATA FGOLDH/ 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0 3706.
3869     + , 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0/ 3707.
3870     C 3708.
3871     DATA LASTVC/-123456/, KFORCE/-123456789/ 3709.
3872     C 3710.
3873     C 3711.
3874     DATA TAUMIN/1.0E-04/, TLGRAD/ 1.0/, EOCTRA/1.0/, ZOCSRA/1.0/ 3712.
3875     DATA FRACSL/1.0E-02/, TKCICE/258./, ESNTRA/1.0/, ZSNSRA/1.0/ 3713.
3876     DATA RATQSL/1.0 /, FLONO3/ 0.0/, EICTRA/1.0/, ZICSRA/1.0/ 3714.
3877     DATA FOGTSL/0.0 /, ECLTRA/1.00/, EDSTRA/1.0/, ZDSSRA/1.0/ 3715.
3878     DATA PTLISO/2.5E+00/, ZCLSRA/1.00/, EVGTRA/1.0/, ZVGSRA/1.0/ 3716.
3879     C 3717.
3880     DATA FMARCL/0.50/, FCLDTR/1.0/, NTRACE/0/, IDPROG/0/ 3718.
3881     DATA WETTRA/1.00/, FCLDSR/1.0/, ITR(1)/0/, ID2TRD/0/ 3719.
3882     DATA WETSRA/1.00/, FALGAE/1.0/, ITR(2)/0/, ID3SRD/0/ 3720.
3883     DATA DMOICE/10.0/, FRAYLE/1.0/, ITR(3)/0/, ID4VEG/0/ 3721.
3884     DATA DMLICE/10.0/, LICETK/ 0/, ITR(4)/0/, ID5FOR/0/ 3722.
3885     C 3723.
3886     DATA NV/ 8/ 3724.
3887     DATA IMGAS1/1/, KEEPRH/0/, KGASSR/0/, LAYRAD/ 3/ 3725.
3888     DATA IMGAS2/3/, KEEPAL/0/, KAERSR/0/, NL/12/ 3726.
3889     DATA ILGAS1/2/, ISOSCT/0/, KFRACC/0/, NLP/13/ 3727.
3890     DATA ILGAS2/9/, IHGSCT/0/, MARCLD/0/, JMLAT/24/ 3728.
3891     DATA KWVCON/1/, LAPGAS/1/, NORMS0/1/, IMLON/36/ 3729.
3892     C 3730.
3893     DATA JYEAR/1958/, JLAT/18/, S0/1367.0/ 3731.
3894     DATA JDAY/ 0/, ILON/18/, COSZ/0.5000/ 3732.
3895     C 3733.
3896     DATA POCEAN/0.700/, TGO/288.15/, AGESN/1.00/, WMAG/2.00/ 3734.
3897     DATA PEARTH/0.100/, TGE/288.15/, SNOWE/0.30/, WEARTH/0.00/ 3735.
3898     DATA POICE/0.100/, TGOI/288.15/, SNOWOI/0.10/, ZOICE/10.0/ 3736.
3899     DATA PLICE/0.100/, TGLI/288.15/, SNOWLI/0.20/, FRACCC/0.00/ 3737.
3900     DATA TSL/288.15/ 3738.
3901     C 3739.
3902     DATA PLB/ 3740.
3903     + 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 3741.
3904     + 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 3742.
3905     + 1.E-05, 27*0.00/ 3743.
3906     C 3744.
3907     DATA HLB/ 3745.
3908     + 1.E-10,1.0,2.0,3.0,6.0,11.0,20.0,32.0,47.0,51.0,71.0 3746.
3909     + ,84.852,99.99,27*99.999/ 3747.
3910     C 3748.
3911     DATA TLB/40*250./ 3749.
3912     DATA TLT/40*250./ 3750.
3913     DATA TLM/40*250./ 3751.
3914     C 3752.
3915     DATA U0GAS/360*0./ 3753.
3916     DATA ULGAS/360*0./ 3754.
3917     C 3755.
3918     DATA TRACER/160*0./ 3756.
3919     DATA CLDTAU/ 40*0./ 3757.
3920     C 3758.
3921     DATA SHL/40*0./ 3759.
3922     DATA RHL/40*0./ 3760.
3923     C 3761.
3924     DATA PVT/8*0.125,3*0.0/ 3762.
3925     C 3763.
3926     DATA SRBXAL/30*0./ 3764.
3927     DATA BXA/153*0./ 3765.
3928     C 3766.
3929     DATA LUXGAS/1/ 3767.
3930     DATA KALVIS/0/ 3768.
3931     DATA MEANAL/0/ 3769.
3932     C 3770.
3933     C-----------------------------------------------------------------------3771.
3934     C AEROSOL RADIATIVE PROPERTIES,COMPOSITION,TYPE & VERTICAL DISTRIBUTION3772.
3935     C-----------------------------------------------------------------------3773.
3936     C 3774.
3937     C BLOCKD INITIALIZED DEFAULT DATA 3775.
3938     C 3776.
3939     C 3785.
3940     DIMENSION QACID1(25),QACID2(25),QSLFT1(25),QSLFT2(25) 3786.
3941     T ,QBSLT1(25),QBSLT2(25),QSSALT(25),QDUST1(25) 3787.
3942     T ,QDUST2(25),QCARB1(25),QCARB2(25) 3788.
3943     T ,SACID1(25),SACID2(25),SSLFT1(25),SSLFT2(25) 3789.
3944     T ,SBSLT1(25),SBSLT2(25),SSSALT(25),SDUST1(25) 3790.
3945     T ,SDUST2(25),SCARB1(25),SCARB2(25) 3791.
3946     T ,CACID1(25),CACID2(25),CSLFT1(25),CSLFT2(25) 3792.
3947     T ,CBSLT1(25),CBSLT2(25),CSSALT(25),CDUST1(25) 3793.
3948     T ,CDUST2(25),CCARB1(25),CCARB2(25) 3794.
3949     T ,QWATER(25),QICE25(25),SWATER(25),SICE25(25) 3795.
3950     T ,CWATER(25),CICE25(25) 3796.
3951     C 3797.
3952     S ,XACID1(6),XACID2(6),XSLFT1(6),XSLFT2(6),XBSLT1(6),XBSLT2(6)3798.
3953     S ,XSSALT(6),XDUST1(6),XDUST2(6),XCARB1(6),XCARB2(6) 3799.
3954     S ,YACID1(6),YACID2(6),YSLFT1(6),YSLFT2(6),YBSLT1(6),YBSLT2(6)3800.
3955     S ,YSSALT(6),YDUST1(6),YDUST2(6),YCARB1(6),YCARB2(6) 3801.
3956     S ,ZACID1(6),ZACID2(6),ZSLFT1(6),ZSLFT2(6),ZBSLT1(6),ZBSLT2(6)3802.
3957     S ,ZSSALT(6),ZDUST1(6),ZDUST2(6),ZCARB1(6),ZCARB2(6) 3803.
3958     S ,XWATER(6),XICE25(6),YWATER(6),YICE25(6),ZWATER(6),ZICE25(6)3804.
3959     C 3805.
3960     EQUIVALENCE (TRAQEX(1, 1),QACID1(1)),(TRAQEX(1, 2),QACID2(1)) 3806.
3961     1 ,(TRAQEX(1, 3),QSLFT1(1)),(TRAQEX(1, 4),QSLFT2(1)) 3807.
3962     2 ,(TRAQEX(1, 5),QBSLT1(1)),(TRAQEX(1, 6),QBSLT2(1)) 3808.
3963     3 ,(TRAQEX(1, 7),QSSALT(1)),(TRAQEX(1, 8),QDUST1(1)) 3809.
3964     4 ,(TRAQEX(1, 9),QDUST2(1)),(TRAQEX(1,10),QCARB1(1)) 3810.
3965     5 ,(TRAQEX(1,11),QCARB2(1)) 3811.
3966     C 3812.
3967     EQUIVALENCE (TRAQSC(1, 1),SACID1(1)),(TRAQSC(1, 2),SACID2(1)) 3813.
3968     1 ,(TRAQSC(1, 3),SSLFT1(1)),(TRAQSC(1, 4),SSLFT2(1)) 3814.
3969     2 ,(TRAQSC(1, 5),SBSLT1(1)),(TRAQSC(1, 6),SBSLT2(1)) 3815.
3970     3 ,(TRAQSC(1, 7),SSSALT(1)),(TRAQSC(1, 8),SDUST1(1)) 3816.
3971     4 ,(TRAQSC(1, 9),SDUST2(1)),(TRAQSC(1,10),SCARB1(1)) 3817.
3972     5 ,(TRAQSC(1,11),SCARB2(1)) 3818.
3973     C 3819.
3974     EQUIVALENCE (TRACOS(1, 1),CACID1(1)),(TRACOS(1, 2),CACID2(1)) 3820.
3975     1 ,(TRACOS(1, 3),CSLFT1(1)),(TRACOS(1, 4),CSLFT2(1)) 3821.
3976     2 ,(TRACOS(1, 5),CBSLT1(1)),(TRACOS(1, 6),CBSLT2(1)) 3822.
3977     3 ,(TRACOS(1, 7),CSSALT(1)),(TRACOS(1, 8),CDUST1(1)) 3823.
3978     4 ,(TRACOS(1, 9),CDUST2(1)),(TRACOS(1,10),CCARB1(1)) 3824.
3979     5 ,(TRACOS(1,11),CCARB2(1)) 3825.
3980     C 3826.
3981     EQUIVALENCE (TRCQEX(1, 1),QWATER(1)),(TRCQEX(1, 2),QICE25(1)) 3827.
3982     EQUIVALENCE (TRCQSC(1, 1),SWATER(1)),(TRCQSC(1, 2),SICE25(1)) 3828.
3983     EQUIVALENCE (TRCCOS(1, 1),CWATER(1)),(TRCCOS(1, 2),CICE25(1)) 3829.
3984     3830.
3985     C 3831.
3986     EQUIVALENCE (SRAQEX(1, 1),XACID1(1)),(SRAQEX(1, 2),XACID2(1)) 3832.
3987     1 ,(SRAQEX(1, 3),XSLFT1(1)),(SRAQEX(1, 4),XSLFT2(1)) 3833.
3988     2 ,(SRAQEX(1, 5),XBSLT1(1)),(SRAQEX(1, 6),XBSLT2(1)) 3834.
3989     3 ,(SRAQEX(1, 7),XSSALT(1)),(SRAQEX(1, 8),XDUST1(1)) 3835.
3990     4 ,(SRAQEX(1, 9),XDUST2(1)),(SRAQEX(1,10),XCARB1(1)) 3836.
3991     5 ,(SRAQEX(1,11),XCARB2(1)) 3837.
3992     C 3838.
3993     EQUIVALENCE (SRAQSC(1, 1),YACID1(1)),(SRAQSC(1, 2),YACID2(1)) 3839.
3994     1 ,(SRAQSC(1, 3),YSLFT1(1)),(SRAQSC(1, 4),YSLFT2(1)) 3840.
3995     2 ,(SRAQSC(1, 5),YBSLT1(1)),(SRAQSC(1, 6),YBSLT2(1)) 3841.
3996     3 ,(SRAQSC(1, 7),YSSALT(1)),(SRAQSC(1, 8),YDUST1(1)) 3842.
3997     4 ,(SRAQSC(1, 9),YDUST2(1)),(SRAQSC(1,10),YCARB1(1)) 3843.
3998     5 ,(SRAQSC(1,11),YCARB2(1)) 3844.
3999     C 3845.
4000     EQUIVALENCE (SRACOS(1, 1),ZACID1(1)),(SRACOS(1, 2),ZACID2(1)) 3846.
4001     1 ,(SRACOS(1, 3),ZSLFT1(1)),(SRACOS(1, 4),ZSLFT2(1)) 3847.
4002     2 ,(SRACOS(1, 5),ZBSLT1(1)),(SRACOS(1, 6),ZBSLT2(1)) 3848.
4003     3 ,(SRACOS(1, 7),ZSSALT(1)),(SRACOS(1, 8),ZDUST1(1)) 3849.
4004     4 ,(SRACOS(1, 9),ZDUST2(1)),(SRACOS(1,10),ZCARB1(1)) 3850.
4005     5 ,(SRACOS(1,11),ZCARB2(1)) 3851.
4006     C 3852.
4007     EQUIVALENCE (SRCQEX(1, 1),XWATER(1)),(SRCQEX(1, 2),XICE25(1)) 3853.
4008     EQUIVALENCE (SRCQSC(1, 1),YWATER(1)),(SRCQSC(1, 2),YICE25(1)) 3854.
4009     EQUIVALENCE (SRCCOS(1, 1),ZWATER(1)),(SRCCOS(1, 2),ZICE25(1)) 3855.
4010     3856.
4011     C 3857.
4012     DATA NGOLDH/5/,NAERO/11/ 3858.
4013     C 3859.
4014     C-----------------------------------------------------------------------3860.
4015     C COMPOSITION & VERTICAL DISTRIBUTION FOR 5 SPECIFIED AEROSOL TYPES3861.
4016     C-----------------------------------------------------------------------3862.
4017     C TYPE 3863.
4018     C 1 STRATOSPHERIC GLOBAL AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3864.
4019     C 2 TROPOSPHERIC OCEAN AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3865.
4020     C 3 TROPOSPHERIC LAND AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3866.
4021     C 4 TROPOSPHERIC DESERT AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3867.
4022     C 5 TROPOSPHERIC HAZE AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3868.
4023     C 3869.
4024     C 1 2 3 4 5 6 7 8 9 10 11 3870.
4025     C ACID1 OCT82 SLFT1 SLFT2 BSLT1 BSLT2 SSALT DUST1 DUST2 MAY82 CARB23871.
4026     DATA AGOLDH/ 3872.
4027     1 .012, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3873.
4028     2 .0, .0, .018, .033, .012, .023, .011, .0, .0, .0, .0,3874.
4029     3 .0, .0, .031, .057, .021, .042, .0, .0, .0, .0, .018,3875.
4030     4 .0, .0, .0, .0, .0, .0, .0, .300, .300, .0, .0,3876.
4031     5 .0, .250, .0, .0, .0, .0, .0, .300, .0, .0, .0/3877.
4032     DATA BGOLDH/ 3878.
4033     1 20.0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3879.
4034     2 .0, .0, 4.00, 0.00, 4.00, 1.00, 0.00, .0, .0, .0, .0,3880.
4035     3 .0, .0, 4.00, 0.00, 4.00, 0.00, .0, .0, .0, .0, 0.00,3881.
4036     4 .0, .0, .0, .0, .0, .0, .0, 3.50, 0.00, .0, .0,3882.
4037     5 .0, 0.00, .0, .0, .0, .0, .0, 3.50, .0, .0, .0/3883.
4038     DATA CGOLDH/ 3884.
4039     1 3.00, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3885.
4040     2 .0, .0, 3.00, 1.00, 3.00, 0.5, 1.00, .0, .0, .0, .0,3886.
4041     3 .0, .0, 3.00, 1.00, 3.00, 1.00, .0, .0, .0, .0, 1.00,3887.
4042     4 .0, .0, .0, .0, .0, .0, .0, 1.00, 1.00, .0, .0,3888.
4043     5 .0, 1.00, .0, .0, .0, .0, .0, 1.00, .0, .0, .0/3889.
4044     C 3890.
4045     C-----------------------------------------------------------------------3891.
4046     C THERMAL RADIATION 25 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB3892.
4047     C-----------------------------------------------------------------------3893.
4048     DATA QACID1/ 3894.
4049     + 0.04052,0.05895,0.08506,0.06673,0.05160,0.04437,0.03864, 3895.
4050     + 0.02719,0.01668,0.01146,0.00705,0.03286,0.02449,0.03017, 3896.
4051     + 0.03198,0.02891,0.02634,0.02366,0.02300,0.02271,0.02159, 3897.
4052     + 0.08516,0.08825,0.08982,0.09284/ 3898.
4053     DATA SACID1/ 3899.
4054     + 0.00095,0.00361,0.00273,0.00226,0.00150,0.00141,0.00131, 3900.
4055     + 0.00090,0.00049,0.00029,0.00014,0.00072,0.00049,0.00031, 3901.
4056     + 0.00023,0.00023,0.00022,0.00020,0.00019,0.00018,0.00018, 3902.
4057     + 0.00183,0.00201,0.00205,0.00207/ 3903.
4058     DATA CACID1/ 3904.
4059     + 0.11030,0.17256,0.17138,0.19696,0.19510,0.18945,0.18874, 3905.
4060     + 0.18795,0.18313,0.17814,0.17075,0.10583,0.09756,0.08388, 3906.
4061     + 0.07246,0.07266,0.07099,0.06873,0.06754,0.06661,0.06674, 3907.
4062     + 0.11197,0.11068,0.10998,0.10852/ 3908.
4063     C 3909.
4064     DATA QACID2/ 3910.
4065     + 0.05764,0.15189,0.06264,0.04527,0.03973,0.03646,0.03375, 3911.
4066     + 0.02163,0.01337,0.00979,0.00724,0.04076,0.03631,0.04273, 3912.
4067     + 0.04072,0.03752,0.03290,0.03012,0.02968,0.02914,0.02763, 3913.
4068     + 0.10731,0.12510,0.12901,0.13232/ 3914.
4069     DATA SACID2/ 3915.
4070     + 0.00367,0.00752,0.00264,0.00172,0.00188,0.00221,0.00225, 3916.
4071     + 0.00134,0.00066,0.00034,0.00012,0.00237,0.00121,0.00084, 3917.
4072     + 0.00080,0.00081,0.00074,0.00069,0.00067,0.00065,0.00064, 3918.
4073     + 0.00674,0.00807,0.00825,0.00837/ 3919.
4074     DATA CACID2/ 3920.
4075     + 0.05720,0.11171,0.11850,0.11443,0.12325,0.13171,0.13500, 3921.
4076     + 0.13575,0.13419,0.12666,0.10961,0.05186,0.04026,0.03219, 3922.
4077     + 0.03060,0.03105,0.03041,0.02959,0.02911,0.02884,0.02901, 3923.
4078     + 0.07145,0.07168,0.07134,0.07096/ 3924.
4079     C 3925.
4080     DATA QSLFT1/ 3926.
4081     + 0.15555,0.16333,0.16406,0.16396,0.16070,0.14074,0.11920, 3927.
4082     + 0.09140,0.07341,0.06645,0.05871,0.15301,0.13456,0.15809, 3928.
4083     + 0.16264,0.14805,0.12798,0.10588,0.09960,0.09604,0.08844, 3929.
4084     + 0.35895,0.27430,0.26964,0.27183/ 3930.
4085     DATA SSLFT1/ 3931.
4086     + 0.13162,0.13152,0.11642,0.12932,0.10550,0.08323,0.07081, 3932.
4087     + 0.05079,0.03287,0.02458,0.01871,0.12787,0.11183,0.09490, 3933.
4088     + 0.08739,0.08716,0.08022,0.07182,0.06899,0.06700,0.06496, 3934.
4089     + 0.13067,0.12933,0.12878,0.12808/ 3935.
4090     DATA CSLFT1/ 3936.
4091     + 0.52508,0.48102,0.59654,0.66259,0.66566,0.70224,0.71546, 3937.
4092     + 0.69308,0.62819,0.55963,0.45811,0.52840,0.54500,0.51620, 3938.
4093     + 0.50685,0.52475,0.54985,0.58351,0.59484,0.60203,0.61652, 3939.
4094     + 0.45926,0.47060,0.47243,0.47178/ 3940.
4095     C 3941.
4096     DATA QSLFT2/ 3942.
4097     + 0.44109,0.37065,0.38095,0.40554,0.37738,0.32564,0.27970, 3943.
4098     + 0.21687,0.17752,0.16154,0.14952,0.43239,0.38517,0.39512, 3944.
4099     + 0.39098,0.36978,0.32960,0.28406,0.27042,0.26204,0.24771, 3945.
4100     + 0.63665,0.59084,0.58844,0.59078/ 3946.
4101     DATA SSLFT2/ 3947.
4102     + 0.37818,0.31549,0.29505,0.33810,0.28074,0.22692,0.19562, 3948.
4103     + 0.14289,0.09653,0.07449,0.06008,0.36685,0.33089,0.28296, 3949.
4104     + 0.26185,0.26286,0.24369,0.22019,0.21220,0.20647,0.20093, 3950.
4105     + 0.31870,0.30963,0.30762,0.30507/ 3951.
4106     DATA CSLFT2/ 3952.
4107     + 0.54586,0.50074,0.62826,0.69007,0.69596,0.73443,0.74600, 3953.
4108     + 0.71846,0.64430,0.57291,0.47311,0.54977,0.56612,0.53939, 3954.
4109     + 0.53105,0.54799,0.57221,0.60426,0.61497,0.62179,0.63518, 3955.
4110     + 0.51454,0.52095,0.52268,0.52316/ 3956.
4111     C 3957.
4112     DATA QBSLT1/ 3958.
4113     + 0.19787,0.15206,0.14808,0.15505,0.14132,0.12508,0.10931, 3959.
4114     + 0.07946,0.05659,0.04675,0.03801,0.20081,0.15823,0.15732, 3960.
4115     + 0.15377,0.14273,0.13163,0.12005,0.11684,0.11523,0.11121, 3961.
4116     + 0.36601,0.39099,0.39240,0.39274/ 3962.
4117     DATA SBSLT1/ 3963.
4118     + 0.09892,0.12369,0.09780,0.11017,0.08914,0.08577,0.07794, 3964.
4119     + 0.05688,0.03912,0.03069,0.02440,0.09492,0.08277,0.05817, 3965.
4120     + 0.04773,0.04970,0.04568,0.04058,0.03865,0.03717,0.03641, 3966.
4121     + 0.07710,0.08232,0.08235,0.08163/ 3967.
4122     DATA CBSLT1/ 3968.
4123     + 0.54090,0.49369,0.59375,0.67539,0.69444,0.71623,0.71674, 3969.
4124     + 0.69425,0.63125,0.57379,0.48766,0.54072,0.57272,0.57215, 3970.
4125     + 0.57655,0.59243,0.60616,0.62323,0.62911,0.63253,0.63934, 3971.
4126     + 0.51632,0.50380,0.50414,0.50666/ 3972.
4127     C 3973.
4128     DATA QBSLT2/ 3974.
4129     + 0.49004,0.35700,0.34009,0.38146,0.35476,0.32874,0.29258, 3975.
4130     + 0.21726,0.16067,0.13571,0.11451,0.48169,0.40550,0.37263, 3976.
4131     + 0.35312,0.33842,0.31466,0.28850,0.28051,0.27574,0.26813, 3977.
4132     + 0.59495,0.63654,0.63850,0.63742/ 3978.
4133     DATA SBSLT2/ 3979.
4134     + 0.26833,0.30862,0.25309,0.29334,0.24644,0.24238,0.22164, 3980.
4135     + 0.16459,0.11742,0.09480,0.07809,0.26006,0.23936,0.17265, 3981.
4136     + 0.14418,0.15103,0.13960,0.12488,0.11925,0.11488,0.11275, 3982.
4137     + 0.19766,0.20963,0.20969,0.20807/ 3983.
4138     DATA CBSLT2/ 3984.
4139     + 0.57850,0.51330,0.62334,0.70306,0.72063,0.74166,0.74111, 3985.
4140     + 0.71466,0.64442,0.58410,0.49911,0.58174,0.60690,0.60535, 3986.
4141     + 0.60954,0.62353,0.63716,0.65423,0.66019,0.66381,0.67030, 3987.
4142     + 0.58670,0.57707,0.57759,0.58014/ 3988.
4143     C 3989.
4144     DATA QSSALT/ 3990.
4145     + 0.27651,0.36950,0.40122,0.39669,0.34286,0.33458,0.29978, 3991.
4146     + 0.26075,0.26470,0.26660,0.28507,0.27114,0.23752,0.18761, 3992.
4147     + 0.16890,0.17532,0.17705,0.17827,0.17801,0.17743,0.17914, 3993.
4148     + 0.34241,0.33620,0.33607,0.33681/ 3994.
4149     DATA SSSALT/ 3995.
4150     + 0.27651,0.36950,0.40121,0.39659,0.34226,0.33245,0.29555, 3996.
4151     + 0.22360,0.16290,0.13425,0.11177,0.27114,0.23751,0.18755, 3997.
4152     + 0.16883,0.17526,0.17700,0.17823,0.17797,0.17739,0.17911, 3998.
4153     + 0.34241,0.33620,0.33607,0.33681/ 3999.
4154     DATA CSSALT/ 4000.
4155     + 0.66858,0.50298,0.60372,0.65282,0.66694,0.67041,0.66666, 4001.
4156     + 0.62258,0.52248,0.44732,0.32878,0.66866,0.66680,0.66404, 4002.
4157     + 0.66252,0.66281,0.66265,0.66244,0.66232,0.66223,0.66226, 4003.
4158     + 0.67338,0.67406,0.67410,0.67408/ 4004.
4159     C 4005.
4160     DATA QDUST1/ 4006.
4161     + 0.60958,0.65996,0.59890,0.73030,0.64827,0.55835,0.48157, 4007.
4162     + 0.34847,0.23144,0.18097,0.13460,0.59012,0.47533,0.39938, 4008.
4163     + 0.36575,0.35808,0.33834,0.31587,0.30849,0.30369,0.29821, 4009.
4164     + 0.91360,1.14613,1.16193,1.16619/ 4010.
4165     DATA SDUST1/ 4011.
4166     + 0.32015,0.60541,0.49800,0.59591,0.46651,0.39745,0.34242, 4012.
4167     + 0.23468,0.13039,0.08473,0.04350,0.29084,0.23940,0.16410, 4013.
4168     + 0.13070,0.13267,0.12095,0.10691,0.10167,0.09788,0.09578, 4014.
4169     + 0.39128,0.54469,0.55555,0.55942/ 4015.
4170     DATA CDUST1/ 4016.
4171     + 0.50425,0.49645,0.57736,0.63615,0.63373,0.66224,0.67205, 4017.
4172     + 0.67034,0.65137,0.61767,0.53600,0.49640,0.47921,0.43825, 4018.
4173     + 0.40760,0.41364,0.41120,0.40706,0.40418,0.40149,0.40315, 4019.
4174     + 0.47280,0.39308,0.38801,0.38670/ 4020.
4175     C 4021.
4176     DATA QDUST2/ 4022.
4177     + 0.95483,0.71515,0.77676,0.91847,0.93699,0.89565,0.82979, 4023.
4178     + 0.74871,0.70959,0.69272,0.68748,0.94632,0.90846,0.85600, 4024.
4179     + 0.83350,0.83544,0.82317,0.80807,0.80270,0.79879,0.79577, 4025.
4180     + 1.02427,1.12417,1.13054,1.13169/ 4026.
4181     DATA SDUST2/ 4027.
4182     + 0.49885,0.58157,0.55165,0.64038,0.59140,0.55222,0.50136, 4028.
4183     + 0.42019,0.36087,0.33502,0.31667,0.49026,0.47989,0.42207, 4029.
4184     + 0.39751,0.40487,0.39774,0.38819,0.38426,0.38107,0.38027, 4030.
4185     + 0.49780,0.59147,0.59817,0.60013/ 4031.
4186     DATA CDUST2/ 4032.
4187     + 0.74352,0.54594,0.68229,0.72513,0.73598,0.75710,0.75041, 4033.
4188     + 0.70723,0.65024,0.61702,0.58021,0.74556,0.74741,0.75647, 4034.
4189     + 0.76384,0.76647,0.77599,0.78746,0.79136,0.79400,0.79700, 4035.
4190     + 0.71874,0.62817,0.62224,0.62062/ 4036.
4191     C 4037.
4192     DATA QCARB1/ 4038.
4193     + 0.44718,0.51882,0.26055,0.20526,0.19295,0.18655,0.17520, 4039.
4194     + 0.11120,0.06749,0.04893,0.03537,0.32912,0.25261,0.24973, 4040.
4195     + 0.23947,0.22883,0.20424,0.18781,0.18400,0.18032,0.17370, 4041.
4196     + 0.57200,0.64430,0.65267,0.65790/ 4042.
4197     DATA SCARB1/ 4043.
4198     + 0.17857,0.12659,0.06506,0.05088,0.05317,0.05712,0.05562, 4044.
4199     + 0.03310,0.01705,0.01009,0.00493,0.13908,0.08683,0.06332, 4045.
4200     + 0.06114,0.06260,0.05755,0.05319,0.05155,0.05032,0.04981, 4046.
4201     + 0.19594,0.21003,0.20967,0.20853/ 4047.
4202     DATA CCARB1/ 4048.
4203     + 0.40490,0.48729,0.43960,0.40824,0.46236,0.51422,0.53366, 4049.
4204     + 0.53211,0.51283,0.46211,0.32882,0.40923,0.35984,0.30817, 4050.
4205     + 0.30468,0.31306,0.31215,0.30857,0.30555,0.30388,0.30644, 4051.
4206     + 0.43102,0.40748,0.40436,0.40208/ 4052.
4207     C 4053.
4208     DATA QCARB2/ 4054.
4209     + 0.09591,0.22971,0.21603,0.21745,0.17928,0.17061,0.15202, 4055.
4210     + 0.10846,0.06721,0.04817,0.03076,0.09456,0.08428,0.07093, 4056.
4211     + 0.06589,0.06737,0.06766,0.06782,0.06771,0.06754,0.06792, 4057.
4212     + 0.12455,0.12130,0.12121,0.12155/ 4058.
4213     DATA SCARB2/ 4059.
4214     + 0.00748,0.06133,0.05031,0.04978,0.03714,0.03448,0.03065, 4060.
4215     + 0.02099,0.01137,0.00688,0.00291,0.00728,0.00544,0.00350, 4061.
4216     + 0.00276,0.00291,0.00290,0.00288,0.00285,0.00282,0.00286, 4062.
4217     + 0.01420,0.01327,0.01324,0.01332/ 4063.
4218     DATA CCARB2/ 4064.
4219     + 0.14117,0.25269,0.27090,0.30506,0.29845,0.28974,0.28880, 4065.
4220     + 0.28843,0.28603,0.28395,0.29112,0.14128,0.12741,0.11121, 4066.
4221     + 0.09892,0.09935,0.09786,0.09604,0.09517,0.09448,0.09466, 4067.
4222     + 0.18297,0.17686,0.17658,0.17696/ 4068.
4223     C 4069.
4224     DATA QWATER/ 4070.
4225     + 0.82334,0.89509,1.13254,1.20762,1.24075,1.18580,1.07585, 4071.
4226     + 0.95283,0.89542,0.86914,0.85864,0.87834,0.94021,1.03878, 4072.
4227     + 1.07876,1.06927,1.06987,1.07153,1.07327,1.07505,1.07280, 4073.
4228     + 1.20709,1.20194,1.20383,1.20978/ 4074.
4229     DATA SWATER/ 4075.
4230     + 0.34695,0.68566,0.86748,0.89010,0.83121,0.75556,0.65338, 4076.
4231     + 0.51441,0.40925,0.36469,0.31873,0.39396,0.39368,0.43707, 4077.
4232     + 0.45625,0.44997,0.45039,0.45146,0.45251,0.45357,0.45227, 4078.
4233     + 0.85537,0.85478,0.85718,0.86370/ 4079.
4234     DATA CWATER/ 4080.
4235     + 0.91848,0.65450,0.79206,0.82335,0.83709,0.84869,0.84338, 4081.
4236     + 0.77907,0.68419,0.62521,0.54076,0.91355,0.89224,0.85667, 4082.
4237     + 0.84557,0.85029,0.85229,0.85399,0.85411,0.85389,0.85524, 4083.
4238     + 0.91095,0.91472,0.91488,0.91467/ 4084.
4239     C 4085.
4240     DATA QICE25/ 4086.
4241     + 1.15210,0.81551,0.98885,1.10325,1.17652,1.14217,1.07777, 4087.
4242     + 1.08252,1.14496,1.16939,1.22006,1.16194,1.16781,1.19342, 4088.
4243     + 1.20279,1.19736,1.19435,1.19146,1.19097,1.19095,1.18924, 4089.
4244     + 1.19321,1.21794,1.21959,1.21942/ 4090.
4245     DATA SICE25/ 4091.
4246     + 0.57392,0.45452,0.57278,0.68806,0.74580,0.69171,0.64662, 4092.
4247     + 0.62884,0.64120,0.64892,0.66105,0.59403,0.60241,0.67853, 4093.
4248     + 0.70399,0.68299,0.66547,0.64731,0.64301,0.64122,0.63321, 4094.
4249     + 0.71867,0.77122,0.77524,0.77622/ 4095.
4250     DATA CICE25/ 4096.
4251     + 0.93634,0.72920,0.86084,0.88431,0.87489,0.88472,0.86613, 4097.
4252     + 0.82078,0.79850,0.79041,0.78539,0.93377,0.91036,0.85751, 4098.
4253     + 0.84228,0.85220,0.86089,0.87036,0.87263,0.87355,0.87810, 4099.
4254     + 0.94697,0.94840,0.94812,0.94714/ 4100.
4255     C 4101.
4256     C-----------------------------------------------------------------------4102.
4257     C SOLAR RADIATION 6 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB4103.
4258     C-----------------------------------------------------------------------4104.
4259     C 4105.
4260     DATA XACID1/ 0.05776,0.10033,0.19099,0.36614,0.55931,1.04703/ 4106.
4261     DATA YACID1/ 0.01880,0.09956,0.19090,0.36613,0.55931,1.04703/ 4107.
4262     DATA ZACID1/ 0.36054,0.51871,0.57276,0.62068,0.65273,0.68988/ 4108.
4263     C 4109.
4264     DATA XACID2/0.13360,0.33875,0.51498,0.68359,0.79939,0.94494/ 4110.
4265     DATA YACID2/0.07420,0.33691,0.51483,0.68358,0.79939,0.94494/ 4111.
4266     C$ DATA ZACID2/0.40248,0.62259,0.68524,0.71328,0.71195,0.72894/ 4112.
4267     DATA ZACID2/0.39821,0.54835,0.60846,0.63637,0.63503,0.65221/ 4112.1
4268     C 4113.
4269     DATA XSLFT1/ 0.31035,0.44757,0.54238,0.66756,0.78260,1.04454/ 4114.
4270     DATA YSLFT1/ 0.24589,0.44490,0.54224,0.66755,0.78260,1.04454/ 4115.
4271     DATA ZSLFT1/ 0.70591,0.67557,0.66832,0.66438,0.66199,0.66008/ 4116.
4272     C 4117.
4273     DATA XSLFT2/ 0.60959,0.74888,0.81124,0.87560,0.92632,1.00936/ 4118.
4274     DATA YSLFT2/ 0.50477,0.74262,0.81090,0.87556,0.92631,1.00935/ 4119.
4275     DATA ZSLFT2/ 0.74067,0.70281,0.69748,0.69922,0.70070,0.70754/ 4120.
4276     C 4121.
4277     DATA XBSLT1/ 0.30419,0.46195,0.54908,0.66403,0.77732,1.02644/ 4122.
4278     DATA YBSLT1/ 0.28732,0.44765,0.53358,0.64786,0.76063,1.00769/ 4123.
4279     DATA ZBSLT1/ 0.67768,0.66588,0.66785,0.66932,0.66671,0.66818/ 4124.
4280     C 4125.
4281     DATA XBSLT2/ 0.62145,0.76377,0.81783,0.87743,0.92782,1.00765/ 4126.
4282     DATA YBSLT2/ 0.58466,0.73120,0.78367,0.84258,0.89259,0.96944/ 4127.
4283     DATA ZBSLT2/ 0.70368,0.69767,0.70313,0.70847,0.70983,0.71935/ 4128.
4284     C 4129.
4285     DATA XSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00414/ 4130.
4286     DATA YSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00413/ 4131.
4287     DATA ZSSALT/ 0.67233,0.68272,0.68718,0.69084,0.69334,0.69627/ 4132.
4288     C 4133.
4289     DATA XDUST1/ 1.17571,1.20282,1.13894,1.08190,1.04572,0.99864/ 4134.
4290     DATA YDUST1/ 1.04642,1.12320,1.04442,0.97057,0.93288,0.78720/ 4135.
4291     DATA ZDUST1/ 0.72235,0.68164,0.69516,0.72361,0.74315,0.80409/ 4136.
4292     C 4137.
4293     DATA XDUST2/ 1.09335,1.12888,1.09512,1.05217,1.02411,1.00081/ 4138.
4294     DATA YDUST2/ 0.83740,0.93590,0.88162,0.81721,0.78602,0.68767/ 4139.
4295     DATA ZDUST2/ 0.78776,0.76447,0.77511,0.79364,0.80840,0.85594/ 4140.
4296     C 4141.
4297     DATA XCARB1/0.74444,1.11851,1.14599,1.09902,1.05179,1.00292/ 4142.
4298     DATA YCARB1/0.53412,1.11290,1.14544,1.09899,1.05179,1.00292/ 4143.
4299     C$ DATA ZCARB1/0.75767,0.74553,0.72950,0.71977,0.71968,0.74073/ 4144.
4300     DATA ZCARB1/0.71248,0.66984,0.65284,0.64292,0.64282,0.66426/ 4144.1
4301     C 4145.
4302     DATA XCARB2/ 0.54418,0.82500,0.91922,0.97919,1.00345,0.99476/ 4146.
4303     DATA YCARB2/ 0.19636,0.34820,0.40558,0.44719,0.46860,0.48132/ 4147.
4304     DATA ZCARB2/ 0.45878,0.59691,0.65112,0.70444,0.74341,0.79820/ 4148.
4305     C 4149.
4306     DATA XWATER/ 1.10372,1.05381,1.03792,1.02265,1.01285,0.99989/ 4150.
4307     DATA YWATER/ 0.84758,1.03190,1.02896,1.02226,1.01282,0.99988/ 4151.
4308     DATA ZWATER/ 0.87621,0.84587,0.84884,0.85323,0.85888,0.86321/ 4152.
4309     C 4153.
4310     DATA XICE25/ 1.05394,1.02884,1.02030,1.01257,1.00706,0.99981/ 4154.
4311     DATA YICE25/ 0.75677,0.96035,1.00797,1.01184,1.00702,0.99981/ 4155.
4312     DATA ZICE25/ 0.92708,0.88645,0.87975,0.87906,0.87391,0.87623/ 4156.
4313     C 4157.
4314     C-----------------------------------------------------------------------4158.
4315     C THERMAL RADIATION 25 K-INTERVAL MERGED CLOUD & SURFACE ALBEDO DATA 4159.
4316     C-----------------------------------------------------------------------4160.
4317     DATA AGSIDV/ 4161.
4318     S 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4162.
4319     S 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4163.
4320     S 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4164.
4321     S 0.01757,0.02022,0.02059,0.02082, 4165.
4322     I 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4166.
4323     I 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4167.
4324     I 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4168.
4325     I 0.01757,0.02022,0.02059,0.02082, 4169.
4326     D 0.04500,0.10414,0.06739,0.08448,0.08516,0.06283,0.05230, 4170.
4327     D 0.03382,0.01901,0.01542,0.01178,0.05142,0.04835,0.05505, 4171.
4328     D 0.05600,0.05310,0.04603,0.03731,0.03472,0.03328,0.03000, 4172.
4329     D 0.16159,0.17592,0.17812,0.17927, 4173.
4330     V 25*0.0/ 4174.
4331     DATA AOCEAN/ 4175.
4332     + 0.04000,0.05965,0.06124,0.08339,0.09235,0.09510,0.09908, 4176.
4333     + 0.11117,0.12263,0.12577,0.12931,0.04700,0.06894,0.08970, 4177.
4334     + 0.09574,0.09565,0.09619,0.09672,0.09703,0.09723,0.09700, 4178.
4335     + 0.04645,0.04487,0.04482,0.04493/ 4179.
4336     C 4180.
4337     DATA CLDALB/ 4181.
4338     + 0.01332,0.08190,0.07036,0.05082,0.04486,0.04673,0.04770, 4182.
4339     + 0.05130,0.05240,0.05251,0.05259,0.01558,0.01763,0.02410, 4183.
4340     + 0.02571,0.02514,0.02448,0.02366,0.02347,0.02340,0.02294, 4184.
4341     + 0.04566,0.04499,0.04518,0.04544, 4185.
4342     + 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4186.
4343     + 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4187.
4344     + 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4188.
4345     + 0.01757,0.02022,0.02059,0.02082/ 4189.
4346     C 4190.
4347     DATA ASNALB/0.600,0.350,13*0.0/ 4191.
4348     C&& DATA ASNALB/0.550,0.300,13*0.0/
4349     C 4192.
4350     C&& DATA AOIALB/0.550,0.300,13*0.0/ 4193.
4351     DATA AOIALB/0.600,0.350,13*0.0/
4352     C 4194.
4353     DATA ALIALB/0.600,0.350,13*0.0/ 4195.
4354     C 4196.
4355     C-----------------------------------------------------------------------4197.
4356     C TRACE GAS VERTICAL DISTRIBUTION & 1958 MEAN CONCENTRATION 4198.
4357     C-----------------------------------------------------------------------4199.
4358     C 4200.
4359     DATA CMANO2/ 4201.
4360     1 8.66E-06,5.15E-06,2.85E-06,1.50E-06,9.89E-07,6.91E-07,7.17E-07, 4202.
4361     2 8.96E-07,3.67E-06,4.85E-06,5.82E-06,6.72E-06,7.77E-06,8.63E-06, 4203.
4362     3 8.77E-06,8.14E-06,6.91E-06,5.45E-06,4.00E-06,2.67E-06,1.60E-06, 4204.
4363     4 8.36E-07,3.81E-07,1.58E-07,6.35E-08,2.57E-08,1.03E-08,4.18E-09, 4205.
4364     5 1.66E-09,6.57E-10,2.58E-10,1.02E-10,4.11E-11,1.71E-11,7.73E-12, 4206.
4365     6 9.07E-12,4.63E-12,2.66E-12,1.73E-12,1.28E-12,1.02E-12,1.00E-30/ 4207.
4366     C 4208.
4367     C 4209.
4368     C GAS NUMBER 1 2 3 4 5 6 7 8 9 4210.
4369     C H2O CO2 O3 O2 NO2 N2O CH4 CCL3F1 CCL2F2 4211.
4370     C DATA FULGAS/1.0, 1.0,1.0, 1.0,1.0, 1.0, 1.0, 1.0, 1.0/4212.
4371     c DATA PPMV58/0.0,315.0,0.0,210000.,0.0,0.295,1.400,8.00E-6,25.0E-6/4213.
4372     DATA PPMV58/0.0, 0.0,0.0,210000.,0.0,4*0.0/
4373     C$ DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0, 15.0, 10.0, 12.0, 12.0/4214.
4374     DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0,915.0,910.0, 12.0, 12.0/4215.
4375     DATA ZH/ 8.0, 8.0,8.0, 8.0,8.0, 10.0, 30.0, 3.0, 3.0/4216.
4376     C 4217.
4377     C-----------------------------------------------------------------------4218.
4378     C TRACE GAS ABSORPTION COEFFICIENTS FOR F11 & F12 4219.
4379     C-----------------------------------------------------------------------4220.
4380     C 4221.
4381     DIMENSION F11PCM(25),F12PCM(25) 4222.
4382     EQUIVALENCE (TRACEG(1,1),F11PCM(1)),(TRACEG(1,2),F12PCM(1)) 4223.
4383     C 4224.
4384     C 4225.
4385     DATA F11PCM/ 4226.
4386     + 13.6000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 4227.
4387     + 0.0000, 0.0000, 0.0000, 0.0000,11.9504, 2.5138, 0.5054, 4228.
4388     + 0.1086, 0.0308, 0.0178, 0.0054, 0.0000, 0.0000, 0.0000, 4229.
4389     + 2.5220, 1.1731, 0.8627, 0.7445/ 4230.
4390     C 4231.
4391     DATA F12PCM/ 4232.
4392     + 5.4900, 1.3339, 0.7739, 0.1304, 0.0286, 0.0051, 0.0000, 4233.
4393     + 0.0000, 0.0000, 0.0000, 0.0000, 9.0745, 2.3577, 0.4135, 4234.
4394     + 0.0575, 0.0000, 0.2507, 0.6215, 0.7262, 0.7972, 0.9150, 4235.
4395     + 13.1663, 1.1564, 0.0388, 0.0082/ 4236.
4396     C 4236.11
4397     C ------------------------------------------------------------------4236.12
4398     C DECEMBER 4, 1991 UPDATE PROVIDES FOR THE FOLLOWING IMPROVEMENTS:4236.13
4399     C ------------------------------------------------------------------4236.14
4400     C IF(NEWASZ.GT.0) ALL AEROSOL SOLAR ZENITH ANGLE DEPENDENCE IMPROVED4236.15
4401     C IF(NEWAQA.GT.0) ALL AERSOL THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.16
4402     C (TRACER AEROSOLS ALREADY USE Q-ABSORPTION IN XRAD83XX) 4236.17
4403     C IF(NEWCQA.GT.0) ALL CLOUDS THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.18
4404     C ------------------------------------------------------------------4236.21
4405     C 4236.22
4406     EQUIVALENCE (ISPARE(1),NEWASZ) 4236.23
4407     EQUIVALENCE (ISPARE(2),NEWAQA) 4236.24
4408     EQUIVALENCE (ISPARE(3),NEWCQA) 4236.25
4409     C 4236.26
4410     DATA NEWASZ/0/, NEWAQA/0/, NEWCQA/0/ 4236.27
4411     C 4236.28
4412     END 4237.
4413     SUBROUTINE PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 4238.
4414     C 4239.
4415     C ------------------------------------------------------------------4240.
4416     C ------------- MCCLATCHY (1972) ATMOSPHERE DATA -----------4241.
4417     C ------------------------------------------------------------------4242.
4418     C 4243.
4419     C INPUT DATA 4244.
4420     C------------------ 4245.
4421     C NATM=0 GIVES ABREVIATED DATA FOR STANDARD ATMOSPHER4246.
4422     C (INPUT: P OR H) (RETURNS: H OR P & D,T)4247.
4423     C 4248.
4424     C NATM=1 GIVES ATMOSPHERE DATA FOR TROPICAL LATITUDES4249.
4425     C NATM=2 GIVES ATMOSPHERE DATA FOR MIDLATITUDE SUMMER4250.
4426     C NATM=3 GIVES ATMOSPHERE DATA FOR MIDLATITUDE WINTER4251.
4427     C NATM=4 GIVES ATMOSPHERE DATA FOR SUBARCTIC SUMMER 4252.
4428     C NATM=5 GIVES ATMOSPHERE DATA FOR SUBARCTIC WINTER 4253.
4429     C NATM=6 GIVES ATMOSPHERE DATA FOR STANDARD ATMOSPHER4254.
4430     C 4255.
4431     C NPHD=1 RETURNS H,D,T,O,Q,S DATA FOR GIVEN PRESSURE P4256.
4432     C NPHD=2 RETURNS P,D,T,O,Q,S DATA FOR GIVEN HEIGHT H4257.
4433     C NPHD=3 RETURNS P,H,T,O,Q,S DATA FOR GIVEN DENSITY D4258.
4434     C 4259.
4435     C OUTPUT DATA 4260.
4436     C------------------ 4261.
4437     C P = PRESSURE IN MILLIBARS 4262.
4438     C H = HEIGHT IN KILOMETERS 4263.
4439     C D = DENSITY IN GRAMS/METER**3 4264.
4440     C T = TEMPERATURE (ABSOLUTE) 4265.
4441     C O = OZONE MIXING RATIO (GRAMS OZONE)/(GRAMS AIR) 4266.
4442     C Q = SPECIFIC HUMIDITY (GRAMS WATER VAPOR)/(GRAMS AIR)4267.
4443     C S = SATURATION RATIO (GRAMS WATER VAPOR)/(GRAMS AIR) 4268.
4444     C OCM = OZONE (CM-STP) ABOVE GIVEN HEIGHT 4269.
4445     C WCM = WATER VAPOR (CM-STP) ABOVE GIVEN HEIGHT 4270.
4446     C 4271.
4447     C REMARKS 4272.
4448     C------------------ 4273.
4449     C INPUT P,H,D PARAMETERS ARE NOT ALTERED 4274.
4450     C P,D INTERPOLATION IS EXPONENTIAL WITH HEIGHT 4275.
4451     C NO EXTRAPOLATION IS MADE OUTSIDE 0-100 KM INTERVAL 4276.
4452     C S IS NOT COMPUTED ABOVE 40 KM (FORMULA NOT ACCURATE)4277.
4453     C 4278.
4454     C R = Q/S GIVES RELATIVE HUMIDITY 4279.
4455     C W = Q/(1-Q) GIVES WATER VAPOR MIXING RATIO 4280.
4456     C N = D*2.079E 16 GIVES NUMBER DENSITY PER CM**3 4281.
4457     C 4282.
4458     C 4283.
4459     C 4284.
4460     C 4285.
4461     C 4286.
4462     DIMENSION PRS1(33),PRS2(33),PRS3(33),PRS4(33),PRS5(33),PRS6(33)4287.
4463     1 ,DNS1(33),DNS2(33),DNS3(33),DNS4(33),DNS5(33),DNS6(33)4288.
4464     2 ,TMP1(33),TMP2(33),TMP3(33),TMP4(33),TMP5(33),TMP6(33)4289.
4465     3 ,WVP1(33),WVP2(33),WVP3(33),WVP4(33),WVP5(33),WVP6(33)4290.
4466     4 ,OZO1(33),OZO2(33),OZO3(33),OZO4(33),OZO5(33),OZO6(33)4291.
4467     DIMENSION PRES(33,6),DENS(33,6),TEMP(33,6),WVAP(33,6),OZON(33,6)4292.
4468     C 4293.
4469     EQUIVALENCE 4294.
4470     + (PRES(1,1),PRS1(1)),(DENS(1,1),DNS1(1)),(TEMP(1,1),TMP1(1)) 4295.
4471     + ,(PRES(1,2),PRS2(1)),(DENS(1,2),DNS2(1)),(TEMP(1,2),TMP2(1)) 4296.
4472     + ,(PRES(1,3),PRS3(1)),(DENS(1,3),DNS3(1)),(TEMP(1,3),TMP3(1)) 4297.
4473     + ,(PRES(1,4),PRS4(1)),(DENS(1,4),DNS4(1)),(TEMP(1,4),TMP4(1)) 4298.
4474     + ,(PRES(1,5),PRS5(1)),(DENS(1,5),DNS5(1)),(TEMP(1,5),TMP5(1)) 4299.
4475     + ,(PRES(1,6),PRS6(1)),(DENS(1,6),DNS6(1)),(TEMP(1,6),TMP6(1)) 4300.
4476     EQUIVALENCE (WVAP(1,1),WVP1(1)),(OZON(1,1),OZO1(1)) 4301.
4477     EQUIVALENCE (WVAP(1,2),WVP2(1)),(OZON(1,2),OZO2(1)) 4302.
4478     EQUIVALENCE (WVAP(1,3),WVP3(1)),(OZON(1,3),OZO3(1)) 4303.
4479     EQUIVALENCE (WVAP(1,4),WVP4(1)),(OZON(1,4),OZO4(1)) 4304.
4480     EQUIVALENCE (WVAP(1,5),WVP5(1)),(OZON(1,5),OZO5(1)) 4305.
4481     EQUIVALENCE (WVAP(1,6),WVP6(1)),(OZON(1,6),OZO6(1)) 4306.
4482     C 4307.
4483     C 4308.
4484     DIMENSION HTKM(33) 4309.
4485     DATA HTKM/1.0E-09, 1., 2., 3., 4., 5., 6., 7., 8., 9.,10.,11. 4310.
4486     1 ,12.,13.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24. 4311.
4487     2 ,25.,30.,35.,40.,45.,50.,70.,99.9/ 4312.
4488     C 4313.
4489     C 4314.
4490     C---------------------------------------------------------------------- 4315.
4491     C0000 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4316.
4492     C---------------------------------------------------------------------- 4317.
4493     C 4318.
4494     DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 4319.
4495     DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 4320.
4496     + ,3.7338E-03/ 4321.
4497     DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/4322.
4498     DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 4323.
4499     DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 4324.
4500     DATA HPCON/34.16319/ 4325.
4501     C 4326.
4502     C 4327.
4503     C-----------------------------------------------------------------------4328.
4504     C1111 TROPICAL LATITUDES MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4329.
4505     C-----------------------------------------------------------------------4330.
4506     C 4331.
4507     DATA PRS1/ 1.013E 03,9.040E 02,8.050E 02,7.150E 02,6.330E 02,4332.
4508     1 5.590E 02,4.920E 02,4.320E 02,3.780E 02,3.290E 02,2.860E 02,4333.
4509     2 2.470E 02,2.130E 02,1.820E 02,1.560E 02,1.320E 02,1.110E 02,4334.
4510     3 9.370E 01,7.890E 01,6.660E 01,5.650E 01,4.800E 01,4.090E 01,4335.
4511     4 3.500E 01,3.000E 01,2.570E 01,1.220E 01,6.000E 00,3.050E 00,4336.
4512     5 1.590E 00,8.540E-01,5.790E-02,3.000E-04/ 4337.
4513     DATA DNS1/ 1.167E 03,1.064E 03,9.689E 02,8.756E 02,7.951E 02,4338.
4514     1 7.199E 02,6.501E 02,5.855E 02,5.258E 02,4.708E 02,4.202E 02,4339.
4515     2 3.740E 02,3.316E 02,2.929E 02,2.578E 02,2.260E 02,1.972E 02,4340.
4516     3 1.676E 02,1.382E 02,1.145E 02,9.515E 01,7.938E 01,6.645E 01,4341.
4517     4 5.618E 01,4.763E 01,4.045E 01,1.831E 01,8.600E 00,4.181E 00,4342.
4518     5 2.097E 00,1.101E 00,9.210E-02,5.000E-04/ 4343.
4519     DATA TMP1/ 300.0,294.0,288.0,284.0,277.0,270.0,264.0,257.0,250.0,4344.
4520     1244.0,237.0,230.0,224.0,217.0,210.0,204.0,197.0,195.0,199.0,203.0,4345.
4521     2207.0,211.0,215.0,217.0,219.0,221.0,232.0,243.0,254.0,265.0,270.0,4346.
4522     3 219.0,210.0/ 4347.
4523     DATA WVP1/1.9E 01,1.3E 01,9.3E 00,4.7E 00,2.2E 00,1.5E 00,8.5E-01,4348.
4524     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.
4525     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.
4526     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.
4527     4 1.4E-07,1.0E-09/ 4352.
4528     DATA OZO1/5.6E-05,5.6E-05,5.4E-05,5.1E-05,4.7E-05,4.5E-05,4.3E-05,4353.
4529     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.
4530     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.
4531     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.
4532     4 8.6E-08,4.3E-11/ 4357.
4533     C 4358.
4534     C-----------------------------------------------------------------------4359.
4535     C2222 MIDLATITUDE SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4360.
4536     C-----------------------------------------------------------------------4361.
4537     C 4362.
4538     DATA PRS2/ 1.013E 03,9.020E 02,8.020E 02,7.100E 02,6.280E 02,4363.
4539     1 5.540E 02,4.870E 02,4.260E 02,3.720E 02,3.240E 02,2.810E 02,4364.
4540     2 2.430E 02,2.090E 02,1.790E 02,1.530E 02,1.300E 02,1.110E 02,4365.
4541     3 9.500E 01,8.120E 01,6.950E 01,5.950E 01,5.100E 01,4.370E 01,4366.
4542     4 3.760E 01,3.220E 01,2.770E 01,1.320E 01,6.520E 00,3.330E 00,4367.
4543     5 1.760E 00,9.510E-01,6.710E-02,3.000E-04/ 4368.
4544     DATA DNS2/ 1.191E 03,1.080E 03,9.757E 02,8.846E 02,7.998E 02,4369.
4545     1 7.211E 02,6.487E 02,5.830E 02,5.225E 02,4.669E 02,4.159E 02,4370.
4546     2 3.693E 02,3.269E 02,2.882E 02,2.464E 02,2.104E 02,1.797E 02,4371.
4547     3 1.535E 02,1.305E 02,1.110E 02,9.453E 01,8.056E 01,6.872E 01,4372.
4548     4 5.867E 01,5.014E 01,4.288E 01,1.322E 01,6.519E 00,3.330E 00,4373.
4549     5 1.757E 00,9.512E-01,6.706E-02,5.000E-04/ 4374.
4550     DATA TMP2/ 294.0,290.0,285.0,279.0,273.0,267.0,261.0,255.0,248.0,4375.
4551     1242.0,235.0,229.0,222.0,216.0,216.0,216.0,216.0,216.0,216.0,217.0,4376.
4552     2218.0,219.0,220.0,222.0,223.0,224.0,234.0,245.0,258.0,270.0,276.0,4377.
4553     3 218.0,210.0/ 4378.
4554     DATA WVP2/1.4E 01,9.3E 00,5.9E 00,3.3E 00,1.9E 00,1.0E 00,6.1E-01,4379.
4555     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.
4556     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.
4557     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.
4558     4 1.4E-07,1.0E-09/ 4383.
4559     DATA OZO2/6.0E-05,6.0E-05,6.0E-05,6.2E-05,6.4E-05,6.6E-05,6.9E-05,4384.
4560     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.
4561     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.
4562     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.
4563     4 8.6E-08,4.3E-11/ 4388.
4564     C 4389.
4565     C-----------------------------------------------------------------------4390.
4566     C3333 MIDLATITUDE WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4391.
4567     C-----------------------------------------------------------------------4392.
4568     C 4393.
4569     DATA PRS3/ 1.018E 03,8.973E 02,7.897E 02,6.938E 02,6.081E 02,4394.
4570     1 5.313E 02,4.627E 02,4.016E 02,3.473E 02,2.992E 02,2.568E 02,4395.
4571     2 2.199E 02,1.882E 02,1.610E 02,1.378E 02,1.178E 02,1.007E 02,4396.
4572     3 8.610E 01,7.350E 01,6.280E 01,5.370E 01,4.580E 01,3.910E 01,4397.
4573     4 3.340E 01,2.860E 01,2.430E 01,1.110E 01,5.180E 00,2.530E 00,4398.
4574     5 1.290E 00,6.820E-01,4.670E-02,3.000E-04/ 4399.
4575     DATA DNS3/ 1.301E 03,1.162E 03,1.037E 03,9.230E 02,8.282E 02,4400.
4576     1 7.411E 02,6.614E 02,5.886E 02,5.222E 02,4.619E 02,4.072E 02,4401.
4577     2 3.496E 02,2.999E 02,2.572E 02,2.206E 02,1.890E 02,1.620E 02,4402.
4578     3 1.388E 02,1.188E 02,1.017E 02,8.690E 01,7.421E 01,6.338E 01,4403.
4579     4 5.415E 01,4.624E 01,3.950E 01,1.783E 01,7.924E 00,3.625E 00,4404.
4580     5 1.741E 00,8.954E-01,7.051E-02,5.000E-04/ 4405.
4581     DATA TMP3/ 272.2,268.7,265.2,261.7,255.7,249.7,243.7,237.7,231.7,4406.
4582     1225.7,219.7,219.2,218.7,218.2,217.7,217.2,216.7,216.2,215.7,215.2,4407.
4583     2215.2,215.2,215.2,215.2,215.2,215.2,217.4,227.8,243.2,258.5,265.7,4408.
4584     3 230.7,210.2/ 4409.
4585     DATA WVP3/3.5E 00,2.5E 00,1.8E 00,1.2E 00,6.6E-01,3.8E-01,2.1E-01,4410.
4586     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.
4587     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.
4588     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.
4589     4 1.4E-07,1.0E-09/ 4414.
4590     DATA OZO3/6.0E-05,5.4E-05,4.9E-05,4.9E-05,4.9E-05,5.8E-05,6.4E-05,4415.
4591     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.
4592     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.
4593     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.
4594     4 8.6E-08,4.3E-11/ 4419.
4595     C 4420.
4596     C-----------------------------------------------------------------------4421.
4597     C4444 SUBARCTIC SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4422.
4598     C-----------------------------------------------------------------------4423.
4599     C 4424.
4600     DATA PRS4/ 1.010E 03,8.960E 02,7.929E 02,7.000E 02,6.160E 02,4425.
4601     1 5.410E 02,4.730E 02,4.130E 02,3.590E 02,3.107E 02,2.677E 02,4426.
4602     2 2.300E 02,1.977E 02,1.700E 02,1.460E 02,1.250E 02,1.080E 02,4427.
4603     3 9.280E 01,7.980E 01,6.860E 01,5.890E 01,5.070E 01,4.360E 01,4428.
4604     4 3.750E 01,3.227E 01,2.780E 01,1.340E 01,6.610E 00,3.400E 00,4429.
4605     5 1.810E 00,9.870E-01,7.070E-02,3.000E-04/ 4430.
4606     DATA DNS4/ 1.220E 03,1.110E 03,9.971E 02,8.985E 02,8.077E 02,4431.
4607     1 7.244E 02,6.519E 02,5.849E 02,5.231E 02,4.663E 02,4.142E 02,4432.
4608     2 3.559E 02,3.059E 02,2.630E 02,2.260E 02,1.943E 02,1.671E 02,4433.
4609     3 1.436E 02,1.235E 02,1.062E 02,9.128E 01,7.849E 01,6.750E 01,4434.
4610     4 5.805E 01,4.963E 01,4.247E 01,1.338E 01,6.614E 00,3.404E 00,4435.
4611     5 1.817E 00,9.868E-01,7.071E-02,5.000E-04/ 4436.
4612     DATA TMP4/ 287.0,282.0,276.0,271.0,266.0,260.0,253.0,246.0,239.0,4437.
4613     1232.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,4438.
4614     2225.0,225.0,225.0,225.0,226.0,228.0,235.0,247.0,262.0,274.0,277.0,4439.
4615     3 216.0,210.0/ 4440.
4616     DATA WVP4/9.1E 00,6.0E 00,4.2E 00,2.7E 00,1.7E 00,1.0E 00,5.4E-01,4441.
4617     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.
4618     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.
4619     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.
4620     4 1.4E-07,1.0E-09/ 4445.
4621     DATA OZO4/4.9E-05,5.4E-05,5.6E-05,5.8E-05,6.0E-05,6.4E-05,7.1E-05,4446.
4622     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.
4623     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.
4624     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.
4625     4 8.6E-08,4.3E-11/ 4450.
4626     C 4451.
4627     C-----------------------------------------------------------------------4452.
4628     C5555 SUBARCTIC WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4453.
4629     C-----------------------------------------------------------------------4454.
4630     C 4455.
4631     DATA PRS5/ 1.013E 03,8.878E 02,7.775E 02,6.798E 02,5.932E 02,4456.
4632     1 5.158E 02,4.467E 02,3.853E 02,3.308E 02,2.829E 02,2.418E 02,4457.
4633     2 2.067E 02,1.766E 02,1.510E 02,1.291E 02,1.103E 02,9.431E 01,4458.
4634     3 8.058E 01,6.882E 01,5.875E 01,5.014E 01,4.277E 01,3.647E 01,4459.
4635     4 3.109E 01,2.649E 01,2.256E 01,1.020E 01,4.701E 00,2.243E 00,4460.
4636     5 1.113E 00,5.719E-01,4.016E-02,3.000E-04/ 4461.
4637     DATA DNS5/ 1.372E 03,1.193E 03,1.058E 03,9.366E 02,8.339E 02,4462.
4638     1 7.457E 02,6.646E 02,5.904E 02,5.226E 02,4.538E 02,3.879E 02,4463.
4639     2 3.315E 02,2.834E 02,2.422E 02,2.071E 02,1.770E 02,1.517E 02,4464.
4640     3 1.300E 02,1.113E 02,9.529E 01,8.155E 01,6.976E 01,5.966E 01,4465.
4641     4 5.100E 01,4.358E 01,3.722E 01,1.645E 01,7.368E 00,3.330E 00,4466.
4642     5 1.569E 00,7.682E-01,5.695E-02,5.000E-04/ 4467.
4643     DATA TMP5/ 257.1,259.1,255.9,252.7,247.7,240.9,234.1,227.3,220.6,4468.
4644     1217.2,217.2,217.2,217.2,217.2,217.2,217.2,216.6,216.0,215.4,214.8,4469.
4645     2214.1,213.6,213.0,212.4,211.8,211.2,216.0,222.2,234.7,247.0,259.3,4470.
4646     3 245.7,210.0/ 4471.
4647     DATA WVP5/1.2E 00,1.2E 00,9.4E-01,6.8E-01,4.1E-01,2.0E-01,9.8E-02,4472.
4648     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.
4649     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.
4650     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.
4651     4 1.4E-07,1.0E-09/ 4476.
4652     DATA OZO5/4.1E-05,4.1E-05,4.1E-05,4.3E-05,4.5E-05,4.7E-05,4.9E-05,4477.
4653     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.
4654     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.
4655     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.
4656     4 8.6E-08,4.3E-11/ 4481.
4657     C 4482.
4658     C---------------------------------------------------------------------- 4483.
4659     C6666 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4484.
4660     C---------------------------------------------------------------------- 4485.
4661     C 4486.
4662     DATA PRS6/ 1.01325E+03,8.987E+02,7.950E+02,7.011E+02,6.164E+02,4487.
4663     1 5.402E+02,4.718E+02,4.106E+02,3.560E+02,3.074E+02,2.644E+02,4488.
4664     2 2.263E+02,1.933E+02,1.651E+02,1.410E+02,1.204E+02,1.029E+02,4489.
4665     3 8.787E+01,7.505E+01,6.410E+01,5.475E+01,4.678E+01,4.000E+01,4490.
4666     4 3.422E+01,2.931E+01,2.511E+01,1.172E+01,5.589E+00,2.775E+00,4491.
4667     5 1.431E+00,7.594E-01,4.634E-02,2.384E-04/ 4492.
4668     DATA DNS6/ 1.225E+03,1.112E+03,1.006E+03,9.091E+02,8.191E+02,4493.
4669     1 7.361E+02,6.597E+02,5.895E+02,5.252E+02,4.663E+02,4.127E+02,4494.
4670     2 3.639E+02,3.108E+02,2.655E+02,2.268E+02,1.937E+02,1.654E+02,4495.
4671     3 1.413E+02,1.207E+02,1.031E+02,8.803E+01,7.487E+01,6.373E+01,4496.
4672     4 5.428E+01,4.627E+01,3.947E+01,1.801E+01,8.214E+00,3.851E+00,4497.
4673     5 1.881E+00,9.775E-01,7.424E-02,4.445E-04/ 4498.
4674     DATA TMP6/ 4499.
4675     1 288.150,281.650,275.150,268.650,262.150,255.650,249.150, 4500.
4676     2 242.650,236.150,229.650,223.150,216.650,216.650,216.650, 4501.
4677     3 216.650,216.650,216.650,216.650,216.650,216.650,216.650, 4502.
4678     4 217.650,218.650,219.650,220.650,221.650,226.650,237.050, 4503.
4679     5 251.050,265.050,270.650,217.450,186.870/ 4504.
4680     DATA WVP6/ 1.083E+01,6.323E+00,3.612E+00,2.015E+00,1.095E+00,4505.
4681     1 5.786E-01,2.965E-01,1.469E-01,7.021E-02,3.226E-02,1.419E-02,4506.
4682     2 5.956E-03,5.002E-03,4.186E-03,3.490E-03,2.896E-03,2.388E-03,4507.
4683     3 1.954E-03,1.583E-03,1.267E-03,9.967E-04,8.557E-04,7.104E-04,4508.
4684     4 5.600E-04,4.037E-04,2.406E-04,5.404E-05,2.464E-05,1.155E-05,4509.
4685     5 5.644E-06,2.932E-06,2.227E-07,1.334E-09/ 4510.
4686     DATA OZO6/ 7.526E-05,3.781E-05,6.203E-05,3.417E-05,5.694E-05,4511.
4687     1 3.759E-05,5.970E-05,4.841E-05,7.102E-05,6.784E-05,9.237E-05,4512.
4688     2 9.768E-05,1.251E-04,1.399E-04,1.715E-04,1.946E-04,2.300E-04,4513.
4689     3 2.585E-04,2.943E-04,3.224E-04,3.519E-04,3.714E-04,3.868E-04,4514.
4690     4 3.904E-04,3.872E-04,3.728E-04,2.344E-04,9.932E-05,3.677E-05,4515.
4691     5 1.227E-05,4.324E-06,5.294E-08,1.262E-10/ 4516.
4692     C 4517.
4693     C 4518.
4694     IF(NATM.GT.0) GO TO 200 4519.
4695     O=1.E-10 4520.
4696     Q=1.E-10 4521.
4697     S=1.E-10 4522.
4698     OCM=1.E-10 4523.
4699     WCM=1.E-10 4524.
4700     IF(NPHD.LT.2) GO TO 150 4525.
4701     DO 110 N=2,8 4526.
4702     IF(H.LT.SHLB(N)) GO TO 120 4527.
4703     110 CONTINUE 4528.
4704     N=9 4529.
4705     120 N=N-1 4530.
4706     IF(ABS(SDLB(N)).LT.1.E-04) GO TO 130 4531.
4707     P=SPLB(N)*(1.+SDLB(N)/STLB(N)*(H-SHLB(N)))**(-HPCON/SDLB(N)) 4532.
4708     GO TO 140 4533.
4709     130 P=SPLB(N)*EXP(-HPCON/STLB(N)*(H-SHLB(N))) 4534.
4710     140 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4535.
4711     D=P/T*28.9644E 05/8.31432E 03 4536.
4712     RETURN 4537.
4713     C 4538.
4714     150 CONTINUE 4539.
4715     DO 160 N=2,8 4540.
4716     160 IF(P.GT.SPLB(N)) GO TO 170 4541.
4717     N=9 4542.
4718     170 N=N-1 4543.
4719     IF(ABS(SDLB(N)).LT.1.E-04) GO TO 180 4544.
4720     H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 4545.
4721     GO TO 190 4546.
4722     C ALOG
4723     180 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 4547.
4724     C ALOG
4725     190 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4548.
4726     D=P/T*28.9644E 05/8.31432E 03 4549.
4727     RETURN 4550.
4728     C 4551.
4729     200 CONTINUE 4552.
4730     IF(NPHD.EQ.1) GO TO 240 4553.
4731     IF(NPHD.EQ.2) GO TO 220 4554.
4732     XX=D 4555.
4733     XI=DENS(1,NATM) 4556.
4734     IF(D.GT.XI) XX=XI 4557.
4735     IF(D.LT.5.0E-04) GO TO 280 4558.
4736     DO 210 J=2,33 4559.
4737     XJ=DENS(J,NATM) 4560.
4738     IF(XX.GT.XJ) GO TO 260 4561.
4739     210 XI=XJ 4562.
4740     220 XX=H 4563.
4741     XI=HTKM(1) 4564.
4742     IF(H.LT.XI) XX=XI 4565.
4743     IF(H.GT.99.9) GO TO 280 4566.
4744     DO 230 J=2,33 4567.
4745     XJ=HTKM(J) 4568.
4746     IF(XX.LT.XJ) GO TO 260 4569.
4747     230 XI=XJ 4570.
4748     240 XX=P 4571.
4749     XI=PRES(1,NATM) 4572.
4750     IF(P.GT.XI) XX=XI 4573.
4751     IF(P.LT.3.0E-04) GO TO 280 4574.
4752     DO 250 J=2,33 4575.
4753     XJ=PRES(J,NATM) 4576.
4754     IF(XX.GT.XJ) GO TO 260 4577.
4755     250 XI=XJ 4578.
4756     260 DELTA=(XX-XI)/(XJ-XI) 4579.
4757     I=J-1 4580.
4758     C ALOG
4759     IF(NPHD.NE.2) H=HTKM(I)+(HTKM(J)-HTKM(I))*LOG(XX/XI)/LOG(XJ/XI) 4581.
4760     C ALOG
4761     PI=PRES(I,NATM) 4582.
4762     PJ=PRES(J,NATM) 4583.
4763     DI=DENS(I,NATM) 4584.
4764     DJ=DENS(J,NATM) 4585.
4765     IF(NPHD.NE.1) P=PI+DELTA*(PJ-PI) 4586.
4766     IF(NPHD.NE.3) D=DI+DELTA*(DJ-DI) 4587.
4767     T=TEMP(I,NATM)+DELTA*(TEMP(J,NATM)-TEMP(I,NATM)) 4588.
4768     O=OZON(I,NATM)/DI+DELTA*(OZON(J,NATM)/DJ-OZON(I,NATM)/DI) 4589.
4769     Q=WVAP(I,NATM)/DI+DELTA*(WVAP(J,NATM)/DJ-WVAP(I,NATM)/DI) 4590.
4770     ES=10.**(9.4051-2353./T) 4591.
4771     IF(P.LT.PI) PI=P 4592.
4772     S=1.E+06 4593.
4773     RS=(PI-ES+0.622*ES)/(0.622*ES) 4594.
4774     IF(RS.GT.1.E-06) S=1./RS 4595.
4775     OI=O 4596.
4776     QI=Q 4597.
4777     OCM=0. 4598.
4778     WCM=0. 4599.
4779     DO 270 K=J,33 4600.
4780     PJ=PRES(K,NATM) 4601.
4781     DJ=DENS(K,NATM) 4602.
4782     OJ=OZON(K,NATM)/DJ 4603.
4783     QJ=WVAP(K,NATM)/DJ 4604.
4784     DP=PI-PJ 4605.
4785     OCM=OCM+0.5*(OI+OJ)*DP 4606.
4786     WCM=WCM+0.5*(QI+QJ)*DP 4607.
4787     OI=OJ 4608.
4788     QI=QJ 4609.
4789     270 PI=PJ 4610.
4790     WCM=WCM/0.980*22420.7/18.0 4611.
4791     OCM=OCM/0.980*22420.7/48.0 4612.
4792     RETURN 4613.
4793     280 T=210.0 4614.
4794     IF(NATM.EQ.6) T=186.87 4615.
4795     O=1.E-10 4616.
4796     Q=1.E-10 4617.
4797     S=1.E-10 4618.
4798     OCM=1.E-10 4619.
4799     WCM=1.E-10 4620.
4800     IF(NPHD.NE.1) P=1.E-05 4621.
4801     IF(NPHD.NE.2) H=99.99 4622.
4802     IF(NPHD.NE.3) D=2.E-05 4623.
4803     RETURN 4624.
4804     END 4625.
4805     FUNCTION PFOFTK(WAVNA,WAVNB,TK) 4626.
4806     C ------------------------------------------------------------------4627.
4807     C 4628.
4808     C INPUT DATA 4629.
4809     C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4630.
4810     C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4631.
4811     C 4632.
4812     C TK ABSOLUTE TEMPERATURE IN DEGREES KELVIN 4633.
4813     C 4634.
4814     C OUTPUT DATA 4635.
4815     C PFOFTK PLANCK FLUX (W/M**2) 4636.
4816     C 4637.
4817     C 4638.
4818     C REMARKS 4639.
4819     C PLANCK INTENSITY (W/M**2/STER) IS GIVEN BY PFOFTK/PI4640.
4820     C 4641.
4821     C ------------------------------------------------------------------4642.
4822     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4643.
4823     DIMENSION BN(21),BD(21) 4644.
4824     DATA BN/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,5.D0,-691.D0,7.D0 4645.
4825     1,-3617.D0,43867.D0,-174611.D0,854513.D0,-236364091.D0 4646.
4826     2,8553103.D0,-23749461029.D0,8615841276005.D0,-7709321041217.D0 4647.
4827     3,2577687858367.D0,-2631527155305348D 04,2929993913841559D0/ 4648.
4828     DATA BD/1.D0,2.D0,6.D0,30.D0,42.D0,30.D0,66.D0,2730.D0,6.D0 4649.
4829     1,510.D0,798.D0,330.D0,138.D0,2730.D0,6.D0,870.D0,14322.D0 4650.
4830     2,510.D0,6.D0,1919190.D0,6.D0/ 4651.
4831     DATA PI4/97.40909103400244D0/ 4652.
4832     C DATA PI/3.141592653589793D0/ 4653.
4833     DATA HCK/1.43879D0/ 4654.
4834     DATA DGXLIM/1.D-06/ 4655.
4835     PFOFTK=0.D0 4656.
4836     IF(TK.LT.1.D-06) RETURN 4657.
4837     DO 160 II=1,2 4658.
4838     IF(II.EQ.1) X=HCK*WAVNA/TK 4659.
4839     IF(II.EQ.2) X=HCK*WAVNB/TK 4660.
4840     IF(X.GT.2.3D0) GO TO 120 4661.
4841     XX=X*X 4662.
4842     GSUM=1.D0/3.D0-X/8.D0+XX/60.D0 4663.
4843     NB=3 4664.
4844     XNF=XX/2.D0 4665.
4845     DO 100 N=4,38,2 4666.
4846     NB=NB+1 4667.
4847     NNB=NB 4668.
4848     B=BN(NB)/BD(NB) 4669.
4849     XN3=N+3 4670.
4850     XNM=N*(N-1) 4671.
4851     XNF=XNF*(XX/XNM) 4672.
4852     DG=B/XN3*XNF 4673.
4853     GSUM=GSUM+DG 4674.
4854     DGB=DG 4675.
4855     IF(DABS(DG).LT.DGXLIM) GO TO 110 4676.
4856     100 CONTINUE 4677.
4857     110 GX=GSUM*XX*X 4678.
4858     GO TO 150 4679.
4859     120 GSUM=PI4/15.D0 4680.
4860     DO 130 N=1,20 4681.
4861     NNB=N 4682.
4862     XN=N 4683.
4863     XNN=XN*XN 4684.
4864     XNX=XN*X 4685.
4865     IF(XNX.GT.100.D0) GO TO 140 4686.
4866     GTERM=(X*X*(3.D0+XNX)+6.D0*(1.D0+XNX)/XNN)/XNN 4687.
4867     DG=GTERM*DEXP(-XNX) 4688.
4868     GSUM=GSUM-DG 4689.
4869     DGB=DG 4690.
4870     IF(DG.LT.DGXLIM) GO TO 140 4691.
4871     130 CONTINUE 4692.
4872     140 GX=GSUM 4693.
4873     150 CONTINUE 4694.
4874     IF(II.EQ.1) GXA=GX 4695.
4875     IF(II.EQ.2) GXB=GX 4696.
4876     160 CONTINUE 4697.
4877     PNORM=15.D0/PI4 4698.
4878     PFOFTK=DABS(GXB-GXA)*PNORM 4699.
4879     PFOFTK=PFOFTK*5.6692D-08*TK**4 4700.
4880     RETURN 4701.
4881     END 4702.
4882     FUNCTION TKOFPF(WAVNA,WAVNB,FLUXAB) 4703.
4883     C ------------------------------------------------------------------4704.
4884     C 4705.
4885     C INPUT DATA 4706.
4886     C------------------ 4707.
4887     C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4708.
4888     C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4709.
4889     C FLUXAB PLANCK FLUX (W/M**2) IN INTERVAL 4710.
4890     C (WAVNA,WAVNB) 4711.
4891     C 4712.
4892     C OUTPUT DATA 4713.
4893     C------------------ 4714.
4894     C TK BRIGHTNESS TEMPERATURE IN DEGREES KELVIN4715.
4895     C 4716.
4896     C 4717.
4897     C REMARKS 4718.
4898     C------------------ 4719.
4899     C TKOFPF IS INVERSE FUNCTION OF PFOFTK(WAVNA,WAVNB,TK)4720.
4900     C THE OUTPUT OF TKOFPF SATISFIES THE IDENTITY 4721.
4901     C FLUXAB=PFOFTK(WAVNA,WAVNB,TK) 4722.
4902     C (UNITS FOR FLUXAB AND PFOFTK MUST BE IDENTICAL) 4723.
4903     C 4724.
4904     C ------------------------------------------------------------------4725.
4905     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4726.
4906     LOGICAL LOGFIT 4727.
4907     DATA DELFIT/1.D-06/ 4728.
4908     DATA NMAX/20/ 4729.
4909     C IF(FLUXAB.LE.0.D0) RETURN 4730.
4910     LOGFIT=.FALSE. 4731.
4911     NFIT=0 4732.
4912     PF=FLUXAB 4733.
4913     XA=0.D0 4734.
4914     YA=0.D0 4735.
4915     XB=250.D0 4736.
4916     YB=PFOFTK(WAVNA,WAVNB,XB) 4737.
4917     XX=PF*XB/YB 4738.
4918     YY=PFOFTK(WAVNA,WAVNB,XX) 4739.
4919     IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4740.
4920     IF((YY/PF).LT.0.5D0) GO TO 150 4741.
4921     IF((YY/PF).GT.2.0D0) GO TO 170 4742.
4922     IF(XX.GT.XB) GO TO 110 4743.
4923     XC=XB 4744.
4924     YC=YB 4745.
4925     XB=XX 4746.
4926     YB=YY 4747.
4927     GO TO 120 4748.
4928     110 XC=XX 4749.
4929     YC=YY 4750.
4930     120 XBA=XB-XA 4751.
4931     XCA=XC-XA 4752.
4932     XBC=XB-XC 4753.
4933     YBA=YB-YA 4754.
4934     YCA=YC-YA 4755.
4935     YBC=YB-YC 4756.
4936     NFIT=NFIT+1 4757.
4937     IF(NFIT.GT.NMAX) GO TO 200 4758.
4938     YXBA=YBA/XBA 4759.
4939     YXCA=YCA/XCA 4760.
4940     C=(YXBA-YXCA)/XBC 4761.
4941     B=YXBA-(XB+XA)*C 4762.
4942     A=YA-XA*(B+XA*C) 4763.
4943     ROOT=DSQRT(B*B+4.D0*C*(PF-A)) 4764.
4944     XX=0.5D0*(ROOT-B)/C 4765.
4945     IF(XX.LT.XA.OR.XX.GT.XC) XX=-0.5D0*(ROOT+B)/C 4766.
4946     YY=PFOFTK(WAVNA,WAVNB,XX) 4767.
4947     IF(LOGFIT) YY=DLOG(YY) 4768.
4948     IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4769.
4949     IF(XX.GT.XB) GO TO 130 4770.
4950     XC=XB 4771.
4951     YC=YB 4772.
4952     GO TO 140 4773.
4953     130 XA=XB 4774.
4954     YA=YB 4775.
4955     140 XB=XX 4776.
4956     YB=YY 4777.
4957     GO TO 120 4778.
4958     150 XA=XX 4779.
4959     YA=YY 4780.
4960     160 XC=XB 4781.
4961     YC=YB 4782.
4962     XB=XB/2.D0 4783.
4963     YB=PFOFTK(WAVNA,WAVNB,XB) 4784.
4964     IF(YB.LT.YA) GO TO 190 4785.
4965     IF(YB.GT.PF) GO TO 160 4786.
4966     XA=XB 4787.
4967     YA=YB 4788.
4968     GO TO 190 4789.
4969     170 XC=XX 4790.
4970     YC=YY 4791.
4971     180 XA=XB 4792.
4972     YA=YB 4793.
4973     XB=XB*2.D0 4794.
4974     YB=PFOFTK(WAVNA,WAVNB,XB) 4795.
4975     IF(YB.GT.YC) GO TO 190 4796.
4976     IF(YB.LT.PF) GO TO 180 4797.
4977     XC=XB 4798.
4978     YC=YB 4799.
4979     190 XB=XA+(PF-YA)*(XC-XA)/(YC-YA) 4800.
4980     YB=PFOFTK(WAVNA,WAVNB,XB) 4801.
4981     XX=XB 4802.
4982     IF(DABS(YB-PF).LT.DELFIT) GO TO 200 4803.
4983     PF=DLOG(PF) 4804.
4984     YA=DLOG(YA) 4805.
4985     YB=DLOG(YB) 4806.
4986     YC=DLOG(YC) 4807.
4987     LOGFIT=.TRUE. 4808.
4988     GO TO 120 4809.
4989     200 TKOFPF=XX 4810.
4990     RETURN 4811.
4991     END 4812.
4992     SUBROUTINE WRITER(INDEX,KPAGE) 4813.
4993    
4994     #include "B83XX.COM"
4995    
4996     DIMENSION SRAOC(15),SRAEA(15),SRAOI(15),SRALI(15),SRASN(15) 4875.
4997     C 4876.
4998     DIMENSION SRBALB(6),SRXALB(6) 4877.
4999     EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 4878.
5000     C 4879.
5001     +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 4880.
5002     +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 4881.
5003     C 4882.
5004     EQUIVALENCE (ASNALB(1),ASNVIS),(ASNALB(2),ASNNIR) 4883.
5005     EQUIVALENCE (AOIALB(1),AOIVIS),(AOIALB(2),AOINIR) 4884.
5006     EQUIVALENCE (ALIALB(1),ALIVIS),(ALIALB(2),ALINIR) 4885.
5007     C 4886.
5008     EQUIVALENCE 4887.
5009     + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 4888.
5010     +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 4889.
5011     +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 4890.
5012     +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 4891.
5013     +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 4892.
5014     +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 4893.
5015     C 4894.
5016     EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 4895.
5017     EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 4896.
5018     C 4897.
5019     EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 4898.
5020     EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 4899.
5021     C 4900.
5022     EQUIVALENCE (PVT( 1),DESRT),(PVT( 2),TNDRA),(PVT( 3),GRASS) 4901.
5023     + ,(PVT( 4),SHRUB),(PVT( 5),TREES),(PVT( 6),DECID) 4902.
5024     + ,(PVT( 7),EVERG),(PVT( 8),RAINF),(PVT( 9),ROCKS) 4903.
5025     + ,(PVT(10),CROPS),(PVT(11),ALGAE) 4904.
5026     C 4905.
5027     EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 4906.
5028     + ,(FRC(4), FCLO),(FRC(5), FCOV) 4907.
5029     C 4908.
5030     C 4909.
5031     CHARACTER*8 FTYPE 4910.
5032     DIMENSION BGFLUX(25),BGFRAC(25),TAUSUM(25) 4911.
5033     DIMENSION SUM0(15),SUM1(40),SUM2(40),SUM3(40),FTYPE(5),AUXGAS(4) 4912.
5034     DATA FTYPE/'DOWNWARD',' UPWARD','UPWD NET','COOLRATE','FRACTION'/4913.
5035     DATA AUXGAS/1H0,1HL,1HX,1HX/ 4914.
5036     DATA P0/1013.25/ 4915.
5037     C 4916.
5038     INDJ=MOD(INDEX,10) 4917.
5039     IF(INDJ.LT.1) INDJ=10 4918.
5040     INDI=1 4919.
5041     IF(INDEX.LT.11) INDI=INDJ 4920.
5042     DO 9999 INDX=INDI,INDJ 4921.
5043     C 4922.
5044     IF(INDEX.EQ.0) GO TO 10 4923.
5045     GO TO (100,200,300,400,500,600,700,800,900,1000),INDX 4924.
5046     C 4925.
5047     C------------- 4926.
5048     10 CONTINUE 4927.
5049     C------------- 4928.
5050     C 4929.
5051     NPAGE=1 4930.
5052     WRITE(6,6001) NPAGE 4931.
5053     6001 FORMAT(1I1,'(1) RADCOM M/R: (CONTROL/INPUT PARAMETERS)' 4932.
5054     + ,' DEFAULT VALUES & MODIFICATIONS'/) 4933.
5055     WRITE(6,6002) 4934.
5056     6002 FORMAT(20X,'PARAMETER/VALUE',5X,'COMMENTS RE PARAMETER DEFAULT' 4935.
5057     + ,' VALUE AND PARAMETER RANGE AND EFFECT'/10X,'AEROSOLS') 4936.
5058     WRITE(6,6003) 4937.
5059     6003 FORMAT(20X,'FGOLDH(1) = 1.0',5X,'STRATOSPHERIC AEROSOL, GLOBAL' 4938.
5060     + ,' BACKGROUND - TAU(.55) = 0.005' 4939.
5061     + /20X,'FGOLDH(2) = 1.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4940.
5062     + ,' BACKGROUND: TAU(.55) = 0.125' 4941.
5063     + /20X,'FGOLDH(3) = 0.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4942.
5064     + ,' BACKGROUND: TAU(.55) = 0.125 (FOR FGOLDH(3)=1.0' 4943.
5065     + /) 4944.
5066     GO TO 9999 4945.
5067     C 4946.
5068     C------------- 4947.
5069     100 CONTINUE 4948.
5070     C------------- 4949.
5071     C 4950.
5072     C 4951.
5073     NPAGE=1 4952.
5074     IF(INDEX.LT.11) NPAGE=KPAGE 4953.
5075     WRITE(6,6101) NPAGE,LASTVC,KFORCE 4954.
5076     WRITE(6,6102) 4955.
5077     IDPROG=ID5(1) 4956.
5078     ID2TRD=ID5(2) 4957.
5079     ID3SRD=ID5(3) 4958.
5080     ID4VEG=ID5(4) 4959.
5081     ID5FOR=ID5(5) 4960.
5082     FACTOR=P0/(PLB(1)-PLB(2))*1.25 4961.
5083     PPMCO2=ULGAS(1,2)*FACTOR 4962.
5084     PPMO2 =ULGAS(1,4)*FACTOR 4963.
5085     PPMN2O=ULGAS(1,6)*FACTOR 4964.
5086     PPMCH4=ULGAS(1,7)*FACTOR 4965.
5087     PPMF11=ULGAS(1,8)*FACTOR 4966.
5088     PPMF12=ULGAS(1,9)*FACTOR 4967.
5089     WRITE(6,6103) (FULGAS(I),I=1,9),(FGOLDH(I),I=1,5) 4968.
5090     IF(KGASSR.GT.0.OR.KAERSR.GT.0) 4969.
5091     +WRITE(6,6104) (FULGAS(I+9),I=1,9),(FGOLDH(I+9),I=1,5) 4970.
5092     !
5093     ! === Chien Wang 121797
5094     !
5095     #if ( defined CPL_CHEM )
5096     WRITE(6,6105) PPMCO2,PPMO3,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12
5097     #else
5098     WRITE(6,6105) PPMCO2,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12 4971.
5099     #endif
5100     + ,(FGOLDH(I),I=6,9),NV 4972.
5101     WRITE(6,6106) TAUMIN,TLGRAD,EOCTRA,ZOCSRA,FMARCL,FCLDTR,NTRACE 4973.
5102     + ,IDPROG,IMGAS1,KEEPRH,KGASSR,LAYRAD 4974.
5103     WRITE(6,6107) FRACSL,TKCICE,ESNTRA,ZSNSRA,WETTRA,FCLDSR,ITR(1) 4975.
5104     + ,ID2TRD,IMGAS2,KEEPAL,KAERSR,NL 4976.
5105     WRITE(6,6108) RATQSL,FLONO3,EICTRA,ZICSRA,WETSRA,FALGAE,ITR(2) 4977.
5106     + ,ID3SRD,ILGAS1,ISOSCT,KFRACC,NLP 4978.
5107     WRITE(6,6109) FOGTSL,ECLTRA,EDSTRA,ZDSSRA,DMOICE,FRAYLE,ITR(3) 4979.
5108     + ,ID4VEG,ILGAS2,IHGSCT,MARCLD,JMLAT 4980.
5109     WRITE(6,6110) PTLISO,ZCLSRA,EVGTRA,ZVGSRA,DMLICE,LICETK,ITR(4) 4981.
5110     + ,ID5FOR,KWVCON,LAPGAS,NORMS0,IMLON 4982.
5111     C 4983.
5112     6101 FORMAT(1I1,'(1) RADCOM 1/F: (CONTROL/INPUT PARAMETERS)' 4984.
5113     + ,' (GAS/AEROSOL REFERENCE AMOUNT SCALE FACTORS,' 4985.
5114     + ,' DEFAULTS & OPTIONS IN FORCE) LASTVC=',I7 4986.
5115     + /1X,113('-'),' KFORCE=',I10) 4987.
5116     6102 FORMAT(4X,'GAS: ','H2O',5X,'CO2',7X,'O3',6X,'O2',5X,'NO2' 4988.
5117     + ,5X,'N2O',5X,'CH4',6X,'CCL3F1',3X,'CCL2F2' 4989.
5118     + ,3X,'AERSOL: GLOBAL OCEAN LAND DESERT HAZE') 4990.
5119     6103 FORMAT(1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4991.
5120     + ,3X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4992.
5121     6104 FORMAT(1H+,T84,'T' 4993.
5122     + /1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4994.
5123     + ,' S',1X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4995.
5124     !
5125     ! === Chien Wang 121797
5126     !
5127     #if ( defined CPL_CHEM )
5128     6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,f8.4,F8.0,8X,F8.4,F8.4,1X,F8.7
5129     #else
5130     6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,9X,F8.0,8X,F8.4,F8.4,1X,F8.7 4996.
5131     #endif
5132     + ,1X,F8.7,3X,'TRACER=',1P,E7.1,1P,2E9.2,1P,E8.1,' NV=',I2) 4997.
5133     6106 FORMAT(1X,'TAUMIN=',1P,E7.1,1X,'TLGRAD=',0P,F4.1,' EOCTRA=',F3.1 4998.
5134     + ,1X,'ZOCSRA=', F3.1,1X,'FMARCL=', F4.2,1X,'FCLDTR=',F3.1 4999.
5135     + ,1X,'NTRACE=', I2,3X,'IDPROG=', I4,1X,'IMGAS1=', I1 5000.
5136     + ,1X,'KEEPRH=', I1,1X,'KGASSR=', I1,1X,'LAYRAD=', I2) 5001.
5137     6107 FORMAT(1X,'FRACSL=',1P,E7.1,1X,'TKCICE=',0P,F4.0,' ESNTRA=',F3.1 5002.
5138     + ,1X,'ZSNSRA=', F3.1,1X,'WETTRA=', F4.2,1X,'FCLDSR=',F3.1 5003.
5139     + ,1X,'ITR(1)=', I2,3X,'ID2TRD=', I4,1X,'IMGAS2=', I1 5004.
5140     + ,1X,'KEEPAL=', I1,1X,'KAERSR=', I1,1X,' NL=', I2) 5005.
5141     6108 FORMAT(1X,'RATQSL=', F4.2,4X,'FLONO3=', F4.1,1X,'EICTRA=',F3.1 5006.
5142     + ,1X,'ZICSRA=', F3.1,1X,'WETSRA=', F4.2,1X,'FALGAE=',F3.1 5007.
5143     + ,1X,'ITR(2)=', I2,3X,'ID3SRD=', I4,1X,'ILGAS1=', I1 5008.
5144     + ,1X,'ISOSCT=', I1,1X,'KFRACC=', I1,1X,' NLP=', I2) 5009.
5145     6109 FORMAT(1X,'FOGTSL=', F4.2,4X,'ECLTRA=', F4.2,1X,'EDSTRA=',F3.1 5010.
5146     + ,1X,'ZDSSRA=', F3.1,1X,'DMOICE=', F4.1,1X,'FRAYLE=',F3.1 5011.
5147     + ,1X,'ITR(3)=', I2,3X,'ID4VEG=', I4,1X,'ILGAS2=', I1 5012.
5148     + ,1X,'IHGSCT=', I1,1X,'MARCLD=', I1,1X,' JMLAT=', I2) 5013.
5149     6110 FORMAT(1X,'PTLISO=',1PE7.1,1X,'ZCLSRA=',0PF4.2,1X,'EVGTRA=',F3.1 5014.
5150     + ,1X,'ZVGSRA=', F3.1,1X,'DMLICE=', F4.1,1X,'LICETK=', I3 5015.
5151     + ,1X,'ITR(4)=', I2,3X,'ID5FOR=', I4,1X,'KWVCON=', I1 5016.
5152     + ,1X,'LAPGAS=', I1,1X,'NORMS0=', I1,1X,'IMLON=', I3) 5017.
5153     GO TO 9999 5018.
5154     C 5019.
5155     C------------- 5020.
5156     200 CONTINUE 5021.
5157     C------------- 5022.
5158     C 5023.
5159     NPAGE=0 5024.
5160     IF(INDEX.LT.11) NPAGE=KPAGE 5025.
5161     WRITE(6,6201) NPAGE,AUXGAS(LUXGAS+1),S0,COSZ 5026.
5162     DO 202 K=1,9 5027.
5163     DO 201 L=1,NL 5028.
5164     IF(LUXGAS.EQ.0) UXGAS(L,K)=U0GAS(L,K) 5029.
5165     201 IF(LUXGAS.EQ.1) UXGAS(L,K)=ULGAS(L,K) 5030.
5166     202 CONTINUE 5031.
5167     IF(LUXGAS.LT.2) GO TO 205 5032.
5168     LGS=(LUXGAS-2)*9 5033.
5169     DO 203 L=1,NL 5034.
5170     UXGAS(L,1)=U0GAS(L,1)*FULGAS(1+LGS) 5035.
5171     UXGAS(L,3)=U0GAS(L,3)*FULGAS(3+LGS) 5036.
5172     203 UXGAS(L,5)=U0GAS(L,5)*FULGAS(5+LGS) 5037.
5173     C 5038.
5174     DO 204 L=1,NL 5039.
5175     UXGAS(L,2)=U0GAS(L,2)*FULGAS(2+LGS) 5040.
5176     UXGAS(L,4)=U0GAS(L,4)*FULGAS(4+LGS) 5041.
5177     UXGAS(L,6)=U0GAS(L,6)*FULGAS(6+LGS) 5042.
5178     UXGAS(L,7)=U0GAS(L,7)*FULGAS(7+LGS) 5043.
5179     UXGAS(L,8)=U0GAS(L,8)*FULGAS(8+LGS) 5044.
5180     204 UXGAS(L,9)=U0GAS(L,9)*FULGAS(9+LGS) 5045.
5181     205 CONTINUE 5046.
5182     DO 206 N=1,NL 5047.
5183     L=NLP-N 5048.
5184     WRITE(6,6202) L,PLB(L),HLB(L),TLB(L),TLT(L),TLM(L) 5049.
5185     + ,(UXGAS(L,K),K=1,9),CLDTAU(L),SHL(L),RHL(L) 5050.
5186     206 CONTINUE 5051.
5187     DO 207 I=1,15 5052.
5188     207 SUM0(I)=0. 5053.
5189     DO 210 L=1,NL 5054.
5190     DO 208 I=1,9 5055.
5191     208 SUM0(I)=SUM0(I)+ULGAS(L,I) 5056.
5192     DO 209 I=1,4 5057.
5193     209 SUM0(11+I)=SUM0(11+I)+TRACER(L,I) 5058.
5194     210 SUM0(10)=SUM0(10)+CLDTAU(L) 5059.
5195     DO 212 J=1,NGOLDH 5060.
5196     TAU55=0. 5061.
5197     DO 211 I=1,NAERO 5062.
5198     211 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5063.
5199     212 SUM0(11)=SUM0(11)+TAU55 5064.
5200     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5065.
5201     TGMEAN=SQRT(TGMEAN) 5066.
5202     TGMEAN=SQRT(TGMEAN) 5067.
5203     WRITE(6,6203) SUM0(11),(SUM0(I),I=1,10) 5068.
5204     C WRITE(6,6204) POCEAN, TGO, AGESN, ZOICE,LASTVC, DESRT, DECID 5069.
5205     C + ,SRAOC(1),SRAEA(1),SRAOI(1),SRALI(1),SRASN(1) 5070.
5206     C + ,SRDALB(1),SRXALB(1) 5071.
5207     C WRITE(6,6205) PEARTH, TGE, SNOWE,WEARTH, PSIG0, TNDRA, EVERG 5072.
5208     C WRITE(6,6206) POICE, TGOI,SNOWOI,FRACCC, ALGAE, GRASS, RAINF 5073.
5209     C WRITE(6,6207) PLICE, TGLI,SNOWLI, JYEAR,TRACR1, SHRUB, ROCKS 5074.
5210     C WRITE(6,6208) MEANAL,TGMEAN,EXSNEA, JDAY,TRACR2, TREES, CROPS 5075.
5211     C WRITE(6,6209) KALVIS, TSL,EXSNOI, JLAT,TRACR3, FCHI, FCLO 5076.
5212     C WRITE(6,6210) LUXGAS, WMAG,EXSNLI, ILON,TRACR4, FCMI, FCOV 5077.
5213     C 5078.
5214     WRITE(6,6204) POCEAN,TGO,AGESN,WMAG,SUM0(12),JYEAR,BSNVIS,BSNNIR 5079.
5215     + ,LASTVC 5080.
5216     WRITE(6,6205) PEARTH,TGE,SNOWE,WEARTH,SUM0(13),JDAY,XSNVIS,XSNNIR 5081.
5217     WRITE(6,6206) POICE,TGOI,SNOWOI,ZOICE,SUM0(14),JLAT 5082.
5218     + ,(SRBALB(I),I=1,6) 5083.
5219     WRITE(6,6207) PLICE,TGLI,SNOWLI,FRC(5),SUM0(15),ILON 5084.
5220     + ,(SRXALB(I),I=1,6) 5085.
5221     WRITE(6,6208) TGMEAN,LUXGAS,PSUM,TSL,MEANAL,KALVIS,(PVT(I),I=1,11)5086.
5222     WRITE(6,6209) (BXA(I),I=1,19) 5087.
5223     6201 FORMAT(1I1,'(2) RADCOM G/L: (INPUT DATA)' 5088.
5224     + ,T41,' ABSORBER AMOUNT PER LAYER:' 5089.
5225     + ,' U',1A1,'GAS(L,K) IN CM**3(STP)/CM**2' 5090.
5226     + ,T109,'S0=',F8.3,3X,'COSZ=',F6.4/1X,132('-') 5091.
5227     + /' LN PLB HLB TLB TLT TLM ' 5092.
5228     + ,'H2O CO2 O3 O2 NO2 N2O CH4' 5093.
5229     + ,' CCL3F1 CCL2F2 CLDTAU SHL RHL ') 5094.
5230     6202 FORMAT(1X,I2,F9.3,F6.2,3F7.2,F9.3,F8.3,1X,F6.5,F8.0,1P,1E9.2 5095.
5231     + ,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,1F7.2,1X,F7.6,1X,F5.4) 5096.
5232     6203 FORMAT( 1X,'$SUM AERSOL=',F5.3,7X,'$COLUMN AMOUNT',F9.3 5097.
5233     + ,F8.3,1X,F6.5,F8.0,1P,1E9.2,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,F7.2) 5098.
5234     6204 FORMAT(/1X,'POCEAN=',F6.4,' TGO=' ,F6.2,1X,' AGESN=',F6.3 5099.
5235     + , 1X,' WMAG=',F6.3,' TRACER 1=',F5.3,' JYEAR=',I4 5100.
5236     + , 3X,'BSNVIS=',F6.4,' BSNNIR=' ,F6.4,7X,'LASTVC=',I7) 5101.
5237     6205 FORMAT( ' PEARTH=',F6.4,' TGE=',F6.2,' SNOWE=',F6.3 5102.
5238     + , ' WEARTH=',F6.3,' $SUMS: 2=',F5.3 5103.
5239     + , ' JDAY=',I4 ,2X,' XSNVIS=',F6.4,' XSNNIR=',F6.4 5104.
5240     + , 8X,'NIRALB VISALB') 5105.
5241     6206 FORMAT( ' POICE=',F6.4,' TGOI=',F6.2,' SNOWOI=',F6.3 5106.
5242     + , ' ZOICE=',F6.3,' 3=',F5.3 5107.
5243     + , ' JLAT=',I4, 2X,' SRBALB=',F6.4 5108.
5244     + ,4F7.4,F7.4) 5109.
5245     6207 FORMAT( ' PLICE=',F6.4,' TGLI=',F6.2,' SNOWLI=',F6.3 5110.
5246     + , ' FRC(5)=',F6.3,' 4=',F5.3 5111.
5247     + , ' ILON=',I4, 2X,' SRXALB=',F6.4 5112.
5248     + ,4F7.4,F7.4) 5113.
5249     6208 FORMAT( 1X,13('-'),'$TGMEAN=',F6.2,14X,' LUXGAS=',I1,5X 5114.
5250     + ,1X,'DESERT TUNDRA GRASSL SHRUBS TREES DECIDF' 5115.
5251     + ,' EVERGF',' RAINF',' ROCKS',' CROPS',' ALGAE' 5116.
5252     + / ' $PSUM=',F6.4,' TSL=',F6.2,' MEANAL=',I1 5117.
5253     + ,5X,' KALVIS=',I1,T54,'PVT=',F6.4,10F7.4) 5118.
5254     6209 FORMAT(' BOCVIS BOCNIR XOCVIS XOCNIR|BEAVIS BEANIR XEAVIS XEANIR' 5119.
5255     + ,'|BOIVIS BOINIR XOIVIS XOINIR|BLIVIS BLINIR XLIVIS XLINIR' 5120.
5256     + ,'|EXPSNE|EXPSNO|EXPSNL'/1X,F6.4,18F7.4) 5121.
5257     GO TO 9999 5122.
5258     C 5123.
5259     C------------- 5124.
5260     300 CONTINUE 5125.
5261     C------------- 5126.
5262     C 5127.
5263     NPAGE=0 5128.
5264     IF(INDEX.LT.11) NPAGE=KPAGE 5129.
5265     IF(NL.GT.13) NPAGE=1 5130.
5266     L=NLP 5131.
5267     STNFLB=SRNFLB(L)-TRNFLB(L) 5132.
5268     WRITE(6,6301) NPAGE,NORMS0 5133.
5269     WRITE(6,6302) L,PLB(L),HLB(L),TLB(L) 5134.
5270     + ,TRDFLB(L),TRUFLB(L),TRNFLB(L) 5135.
5271     + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),STNFLB 5136.
5272     DO 301 N=1,NL 5137.
5273     L=NLP-N 5138.
5274     CRHRF=8.4167/(PLB(L)-PLB(L+1)) 5139.
5275     STNFLB=SRNFLB(L)-TRNFLB(L) 5140.
5276     STFHR =SRFHRL(L)-TRFCRL(L) 5141.
5277     TRDCR =TRFCRL(L)*CRHRF 5142.
5278     SRDHR =SRFHRL(L)*CRHRF 5143.
5279     STDHR=STFHR*CRHRF 5144.
5280     SRALB =SRUFLB(L)/(SRDFLB(L)+1.E-10) 5145.
5281     SRXVIS=SRXATM(1) 5146.
5282     SRXNIR=SRXATM(2) 5147.
5283     WRITE(6,6303) L,PLB(L),HLB(L),TLB(L),TLT(L) 5148.
5284     + ,TRDFLB(L),TRUFLB(L),TRNFLB(L),TRFCRL(L) 5149.
5285     + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),SRFHRL(L) 5150.
5286     + ,STNFLB,STFHR,STDHR,TRDCR,SRDHR,SRALB 5151.
5287     301 CONTINUE 5152.
5288     C 5153.
5289     WRITE(6,6304) BTEMPW,TRUFTW,SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR 5154.
5290     + ,PLANIR 5155.
5291     WRITE(6,6305) TRDFGW,TRUFGW,SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR 5156.
5292     + ,ALBNIR 5157.
5293     WRITE(6,6306) SRXVIS,SRXNIR,SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR 5158.
5294     + ,SRANIR 5159.
5295     WRITE(6,6307) TRDFSL,TRUFSL,TRSLCR,TRSLTS,TRSLTG,TRSLWV,TRSLBS 5160.
5296     + ,SRSLHR 5161.
5297     C 5162.
5298     WRITE(6,6308) (FSRNFG(I),I=1,4),LTOPCL,JLAT,JYEAR 5163.
5299     WRITE(6,6309) (FTRUFG(I),I=1,4),LBOTCL,ILON,JDAY 5164.
5300     WRITE(6,6310) (DTRUFG(I),I=1,4),TTRUFG,COSZ 5165.
5301     C 5166.
5302     6301 FORMAT(1I1,'(3) RADCOM M/S: (OUTPUT DATA)' 5167.
5303     + ,T37,'THERMAL FLUXES (W/M**2)',4X,'SOLAR FLUXES (W/M**2)' 5168.
5304     + ,1X,'NORMS0=',I1,' ENERGY INPUT HEAT/COOL DEG/DAY ALB' 5169.
5305     + ,'DO'/1X,31('-'),2X,9('---'),2X,10('---'),1X,'$',7('-') 5170.
5306     + ,'$',5('-'),1X,'$',5('-'),'$',5('-'),'$',5('-'),1X,'$----' 5171.
5307     + /' LN PLB HLB TLB TLT ' 5172.
5308     + ,' TRDFLB TRUFLB TRNFLB TRFCRL SRDFLB SRUFLB SRNFLB' 5173.
5309     + ,' SRFHRL STNFLB STFHR STDHR TRDCR SRDHR SRALB') 5174.
5310     6302 FORMAT(1X,I2,F9.3,F6.2,1X,F6.2,8X,3F7.2,8X,3F8.2,7X,F8.2) 5175.
5311     6303 FORMAT(1X,I2,F9.3,F6.2,2F7.2,1X,3F7.2,F7.2,1X,3F8.2,F7.2,1X,F7.2 5176.
5312     + ,1X,F6.2,1X,3F6.2,1X,F5.4) 5177.
5313     6304 FORMAT(/1X,'AT ATM TOP: ',' BTEMPW=',F6.2,1X,' TRUFTW=',F6.3 5178.
5314     + , 2X,' SRIVIS=',F6.2,' SROVIS=',F6.2, ' PLAVIS=',F6.4 5179.
5315     + , 2X,' SRINIR=',F6.2,' SRONIR=',F6.2, ' PLANIR=',F6.4) 5180.
5316     6305 FORMAT( 1X,'AT GROUND : ',' TRDFGW=',F6.3,1X,' TRUFGW=',F6.3 5181.
5317     + , 2X,' SRDVIS=',F6.2,' SRUVIS=',F6.2, ' ALBVIS=',F6.4 5182.
5318     + , 2X,' SRDNIR=',F6.2,' SRUNIR=',F6.2, ' ALBNIR=',F6.4) 5183.
5319     6306 FORMAT( 1X,'ATMOSPHERE: ',' SRXVIS=',F6.4,1X,' SRXNIR=',F6.4 5184.
5320     + , 2X,' SRTVIS=',F6.4,' SRRVIS=',F6.4, ' SRAVIS=',F6.4 5185.
5321     + , 2X,' SRTNIR=',F6.4,' SRRNIR=',F6.4, ' SRANIR=',F6.4) 5186.
5322     6307 FORMAT( 1X,'SURF LAYER: ',' TRDRSL=',F6.2,1X,' TRUFSL=',F6.2 5187.
5323     + , 2X,' TRSLCR=',F6.4,'+TRSLTS=',F6.4, '-TRSLTG=',F6.4 5188.
5324     + , 2X,' TRSLWV=',F6.4,' TRSLBS=',F6.3, ' SRSLHR=',F6.4) 5189.
5325     6308 FORMAT(/1X,'FSRNFG(I)=> FRAC SRNFLB(1) EACH SURFTYPE' 5190.
5326     + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5191.
5327     + ,F7.4,1X,' LTOPCL=',I2,' JLAT=',I2,' JYEAR',I4) 5192.
5328     6309 FORMAT( 1X,'FTRUFG(I)=> FRAC TRUFLB(1) EACH SURFTYPE' 5193.
5329     + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5194.
5330     + ,F7.4,1X,' LBOTCL=',I2,' ILON=',I2,' JDAY=',I4) 5195.
5331     6310 FORMAT( 1X,'DTRUFG(I)=> DERIV TRUFLB(1) EACH SURFTYPE' 5196.
5332     + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5197.
5333     + ,F7.4, '=>TTRUFG=',F6.4,' COSZ=',F6.4) 5198.
5334     GO TO 9999 5199.
5335     C 5200.
5336     C------------- 5201.
5337     400 CONTINUE 5202.
5338     C------------- 5203.
5339     GO TO 9999 5204.
5340     C 5205.
5341     C------------- 5206.
5342     500 CONTINUE 5207.
5343     C------------- 5208.
5344     C 5209.
5345     NPAGE=1 5210.
5346     IF(INDEX.LT.11) NPAGE=KPAGE 5211.
5347     SIGMA=5.6697D-08 5212.
5348     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5213.
5349     TGMEAN=SQRT(TGMEAN) 5214.
5350     TGMEAN=SQRT(TGMEAN) 5215.
5351     SIGT4=SIGMA*TGMEAN**4 5216.
5352     ITG=TGMEAN 5217.
5353     WTG=TGMEAN-ITG 5218.
5354     ITG=ITG-IT0 5219.
5355     SUMK=0.0 5220.
5356     DO 501 K=1,NKTR 5221.
5357     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5222.
5358     BGFRAC(K)=BGFLUX(K)/SIGT4 5223.
5359     SUMK=SUMK+BGFLUX(K) 5224.
5360     ITG=ITG+ITNEXT 5225.
5361     501 CONTINUE 5226.
5362     WRITE(6,6501) NPAGE 5227.
5363     WRITE(6,6502) (K,K=1,11) 5228.
5364     DO 502 N=1,NL 5229.
5365     L=NLP-N 5230.
5366     LI=L 5231.
5367     LL=NL*10+L 5232.
5368     WRITE(6,6503) L,PL(L),DPL(L),TLM(L),(TAULAP(I),I=LI,LL,NL) 5233.
5369     502 CONTINUE 5234.
5370     LK=0 5235.
5371     DO 504 K=1,NKTR 5236.
5372     TAUSUM(K)=0. 5237.
5373     DO 503 L=1,NL 5238.
5374     LK=LK+1 5239.
5375     503 TAUSUM(K)=TAUSUM(K)+TAULAP(LK) 5240.
5376     504 CONTINUE 5241.
5377     WRITE(6,6504) (TAUSUM(K),K=1,11) 5242.
5378     WRITE(6,6505) 5243.
5379     WRITE(6,6506) SUMK,(BGFLUX(K),K=1,11) 5244.
5380     WRITE(6,6507) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5245.
5381     NPAGE=0 5246.
5382     IF(NL.GT.13) NPAGE=1 5247.
5383     WRITE(6,6508) NPAGE 5248.
5384     WRITE(6,6509) (K,K=12,25) 5249.
5385     DO 505 N=1,NL 5250.
5386     L=NLP-N 5251.
5387     LI=NL*11+L 5252.
5388     LL=NL*24+L 5253.
5389     WRITE(6,6510) L,(TAULAP(I),I=LI,LL,NL) 5254.
5390     505 CONTINUE 5255.
5391     WRITE(6,6511) (TAUSUM(K),K=12,NKTR) 5256.
5392     WRITE(6,6512) (BGFLUX(K),K=12,NKTR) 5257.
5393     WRITE(6,6513) (BGFRAC(K),K=12,NKTR) 5258.
5394     C 5259.
5395     6501 FORMAT(1I1,'(5) TAULAP TABLE FOR THERMAL RADIATION: INCLUDES' 5260.
5396     + ,' WEAK OVERLAPPING GAS ABSORPTION BY' 5261.
5397     + ,' H2O, CO2, O3, N2O, CH4',T117,'LIST: TAULAP(LK)'/ 5262.
5398     + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5263.
5399     + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5264.
5400     + ,/T30,8('-'),3X,93('-')) 5265.
5401     6502 FORMAT(' LN PL DPL TLM K=' 5266.
5402     + ,I4,5X,'K=',I4,I10,5I9,3I10) 5267.
5403     6503 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5268.
5404     6504 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5269.
5405     6505 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5270.
5406     6506 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5271.
5407     6507 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5272.
5408     + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5273.
5409     6508 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5274.
5410     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5275.
5411     + /4X,92('-'),3X,34('-')) 5276.
5412     6509 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5277.
5413     6510 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5278.
5414     6511 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5279.
5415     6512 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5280.
5416     6513 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5281.
5417     GO TO 9999 5282.
5418     C 5283.
5419     C------------- 5284.
5420     600 CONTINUE 5285.
5421     C------------- 5286.
5422     C 5287.
5423     NPAGE=1 5288.
5424     IF(INDEX.LT.11) NPAGE=KPAGE 5289.
5425     SIGMA=5.6697D-08 5290.
5426     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5291.
5427     TGMEAN=SQRT(TGMEAN) 5292.
5428     TGMEAN=SQRT(TGMEAN) 5293.
5429     SIGT4=SIGMA*TGMEAN**4 5294.
5430     ITG=TGMEAN 5295.
5431     WTG=TGMEAN-ITG 5296.
5432     ITG=ITG-IT0 5297.
5433     SUMK=0.0 5298.
5434     DO 601 K=1,NKTR 5299.
5435     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5300.
5436     BGFRAC(K)=BGFLUX(K)/SIGT4 5301.
5437     SUMK=SUMK+BGFLUX(K) 5302.
5438     ITG=ITG+ITNEXT 5303.
5439     601 CONTINUE 5304.
5440     WRITE(6,6601) NPAGE 5305.
5441     WRITE(6,6602) (K,K=1,11) 5306.
5442     DO 602 N=1,NL 5307.
5443     L=NLP-N 5308.
5444     LI=L 5309.
5445     LL=NL*10+L 5310.
5446     WRITE(6,6603) L,PL(L),DPL(L),TLM(L),(TAUN(I),I=LI,LL,NL) 5311.
5447     602 CONTINUE 5312.
5448     LK=0 5313.
5449     DO 604 K=1,NKTR 5314.
5450     TAUSUM(K)=TAUSL(K) 5315.
5451     DO 603 L=1,NL 5316.
5452     LK=LK+1 5317.
5453     603 TAUSUM(K)=TAUSUM(K)+TAUN(LK) 5318.
5454     604 CONTINUE 5319.
5455     WRITE(6,6604) (TAUSL(K),K=1,11) 5320.
5456     WRITE(6,6605) (TAUSUM(K),K=1,11) 5321.
5457     WRITE(6,6606) SUMK,(BGFLUX(K),K=1,11) 5322.
5458     WRITE(6,6607) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5323.
5459     NPAGE=0 5324.
5460     IF(NL.GT.13) NPAGE=1 5325.
5461     WRITE(6,6608) NPAGE 5326.
5462     WRITE(6,6609) (K,K=12,25) 5327.
5463     DO 605 N=1,NL 5328.
5464     L=NLP-N 5329.
5465     LI=NL*11+L 5330.
5466     LL=NL*24+L 5331.
5467     WRITE(6,6610) L,(TAUN(I),I=LI,LL,NL) 5332.
5468     605 CONTINUE 5333.
5469     WRITE(6,6611) ( TAUSL(K),K=12,NKTR) 5334.
5470     WRITE(6,6612) (TAUSUM(K),K=12,NKTR) 5335.
5471     WRITE(6,6613) (BGFLUX(K),K=12,NKTR) 5336.
5472     WRITE(6,6614) (BGFRAC(K),K=12,NKTR) 5337.
5473     C 5338.
5474     6601 FORMAT(1I1,'(6) TAU TABLE FOR THERMAL RADIATION: INCLUDES ANY' 5339.
5475     + ,' SPECIFIED OVERLAP, CLOUD & AEROSOL ABSORPTION' 5340.
5476     + ,T117,'TAUN(LK),TAUSL(L)'/ 5341.
5477     + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5342.
5478     + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5343.
5479     + ,/T30,8('-'),3X,93('-')) 5344.
5480     6602 FORMAT(' LN PL DPL TLM K=' 5345.
5481     + ,I4,5X,'K=',I4,I10,5I9,3I10) 5346.
5482     6603 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5347.
5483     6604 FORMAT(/13X,'SURFACE LAYER=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5348.
5484     6605 FORMAT(/13X,'COLUMN AMOUNT=',F10.3,F11.3,F10.3,5F9.3,3F10.3) 5349.
5485     6606 FORMAT(/1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5350.
5486     6607 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5351.
5487     + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5352.
5488     6608 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5353.
5489     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5354.
5490     + /4X,92('-'),3X,34('-')) 5355.
5491     6609 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5356.
5492     6610 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5357.
5493     6611 FORMAT(/1X,'SL',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5358.
5494     6612 FORMAT(/1X,'CA',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5359.
5495     6613 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5360.
5496     6614 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5361.
5497     GO TO 9999 5362.
5498     C 5363.
5499     C------------- 5364.
5500     700 CONTINUE 5365.
5501     C------------- 5366.
5502     C 5367.
5503     NPAGE=1 5368.
5504     IF(INDEX.LT.11) NPAGE=KPAGE 5369.
5505     SIGMA=5.6697D-08 5370.
5506     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5371.
5507     TGMEAN=SQRT(TGMEAN) 5372.
5508     TGMEAN=SQRT(TGMEAN) 5373.
5509     SIGT4=SIGMA*TGMEAN**4 5374.
5510     ITG=TGMEAN 5375.
5511     WTG=TGMEAN-ITG 5376.
5512     ITG=ITG-IT0 5377.
5513     SUMK=0.0 5378.
5514     DO 701 K=1,NKTR 5379.
5515     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5380.
5516     BGFRAC(K)=BGFLUX(K)/SIGT4 5381.
5517     SUMK=SUMK+BGFLUX(K) 5382.
5518     ITG=ITG+ITNEXT 5383.
5519     701 CONTINUE 5384.
5520     WRITE(6,6701) NPAGE 5385.
5521     WRITE(6,6702) (K,K=1,11) 5386.
5522     DO 702 N=1,NL 5387.
5523     L=NLP-N 5388.
5524     WRITE(6,6703) L,PL(L),DPL(L),TLM(L),(TRAEXT(L,K),K=1,11) 5389.
5525     702 CONTINUE 5390.
5526     DO 704 K=1,NKTR 5391.
5527     TAUSUM(K)=0. 5392.
5528     DO 703 L=1,NL 5393.
5529     703 TAUSUM(K)=TAUSUM(K)+TRAEXT(L,K) 5394.
5530     704 CONTINUE 5395.
5531     WRITE(6,6704) (TAUSUM(K),K=1,11) 5396.
5532     WRITE(6,6705) 5397.
5533     WRITE(6,6706) SUMK,(BGFLUX(K),K=1,11) 5398.
5534     WRITE(6,6707) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5399.
5535     NPAGE=0 5400.
5536     IF(NL.GT.13) NPAGE=1 5401.
5537     WRITE(6,6708) NPAGE 5402.
5538     WRITE(6,6709) (K,K=12,25) 5403.
5539     DO 705 N=1,NL 5404.
5540     L=NLP-N 5405.
5541     WRITE(6,6710) L,(TRAEXT(L,K),K=12,NKTR) 5406.
5542     705 CONTINUE 5407.
5543     WRITE(6,6711) (TAUSUM(K),K=12,NKTR) 5408.
5544     WRITE(6,6712) (BGFLUX(K),K=12,NKTR) 5409.
5545     WRITE(6,6713) (BGFRAC(K),K=12,NKTR) 5410.
5546     C 5411.
5547     6701 FORMAT(1I1,'(7) AEROSOL TAU TABLE FOR THERMAL RADIATION:' 5412.
5548     + ,' CLOUD & AEROSOL ABSORPTION' 5413.
5549     + ,T116,'LIST: TRAEXT(L,K)'/ 5414.
5550     + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5415.
5551     + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5416.
5552     + ,/T30,8('-'),3X,93('-')) 5417.
5553     6702 FORMAT(' LN PL DPL TLM K=' 5418.
5554     + ,I4,5X,'K=',I4,I10,5I9,3I10) 5419.
5555     6703 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5420.
5556     6704 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5421.
5557     6705 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5422.
5558     6706 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5423.
5559     6707 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5424.
5560     + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5425.
5561     6708 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5426.
5562     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5427.
5563     + /4X,92('-'),3X,34('-')) 5428.
5564     6709 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5429.
5565     6710 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5430.
5566     6711 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5431.
5567     6712 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5432.
5568     6713 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5433.
5569     GO TO 9999 5434.
5570     C 5435.
5571     C------------- 5436.
5572     800 CONTINUE 5437.
5573     C------------- 5438.
5574     C 5439.
5575     NPAGE=1 5440.
5576     IF(INDEX.LT.11) NPAGE=KPAGE 5441.
5577     WRITE(6,6801) NPAGE 5442.
5578     DO 802 K=1,NKSR 5443.
5579     SUM1(K)=0. 5444.
5580     SUM2(K)=0. 5445.
5581     SUM3(K)=0. 5446.
5582     DO 801 L=1,NL 5447.
5583     SUM1(K)=SUM1(K)+EXTAER(L,K) 5448.
5584     SUM2(K)=SUM2(K)+SCTAER(L,K) 5449.
5585     SUM3(K)=SUM3(K)+SCTAER(L,K)*COSAER(L,K) 5450.
5586     801 PI0AER(L,K)=SCTAER(L,K)/(EXTAER(L,K)+1.E-10) 5451.
5587     SUM3(K)=SUM3(K)/(SUM2(K)+1.E-10) 5452.
5588     SUM0(K)=SUM2(K)/(SUM1(K)+1.E-10) 5453.
5589     802 CONTINUE 5454.
5590     WRITE(6,6802) (K,K=1,6),(K,K=1,6) 5455.
5591     DO 803 N=1,NL 5456.
5592     L=NLP-N 5457.
5593     WRITE(6,6803) L,PLB(L),HLB(L) 5458.
5594     + ,(EXTAER(L,J),J=1,6),(SCTAER(L,J),J=1,6) 5459.
5595     803 CONTINUE 5460.
5596     WRITE(6,6804) (SUM1(K),K=1,NKSR),(SUM2(K),K=1,NKSR) 5461.
5597     NPAGE=0 5462.
5598     IF(NL.GT.13) NPAGE=1 5463.
5599     WRITE(6,6805) NPAGE 5464.
5600     WRITE(6,6806) (K,K=1,6),(K,K=1,6) 5465.
5601     DO 804 N=1,NL 5466.
5602     L=NLP-N 5467.
5603     WRITE(6,6807) L,PL(L),DPL(L) 5468.
5604     + ,(COSAER(L,J),J=1,6),(PI0AER(L,J),J=1,6) 5469.
5605     804 CONTINUE 5470.
5606     WRITE(6,6808) (SUM3(K),K=1,NKSR),(SUM0(K),K=1,NKSR) 5471.
5607     WRITE(6,6809) (SRBALB(K),K=1,NKSR) 5472.
5608     WRITE(6,6810) (SRXALB(K),K=1,NKSR) 5473.
5609     WRITE(6,6811) 5474.
5610     SUM=0. 5475.
5611     DO 806 J=1,5 5476.
5612     TAU55=0. 5477.
5613     DO 805 I=1,NAERO 5478.
5614     805 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5479.
5615     WRITE(6,6812) J,FGOLDH(J),TAU55 5480.
5616     806 SUM=SUM+TAU55 5481.
5617     WRITE(6,6813) SUM 5482.
5618     C 5483.
5619     6801 FORMAT(1I1,'(8) AEROSOL INPUT FOR SOLAR RADIATION:' 5484.
5620     + ,' AEROSOL RADIATIVE PROPERTIES' 5485.
5621     + ,T81,'LIST: EXTAER(L,K),SCTAER(L,K),COSAER(L,K),PIZERO(L,K)'5486.
5622     + //T42,'TAU -- EXTINCTION',T99,'TAU -- SCATTERING' 5487.
5623     + ,/T24,53('-'),4X,53('-')) 5488.
5624     6802 FORMAT(' LN PLB HLB K=',I3,5I9,7X,'K=',I3,5I9) 5489.
5625     6803 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5490.
5626     6804 FORMAT(/1X,T7,'COLUMN AMOUNT=',2X,6F9.6,3X,6F9.6) 5491.
5627     6805 FORMAT(1I1/T48,'COSBAR',T105,'PIZERO' 5492.
5628     + ,/T24,53('-'),4X,53('-')) 5493.
5629     6806 FORMAT(' LN PL DPL K=',I3,5I9,7X,'K=',I3,5I9) 5494.
5630     6807 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5495.
5631     6808 FORMAT(/1X,T7,'COLUMN MEAN=',2X,6F9.6,3X,6F9.6) 5496.
5632     6809 FORMAT(/1X,T7,'ALBEDO RSURFB=',2X,6F9.6,3X,6F9.6) 5497.
5633     6810 FORMAT( 1X,T7,'ALBEDO RSURFX=',2X,6F9.6,3X,6F9.6) 5498.
5634     GO TO 9999 5499.
5635     6811 FORMAT(///T44,'AEROSOL COMPOSITION AND TYPE MIX:' 5500.
5636     + ,T81,'FACTOR',6X,'VALUE',T107,'TAU(0.55)'/) 5501.
5637     6812 FORMAT(T81,'FGOLDH(',I1,') =',1P,E9.2,5X,0P,F7.4) 5502.
5638     6813 FORMAT(/T81,'SUM COLUMN TAU(0.55) =',F10.4) 5503.
5639     C 5504.
5640     C------------- 5505.
5641     900 CONTINUE 5506.
5642     C------------- 5507.
5643     C 5508.
5644     SIGMA=5.6697D-08 5509.
5645     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5510.
5646     TGMEAN=SQRT(TGMEAN) 5511.
5647     TGMEAN=SQRT(TGMEAN) 5512.
5648     SIGT4=SIGMA*TGMEAN**4 5513.
5649     ITG=TGMEAN 5514.
5650     WTG=TGMEAN-ITG 5515.
5651     ITG=ITG-IT0 5516.
5652     DO 901 K=1,NKTR 5517.
5653     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5518.
5654     BGFRAC(K)=BGFLUX(K)/SIGT4 5519.
5655     ITG=ITG+ITNEXT 5520.
5656     901 CONTINUE 5521.
5657     DO 910 NW=1,5 5522.
5658     DO 903 K=1,NKTR 5523.
5659     DO 902 L=1,NLP 5524.
5660     IF(NW.EQ.1) WFLB(L,K)=DFLB(L,K) 5525.
5661     IF(NW.EQ.2) WFLB(L,K)=UFLB(L,K) 5526.
5662     IF(NW.EQ.3) WFLB(L,K)=UFLB(L,K)-DFLB(L,K) 5527.
5663     IF(NW.GT.3.AND.L.GT.NL) GO TO 902 5528.
5664     IF(NW.EQ.4) WFLB(L,K)=WFLB(L+1,K)-WFLB(L,K) 5529.
5665     IF(NW.EQ.5.AND.ABS(TRFCRL(L)).LT.1.E-10) WFLB(L,K)=1.E-30 5530.
5666     IF(NW.EQ.5) WFLB(L,K)=WFLB(L,K)/(ABS(TRFCRL(L))+1.E-10) 5531.
5667     902 CONTINUE 5532.
5668     IF(NW.EQ.1) WFSL(K)=DFSL(K) 5533.
5669     IF(NW.EQ.2) WFSL(K)=UFSL(K) 5534.
5670     IF(NW.EQ.3) WFSL(K)=UFSL(K)-DFSL(K) 5535.
5671     IF(NW.EQ.4) WFSL(K)=WFSL(K)-UFLB(1,K)+DFLB(1,K) 5536.
5672     IF(NW.EQ.5.AND.ABS(TRSLCR).LT.1.E-10) WFSL(K)=1.E-30 5537.
5673     IF(NW.EQ.5) WFSL(K)=WFSL(K)/(ABS(TRSLCR)+1.E-10) 5538.
5674     903 CONTINUE 5539.
5675     DO 907 L=1,NLP 5540.
5676     IF(L.GT.NL.AND.NW.GT.3) GO TO 907 5541.
5677     ASUM1=0. 5542.
5678     BSUM1=0. 5543.
5679     CSUM1=0. 5544.
5680     DSUM1=0. 5545.
5681     ESUM1=0. 5546.
5682     FSUM1=0. 5547.
5683     SUM=0. 5548.
5684     DO 904 K=2,11 5549.
5685     ASUM1=ASUM1+ WFSL(K) 5550.
5686     BSUM1=BSUM1+ BGFEMT(K) 5551.
5687     CSUM1=CSUM1+BGFLUX(K) 5552.
5688     DSUM1=DSUM1+BGFRAC(K) 5553.
5689     ESUM1=ESUM1+TRCALB(K) 5554.
5690     FSUM1=FSUM1+ TRGALB(K) 5555.
5691     904 SUM=SUM+WFLB(L,K) 5556.
5692     SUM1(L)=SUM 5557.
5693     ASUM2=0. 5558.
5694     BSUM2=0. 5559.
5695     CSUM2=0. 5560.
5696     DSUM2=0. 5561.
5697     ESUM2=0. 5562.
5698     FSUM2=0. 5563.
5699     SUM=0. 5564.
5700     DO 905 K=12,21 5565.
5701     ASUM2=ASUM2+ WFSL(K) 5566.
5702     BSUM2=BSUM2+ BGFEMT(K) 5567.
5703     CSUM2=CSUM2+BGFLUX(K) 5568.
5704     DSUM2=DSUM2+BGFRAC(K) 5569.
5705     ESUM2=ESUM2+TRCALB(K) 5570.
5706     FSUM2=FSUM2+ TRGALB(K) 5571.
5707     905 SUM=SUM+WFLB(L,K) 5572.
5708     SUM2(L)=SUM 5573.
5709     ASUM3=0. 5574.
5710     BSUM3=0. 5575.
5711     CSUM3=0. 5576.
5712     DSUM3=0. 5577.
5713     ESUM3=0. 5578.
5714     FSUM3=0. 5579.
5715     SUM=0. 5580.
5716     DO 906 K=22,NKTR 5581.
5717     ASUM3=ASUM3+ WFSL(K) 5582.
5718     BSUM3=BSUM3+ BGFEMT(K) 5583.
5719     CSUM3=CSUM3+BGFLUX(K) 5584.
5720     DSUM3=DSUM3+BGFRAC(K) 5585.
5721     ESUM3=ESUM3+TRCALB(K) 5586.
5722     FSUM3=FSUM3+ TRGALB(K) 5587.
5723     906 SUM=SUM+WFLB(L,K) 5588.
5724     SUM3(L)=SUM 5589.
5725     907 CONTINUE 5590.
5726     C 5591.
5727     NPAGE=1 5592.
5728     WRITE(6,6901) NPAGE,NW,FTYPE(NW) 5593.
5729     WRITE(6,6902) (K,K=1,11) 5594.
5730     DO 908 N=1,NLP 5595.
5731     L=NLP+1-N 5596.
5732     IF(L.GT.NL.AND.NW.GT.3) GO TO 908 5597.
5733     SUML=SUM1(L)+SUM2(L)+SUM3(L)+WFLB(L,1) 5598.
5734     WRITE(6,6903) L,SUML,SUM1(L),SUM2(L),SUM3(L),(WFLB(L,K),K=1,11) 5599.
5735     908 CONTINUE 5600.
5736     SUMA=ASUM1+ASUM2+ASUM3+ WFSL(1) 5601.
5737     SUMB=BSUM1+BSUM2+BSUM3+ BGFEMT(1) 5602.
5738     SUMC=CSUM1+CSUM2+CSUM3+BGFLUX(1) 5603.
5739     SUMD=DSUM1+DSUM2+DSUM3+BGFRAC(1) 5604.
5740     SUME=ESUM1+ESUM2+ESUM3+TRCALB(1) 5605.
5741     SUMF=FSUM1+FSUM2+FSUM3+TRGALB(1) 5606.
5742     WRITE(6,6904) SUMA,ASUM1,ASUM2,ASUM3,( WFSL(K),K=1,11) 5607.
5743     WRITE(6,6905) SUMB,BSUM1,BSUM2,BSUM3,( BGFEMT(K),K=1,11) 5608.
5744     WRITE(6,6906) SUMC,CSUM1,CSUM2,CSUM3,(BGFLUX(K),K=1,11) 5609.
5745     WRITE(6,6907) SUMD,DSUM1,DSUM2,DSUM3,(BGFRAC(K),K=1,11) 5610.
5746     WRITE(6,6908) SUME,ESUM1,ESUM2,ESUM3,(TRCALB(K),K=1,11) 5611.
5747     WRITE(6,6909) SUMF,FSUM1,FSUM2,FSUM3,(TRGALB(K),K=1,11) 5612.
5748     NPAGE=0 5613.
5749     IF(NL.GT.13) NPAGE=1 5614.
5750     WRITE(6,6910) NPAGE 5615.
5751     WRITE(6,6911) (K,K=12,25) 5616.
5752     DO 909 N=1,NLP 5617.
5753     L=NLP+1-N 5618.
5754     IF(L.GT.NL.AND.NW.GT.3) GO TO 909 5619.
5755     WRITE(6,6912) L,(WFLB(L,K),K=12,NKTR) 5620.
5756     909 CONTINUE 5621.
5757     WRITE(6,6913) ( WFSL(K),K=12,NKTR) 5622.
5758     WRITE(6,6914) ( BGFEMT(K),K=12,NKTR) 5623.
5759     WRITE(6,6915) (BGFLUX(K),K=12,NKTR) 5624.
5760     WRITE(6,6916) (BGFRAC(K),K=12,NKTR) 5625.
5761     WRITE(6,6917) (TRCALB(K),K=12,NKTR) 5626.
5762     WRITE(6,6918) ( TRGALB(K),K=12,NKTR) 5627.
5763     910 CONTINUE 5628.
5764     C 5629.
5765     6901 FORMAT(1I1,'(9.',I1,') THERMAL RADIATION: K-DISTRIBUTION' 5630.
5766     + ,' BREAKDOWN FOR ',1A8,' FLUX'/ 5631.
5767     + /T8,'SUM PRINCIPAL REGION SUM',4X 5632.
5768     + ,'WINDOW',T66,'WATER VAPOR: PRINCIPAL ABSORBER REGION' 5633.
5769     + ,/T7,'-----',2X,20('-'),4X,6('-'),3X,87('-')) 5634.
5770     6902 FORMAT(1X,'LN TOTAL H2O CO2 O3 K=' 5635.
5771     + ,I2,5X,'K=',I2,9I9) 5636.
5772     6903 FORMAT( 1X,I2,F8.2,1X,3F7.2,F10.3,10F9.3) 5637.
5773     6904 FORMAT(/' SL',F8.2,1X,3F7.2,F10.3,10F9.3) 5638.
5774     6905 FORMAT(/' BG',F8.2,1X,3F7.2,F10.3,10F9.3) 5639.
5775     6906 FORMAT( ' PF',F8.2,1X,3F7.2,F10.3,10F9.3) 5640.
5776     6907 FORMAT( ' FR',F8.4,1X,3F7.4,F10.5,10F9.5) 5641.
5777     6908 FORMAT(/' AC',F8.2,1X,3F7.2,F10.3,10F9.3) 5642.
5778     6909 FORMAT( ' AG',F8.2,1X,3F7.2,F10.3,10F9.3) 5643.
5779     6910 FORMAT(1I1/T26,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5644.
5780     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5645.
5781     + /5X,89('-'),5X,34('-')) 5646.
5782     6911 FORMAT(1X,'LN K=',I4,9I9,7X,'K=',I3,3I9) 5647.
5783     6912 FORMAT( 1X,I2,1X,10F9.3,3X,4F9.3) 5648.
5784     6913 FORMAT(/' SL',1X,10F9.3,3X,4F9.3) 5649.
5785     6914 FORMAT(/' BG',1X,10F9.3,3X,4F9.3) 5650.
5786     6915 FORMAT( ' PF',1X,10F9.3,3X,4F9.3) 5651.
5787     6916 FORMAT( ' FR',1X,10F9.5,3X,4F9.5) 5652.
5788     6917 FORMAT(/' AC',1X,10F9.3,3X,4F9.3) 5653.
5789     6918 FORMAT( ' AG',1X,10F9.3,3X,4F9.3) 5654.
5790     RETURN 5655.
5791     C 5656.
5792     C------------- 5657.
5793     1000 CONTINUE 5658.
5794     C------------- 5659.
5795     C 5660.
5796     NPAGE=1 5661.
5797     IF(INDEX.LT.11) NPAGE=KPAGE 5662.
5798     WRITE(6,7001) NPAGE 5663.
5799     7001 FORMAT(1I1,'(10) BLOCK DATA AEROSOL PROPERTY SPECIFICATION:') 5664.
5800     9999 CONTINUE 5665.
5801     RETURN 5666.
5802     END 5667.
5803     SUBROUTINE SOLARZ(NG,KWRITE) 5668.
5804     #include "B83XX.COM" 5669.
5805     DIMENSION SRDATA(187),ZRDATA(187) 5730.
5806     EQUIVALENCE (SRDFLB(1),SRDATA(1)) 5731.
5807     c DOUBLE PRECISION XMU(50),WT(50) 5732.
5808     dimension XMU(50),WT(50)
5809     DATA NSRD/187/ 5733.
5810     DIMENSION NOFLUX(7) 5734.
5811     DATA NOFLUX/164,167,168,169,170,171,174/ 5735.
5812     C 5736.
5813     C------------------------------------- 5737.
5814     CALL GAUSST(NG,0.D0,1.D0,XMU,WT) 5738.
5815     C------------------------------------- 5739.
5816     DO 100 J=1,NG 5740.
5817     100 WT(J)=WT(J)*2.D0*XMU(J) 5741.
5818     C 5742.
5819     DO 110 I=1,NSRD 5743.
5820     110 ZRDATA(I)=0. 5744.
5821     C 5745.
5822     NORM=NORMS0 5746.
5823     ZCOS=COSZ 5747.
5824     C 5748.
5825     DO 130 J=1,NG 5749.
5826     COSZ=XMU(J) 5750.
5827     NORMS0=1 5751.
5828     C--------------- 5752.
5829     CALL SOLAR 5753.
5830     C--------------- 5754.
5831     DO 120 I=1,NSRD 5755.
5832     120 ZRDATA(I)=ZRDATA(I)+SRDATA(I)*WT(J) 5756.
5833     KPAGE=J-(J/2)*2 5757.
5834     IF(KWRITE.GT.1) CALL WRITER(3,KPAGE) 5758.
5835     130 CONTINUE 5759.
5836     C 5760.
5837     DO 150 I=1,NSRD 5761.
5838     FACTOR=0.25 5762.
5839     DO 140 K=1,7 5763.
5840     IF(I.EQ.NOFLUX(K)) FACTOR=1. 5764.
5841     140 CONTINUE 5765.
5842     IF(I.GT.176) FACTOR=1. 5766.
5843     150 SRDATA(I)=ZRDATA(I)*FACTOR 5767.
5844     COSZ=NG 5768.
5845     IF(NG.GT.9) COSZ=.1*NG 5769.
5846     COSZ=COSZ+NG/1000. 5770.
5847     KPAGE=1 5771.
5848     C 5772.
5849     NORMS0=100 5773.
5850     C 5774.
5851     IF(KWRITE.GT.0) CALL WRITER(13,KPAGE) 5775.
5852     C 5776.
5853     COSZ=ZCOS 5777.
5854     NORMS0=NORM 5778.
5855     C 5779.
5856     RETURN 5780.
5857     END 5781.
5858     SUBROUTINE GAUSST(NG,X1,X2,XP,WT) 5782.
5859     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 5783.
5860     DIMENSION XP(1),WT(1) 5784.
5861     real*8 pi, ps, dxl
5862     DATA PI,PS,DXL/3.141592653589793D0,1.013211836423378D-01,1.D-16/ 5785.
5863     XMID=(X2+X1)/2.D0 5786.
5864     XDIF=X2-X1 5787.
5865     XHAF=XDIF/2.D0 5788.
5866     DNG=NG 5789.
5867     NN=NG/2 5790.
5868     N2=NN*2 5791.
5869     IF(N2.EQ.NG) GO TO 110 5792.
5870     XP(NN+1)=XMID 5793.
5871     WT(NN+1)=XDIF 5794.
5872     IF(NG.LT.2) RETURN 5795.
5873     PN=1.D0 5796.
5874     N=0 5797.
5875     100 N=N+2 5798.
5876     DN=N 5799.
5877     DM=DN-1.D0 5800.
5878     PN=PN*(DM/DN) 5801.
5879     IF(N.LT.N2) GO TO 100 5802.
5880     WT(NN+1)=XDIF/(DNG*PN)**2 5803.
5881     110 I=0 5804.
5882     C=PI/DSQRT(DNG*(DNG+1.D0)+0.5D0-PS)/105.D0 5805.
5883     120 I=I+1 5806.
5884     DI=I 5807.
5885     Z=PS/(4.D0*DI-1.D0)**2 5808.
5886     ZZ=(105.D0+Z*(210.D0-Z*(2170.D0-Z*(105812.D0-12554474.D0*Z)))) 5809.
5887     X=DCOS(ZZ*C*(DI-0.25D0)) 5810.
5888     130 N=1 5811.
5889     DM=1.D0 5812.
5890     PNI=1.D0 5813.
5891     PNJ=X 5814.
5892     140 N=N+1 5815.
5893     DN=N 5816.
5894     PNK=((DM+DN)*X*PNJ-DM*PNI)/DN 5817.
5895     PNI=PNJ 5818.
5896     PNJ=PNK 5819.
5897     DM=DN 5820.
5898     IF(N.LT.NG) GO TO 140 5821.
5899     DX=PNJ*(1.D0-X*X)/DNG/(PNI-X*PNJ) 5822.
5900     X=X-DX 5823.
5901     IF(DABS(DX).GT.DXL) GO TO 130 5824.
5902     J=NG+1-I 5825.
5903     XP(I)=XMID-XHAF*X 5826.
5904     XP(J)=XMID+XHAF*X 5827.
5905     WT(I)=XDIF*(1.D0-X*X)/(DNG*PNI)**2 5828.
5906     WT(J)=WT(I) 5829.
5907     IF(I.LT.NN) GO TO 120 5830.
5908     RETURN 5831.
5909     END 5832.
5910     SUBROUTINE SETATM 5833.
5911     #include "B83XX.COM" 5834.
5912     DIMENSION NL4(4),PLB4(40,4) 5877.
5913     DATA NL4/12,12,24,35/ 5878.
5914     DATA PLB4/ 5879.
5915     1 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 5880.
5916     1 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 5881.
5917     1 1.E-05, 27*0., 5882.
5918     C 5883.
5919     2 984.0000, 934.0000, 854.0000, 720.0000, 550.0000, 390.0000, 5884.
5920     2 255.0000, 150.0000, 70.0000, 10.0000, 5.0000, 2.0000, 5885.
5921     2 1.E-05, 27*0., 5886.
5922     C 5887.
5923     3 1013.2500, 988.8846, 956.9068, 910.2775, 820.4963, 683.6775, 5888.
5924     3 521.6665, 356.3138, 209.4467, 102.9552, 47.7944, 22.1797, 5889.
5925     3 10.29439, 4.77932, 2.21785, 1.01932, 0.46761, 0.21156, 5890.
5926     3 0.092671, 0.047500, 0.021885, 0.010000, 0.005000, 0.002000, 5891.
5927     3 1.00E-05, 15*0.0, 5892.
5928     C 5893.
5929     4 1013.2500,1000.0000, 950.0000, 900.0000, 850.0000, 800.0000, 5894.
5930     4 750.0000, 700.0000, 650.0000, 600.0000, 550.0000, 500.0000, 5895.
5931     4 450.0000, 400.0000, 350.0000, 300.0000, 250.0000, 200.0000, 5896.
5932     4 150.0000, 100.0000, 50.0000, 20.0000, 10.0000, 5.0000, 5897.
5933     4 2.0000, 1.0000, 0.5000, 0.2000, 0.1000, 0.0500, 5898.
5934     4 0.0200, 0.0100, 0.0050, 0.0020, 0.0010, 1.E-05, 5899.
5935     4 4*0./ 5900.
5936     C 5901.
5937     LAST=LASTVC 5902.
5938     LMAG=100000 5903.
5939     C ------------------------------------------ 5904.
5940     C NLAY: ATMOSPHERIC LAYERING SPECIFICATION 5905.
5941     C ------------------------------------------ 5906.
5942     NLAY=LAST/LMAG 5907.
5943     LAST=LAST-LMAG*NLAY 5908.
5944     LMAG=LMAG/10 5909.
5945     C 5910.
5946     KSCALE=0 5911.
5947     IF(NLAY.GT.9) KSCALE=1 5912.
5948     IF(NLAY.GT.9) NLAY=NLAY-10 5913.
5949     C 5914.
5950     IF(NLAY.LT.1.OR.NLAY.GT.8) GO TO 20 5915.
5951     GO TO (10,10,10,10,12,14,16,18),NLAY 5916.
5952     10 NL=NL4(NLAY) 5917.
5953     NLP=NL+1 5918.
5954     C (1-4)=(12,12,24,35 PRESSURE SPECIFICATIONS)5919.
5955     C -------------------------------------------5920.
5956     DO 11 N=1,NLP 5921.
5957     11 PLB(N)=PLB4(N,NLAY) 5922.
5958     GO TO 20 5923.
5959     C (5)=(1-D MODEL LAYER SPECIFICATION)5924.
5960     C -----------------------------------5925.
5961     12 NL=18 5926.
5962     DO 13 N=1,NL 5927.
5963     HLB(N)=N-1+2*(N/7) 5928.
5964     IF(N.GT. 8) HLB(N)=4*N-24-N/11-N/12 5929.
5965     13 IF(N.GT.13) HLB(N)=30+(N-14)*5 5930.
5966     HLB( 1)=1.0E-10 5931.
5967     HLB(19)=99.99 5932.
5968     GO TO 20 5933.
5969     C (6)=(LINE-BY-LINE LAYER SPECIFICATION)5934.
5970     C --------------------------------------5935.
5971     14 NL=30 5936.
5972     DO 15 N=1,NL 5937.
5973     HLB(N)=N-1+(N-17)*(N/17) 5938.
5974     15 IF(N.GT.20) HLB(N)=20+(N-20)*5 5939.
5975     HLB( 1)=1.0E-10 5940.
5976     HLB(31)=99.99 5941.
5977     GO TO 20 5942.
5978     C (7)=(MCCLATCHEY LAYER SPECIFICATION)5943.
5979     C ------------------------------------5944.
5980     16 NL=32 5945.
5981     DO 17 N=1,NL 5946.
5982     HLB(N)=N-1 5947.
5983     17 IF(N.GT.25) HLB(N)=25+5*(N-26) 5948.
5984     HLB( 1)=1.0E-10 5949.
5985     HLB(32)=70.00 5950.
5986     HLB(33)=99.99 5951.
5987     GO TO 20 5952.
5988     C (8)=(HI-RES LAYER SPECIFICATION)5953.
5989     C --------------------------------5954.
5990     18 NL=39 5955.
5991     DO 19 N=1,NL 5956.
5992     HLB(N)=N-1 5957.
5993     IF(N.GT.21) HLB(N)=20+(N-21)*2 5958.
5994     IF(N.GT.31) HLB(N)=40+(N-31)*5 5959.
5995     19 IF(N.GT.37) HLB(N)=70+(N-37)*10 5960.
5996     HLB( 1)=1.0E-10 5961.
5997     HLB(40)=99.99 5962.
5998     C 5963.
5999     C ------------------------------------------- 5964.
6000     C NATM: ATMOSPHERIC STRUCTURE SPECIFICATION 5965.
6001     C ------------------------------------------- 5966.
6002     20 NATM=LAST/LMAG 5967.
6003     LAST=LAST-LMAG*NATM 5968.
6004     LMAG=LMAG/10 5969.
6005     C 5970.
6006     IF(KSCALE.NE.1) GO TO 24 5971.
6007     C 5972.
6008     C SIGMA LEVEL RESCALING OF PRESSURES RELATIVE TO PSIG05973.
6009     C ----------------------------------------------------5974.
6010     C 5975.
6011     NLMOD=NL-LAYRAD 5976.
6012     IF(NLAY.GT.4) GO TO 22 5977.
6013     PTOP=PLB(NLMOD+1) 5978.
6014     PBOT=PLB(1) 5979.
6015     DO 21 L=1,NLMOD 5980.
6016     PSIG(L)=(PLB(L)-PTOP)/(PBOT-PTOP) 5981.
6017     21 PLB(L) =PSIG(L)*(PSIG0-PTOP)+PTOP 5982.
6018     PSIG(NLMOD+1)=0. 5983.
6019     GO TO 24 5984.
6020     C 5985.
6021     C SIGMA LEVEL RESCALING OF HEIGHTS RELATIVE TO PSIG05986.
6022     C --------------------------------------------------5987.
6023     22 HTOP=HLB(NLMOD+1) 5988.
6024     HBOT=HLB(1) 5989.
6025     DO 23 L=1,NLMOD 5990.
6026     PSIG(L)=(HLB(L)-HTOP)/(HBOT-HTOP) 5991.
6027     23 HLB(L) =PSIG(L)*(PSIG0-HTOP)+HTOP 5992.
6028     PSIG(NLMOD+1)=0. 5993.
6029     24 CONTINUE 5994.
6030     C 5995.
6031     NLP=NL+1 5996.
6032     NPHD=1+NLAY/5 5997.
6033     N=1 5998.
6034     IF(NPHD.EQ.1) P=PLB(N) 5999.
6035     IF(NPHD.EQ.2) H=HLB(N) 6000.
6036     CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6001.
6037     IF(NPHD.EQ.1) HLB(N)=H 6002.
6038     IF(NPHD.EQ.2) PLB(N)=P 6003.
6039     PB=P 6004.
6040     TB=T 6005.
6041     OB=OCM 6006.
6042     WB=WCM 6007.
6043     DO 25 N=1,NL 6008.
6044     IF(NPHD.EQ.1) P=PLB(N+1) 6009.
6045     IF(NPHD.EQ.2) H=HLB(N+1) 6010.
6046     CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6011.
6047     IF(NPHD.EQ.1) HLB(N+1)=H 6012.
6048     IF(NPHD.EQ.2) PLB(N+1)=P 6013.
6049     TLB(N)=TB 6014.
6050     TLT(N)=T 6015.
6051     TLM(N)=0.5*(T+TB) 6016.
6052     U0GAS(N,1)=WB-WCM 6017.
6053     U0GAS(N,3)=OB-OCM 6018.
6054     SHL(N)=U0GAS(N,1)/(U0GAS(N,1)+1268.75*(PB-P)) 6019.
6055     EQ=0.5*(PB+P)*SHL(N)/(0.662+0.338*SHL(N)) 6020.
6056     C$ EQ=0.5*(PB+P)*SHL(N)/(0.622+0.338*SHL(N)) 6021.
6057     ES=10.0**(9.4051-2353.0/TLM(N)) 6022.
6058     RHL(N)=EQ/ES 6023.
6059     PB=P 6024.
6060     TB=T 6025.
6061     OB=OCM 6026.
6062     25 WB=WCM 6027.
6063     TLB(NLP)=TLT(NL) 6028.
6064     TSL=TLB(1) 6029.
6065     TGO=TLB(1) 6030.
6066     TGE=TLB(1) 6031.
6067     TGOI=TGO-5. 6032.
6068     TGLI=TGE-5. 6033.
6069     C ---------------------------------- 6034.
6070     C NSUR: SURFACE TYPE SPECIFICATION 6035.
6071     C ---------------------------------- 6036.
6072     30 NSUR=LAST/LMAG 6037.
6073     LAST=LAST-LMAG*NSUR 6038.
6074     LMAG=LMAG/10 6039.
6075     C 6040.
6076     IF(NSUR.EQ.0) GO TO 40 6041.
6077     POCEAN=0. 6042.
6078     PEARTH=0. 6043.
6079     POICE =0. 6044.
6080     PLICE =0. 6045.
6081     AGESN =0. 6046.
6082     SNOWE =0. 6047.
6083     SNOWOI=0. 6048.
6084     SNOWLI=0. 6049.
6085     C 6050.
6086     IF(NSUR.EQ.1) POCEAN=1. 6051.
6087     IF(NSUR.EQ.2) PEARTH=1. 6052.
6088     IF(NSUR.EQ.3) POICE =1. 6053.
6089     IF(NSUR.EQ.4) PLICE =1. 6054.
6090     IF(NSUR.EQ.5) PEARTH=1. 6055.
6091     IF(NSUR.EQ.5) SNOWE =1. 6056.
6092     IF(NSUR.GT.5) PLICE =1. 6057.
6093     IF(NSUR.EQ.6) SNOWLI=1. 6058.
6094     IF(NSUR.LT.7) GO TO 40 6059.
6095     BXAVIS=0. 6060.
6096     BXANIR=0. 6061.
6097     IF(NSUR.EQ.7) BXAVIS=1. 6062.
6098     IF(NSUR.GT.7) BXANIR=1. 6063.
6099     IF(NSUR.EQ.9) BXAVIS=1. 6064.
6100     DO 31 I=1,5 6065.
6101     SRBXAL(I,1)=BXANIR 6066.
6102     31 SRBXAL(I,2)=BXANIR 6067.
6103     SRBXAL(6,1)=BXAVIS 6068.
6104     SRBXAL(6,2)=BXAVIS 6069.
6105     IF(KALVIS.GT.0) SRBXAL(4,1)=SRBXAL(6,1) 6070.
6106     IF(KALVIS.GT.0) SRBXAL(4,2)=SRBXAL(6,2) 6071.
6107     C 6072.
6108     C ---------------------------------------- 6073.
6109     C NTRA: TRACER COMPOSITION SPECIFICATION 6074.
6110     C ---------------------------------------- 6075.
6111     40 NTRA=LAST/LMAG 6076.
6112     LAST=LAST-LMAG*NTRA 6077.
6113     LMAG=LMAG/10 6078.
6114     C 6079.
6115     TAUT55=1.0 6080.
6116     NTRACE=1 6081.
6117     IF(NTRA.LT.1) TAUT55=0. 6082.
6118     IF(NTRA.LT.1) NTRACE=0 6083.
6119     ITR(1)=NTRA 6084.
6120     DO 41 L=1,NL 6085.
6121     41 TRACER(L,1)=TAUT55*(PLB(L)-PLB(L+1))/PLB(1) 6086.
6122     C 6087.
6123     C ------------------------------------- 6088.
6124     C NVEG: VEGETATION TYPE SPECIFICATION 6089.
6125     C ------------------------------------- 6090.
6126     50 NVEG=LAST/LMAG 6091.
6127     LAST=LAST-LMAG*NVEG 6092.
6128     LMAG=LMAG/10 6093.
6129     C 6094.
6130     DO 51 K=1,11 6095.
6131     51 PVT(K)=0. 6096.
6132     IF(NVEG.LT.1) GO TO 60 6097.
6133     PVT(NVEG)=1. 6098.
6134     C ------------------------------------- 6099.
6135     C NCLD: CLOUD LAYER,TAU SPECIFICATION 6100.
6136     C ------------------------------------- 6101.
6137     60 NCLD=LAST 6102.
6138     DO 61 L=1,NL 6103.
6139     61 CLDTAU(L)=0. 6104.
6140     IF(NCLD.GT.0) CLDTAU(NCLD)=64./2**NCLD 6105.
6141     RETURN 6106.
6142     END 6107.
6143     SUBROUTINE SETFOR(NFTFOR) 6108.
6144     #include "B83XX.COM" 6109.
6145     C COMMON/TMINOR/FCO2,FN2O,FCH4,FF11,FF12,FVOL,FSUN 6150.
6146     C 6151.
6147     C-----------------------------------------------------------------------6152.
6148     C EXTERNAL FORCING FOR CO2,N2O,CH4,F11,F12,VOLCANIC AER,SOLAR CONST6153.
6149     C STARTING FROM JAN 1,1880 PROJECTED THROUGH DEC 31,2100 6154.
6150     C INPUT FORCING DATA READ IN FROM DISK DATA DSN=CLIM.RUN.FORCING 6155.
6151     C 6156.
6152     C CALL SETFOR TO READ IN AND/OR INITIALIZE DATA AND/OR RESET PARAMS6157.
6153     C 6158.
6154     C IF(NFTFOR.GT.0) FORCING DATA WILL BE READ IN FROM DISKUNIT=NFTFOR6159.
6155     C IF(NFTFOR.EQ.0) NO DATA READ, SELECT CONSTITUENTS FOR EXT FORCING6160.
6156     C IF(NFTFOR.LT.0) NO DATA READ, RESET ONLY SOL CONST REFERENCE VALU6161.
6157     C-----------------------------------------------------------------------6162.
6158     C 6163.
6159     DIMENSION YEAR(221),SCO2(221),SCH4(221),SN2O(221) 6164.
6160     DIMENSION SF11(221),SF12(221),UPPM(221) 6165.
6161     DIMENSION TAUS(12,221),TAUM(2652) 6166.
6162     EQUIVALENCE (TAUS(1,1),TAUM(1)) 6167.
6163     C 6168.
6164     DIMENSION INDEX(9),INFOR(9) 6169.
6165     EQUIVALENCE (INFOR(1),KVOL),(INFOR(2),KCO2),(INFOR(3),KXXX) 6170.
6166     EQUIVALENCE (INFOR(4),KSUN),(INFOR(5),KYYY),(INFOR(6),KN2O) 6171.
6167     EQUIVALENCE (INFOR(7),KCH4),(INFOR(8),KF11),(INFOR(9),KF12) 6172.
6168     C 6173.
6169     DIMENSION DMO(12),JDY(12) 6174.
6170     DATA DMO/31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31./ 6175.
6171     DATA JDY/31,59,90,120,151,181,212,243,278,304,334,365/ 6176.
6172     C 6177.
6173     IF(NFTFOR.LT.0) GO TO 150 6178.
6174     IF(NFTFOR.LT.1) GO TO 110 6179.
6175     C 6180.
6176     REWIND NFTFOR 6181.
6177     READ (NFTFOR) NOUT,NEND,KFS,KCS,(YEAR(L),SCO2(L),SCH4(L),SN2O(L) 6182.
6178     + ,SF11(L),SF12(L),UPPM(L),(TAUS(K,L),K=1,12),L=1,221)6183.
6179     + ,IDATE 6184.
6180     REWIND NFTFOR 6184.5
6181     C 6185.
6182     ID5(5)=IDATE+10*KFS+KCS 6186.
6183     C 6187.
6184     C-----------------------------------------------------------------------6188.
6185     C REFERENCE YEAR IS (1958) WHERE FULGAS(K)=1 FOR CO2,N2O,CH4,F11,F126189.
6186     C MEAN 1958 BACKGROUND CO2=315 N2O=.295 CH4=1.4 F11=8.E-6 F12=25.E-66190.
6187     C GAS PPM IS LINEARLY INTERPOLATED (MEAN ANNUAL PPM OCCURS JDAY=183)6191.
6188     C 6192.
6189     C BACKGROUND TAU STRATAER=0.012 (VOLCANIC CONTRIBUTION IS ADDITIVE)6193.
6190     C 6194.
6191     C KFS=IDENTIFIER FOR F11,F12 ABUNDANCE SCENARIOS 6195.
6192     C KCS=IDENTIFIER FOR CO2 ABUNDANCE SCENARIOS 6196.
6193     C ID5(5)=IDATE+10*KFS+KCS IS THE FORCING DATA SET IDENTIFIER 6197.
6194     C-----------------------------------------------------------------------6198.
6195     C 6199.
6196     RRCO2=PPMV58(2) 6200.
6197     RCH4=PPMV58(7) 6201.
6198     RN2O=PPMV58(6) 6202.
6199     C (F11,F12 EXTERNAL FORCING DATA ARE IN PPM) 6203.
6200     RF11=PPMV58(8)*1000. 6204.
6201     RF12=PPMV58(9)*1000. 6205.
6202     C 6206.
6203     RVOL=AGOLDH(1,1) 6207.
6204     C-----------------------------------------------------------------------6208.
6205     C 6209.
6206     C SELECT CONSTITUENTS FOR WHICH EXTERNAL FORCING WILL BE IMPLEMENTED6210.
6207     C 6211.
6208     C KFORCE IS AN INTEGER UP TO NINE DIGITS LONG, SUCH THAT EACH DIGIT6212.
6209     C IS AN ON/OFF SWITCH FOR IMPLEMENTING EXTERNAL FORCING FOR:6213.
6210     C 6214.
6211     C (1) (2) (4) (6) (7) (8) (9) CODED DIGITS 6215.
6212     C VOL-AER, CO2, SOL-CON, N2O, CH4, F11, F12, RESPECTIVELY. 6216.
6213     C (THE DIGITS (3) & (5)...ARE NOT USED)6217.
6214     C 6218.
6215     C EXAMPLE: 1206789 SELECTS FORCING FOR ALL EXCEPT SOL CONST6219.
6216     C (ORDER OR REPETITION OF DIGITS IS NOT IMPORTANT)6220.
6217     C-----------------------------------------------------------------------6221.
6218     110 KFOR=KFORCE 6222.
6219     KMAG=100000000 6223.
6220     DO 120 K=1,9 6224.
6221     KF=KFOR/KMAG 6225.
6222     INDEX(K)=KF 6226.
6223     KFOR=KFOR-KF*KMAG 6227.
6224     120 KMAG=KMAG/10 6228.
6225     DO 130 K=1,9 6229.
6226     130 INFOR(K)=0 6230.
6227     DO 140 K=1,9 6231.
6228     IF(INDEX(K).EQ.0) GO TO 140 6232.
6229     INFOR(INDEX(K))=1 6233.
6230     140 CONTINUE 6234.
6231     C 6235.
6232     C-----------------------------------------------------------------------6236.
6233     C SELECT REFERENCE SOLAR CONSTANT (S0) AS PASSED IN COMMON/RADCOM/6237.
6234     C-----------------------------------------------------------------------6238.
6235     C 6239.
6236     150 S00=S0 6240.
6237     RETURN 6241.
6238     C 6242.
6239     C----------------- 6243.
6240     ENTRY GETFOR 6244.
6241     C----------------- 6245.
6242     C 6246.
6243     C-----------------------------------------------------------------------6247.
6244     C EXTERNAL FORCING RETURNED FOR CONSTITUENTS PRESELECTED IN SETFOR6248.
6245     C 6249.
6246     C RADCOM INPUT DATA: JYEAR, JDAY 6250.
6247     C 6251.
6248     C RADCOM OUTPUT DATA: FULGAS(K),K=2,6,7,8,9; FGOLDH(1), S06252.
6249     C 6253.
6250     C-----------------------------------------------------------------------6254.
6251     C 6255.
6252     JDM=JDAY 6256.
6253     DO 210 JMONTH=1,12 6257.
6254     IF(JDAY.GT.JDY(JMONTH)) GO TO 210 6258.
6255     GO TO 220 6259.
6256     210 JDM=JDAY-JDY(JMONTH) 6260.
6257     JMONTH=12 6261.
6258     220 MO=JMONTH+(JYEAR-1880)*12 6262.
6259     IF(MO.LT. 1) MO=1 6263.
6260     IF(MO.GT.2651) MO=2651 6264.
6261     C 6265.
6262     FRACYR=(JDAY-183)/365. 6266.
6263     FRACMO=JDM/DMO(JMONTH) 6267.
6264     C 6268.
6265     NY=JYEAR-1880+1 6269.
6266     IF(JDAY.LT.183) NY=NY-1 6270.
6267     IF(JDAY.LT.183) FRACYR=FRACYR+0.5 6271.
6268     IF(NY.LT. 1) NY=1 6272.
6269     IF(NY.GT.220) NY=220 6273.
6270     FCO2=SCO2(NY)+(SCO2(NY+1)-SCO2(NY))*FRACYR 6274.
6271     FCH4=SCH4(NY)+(SCH4(NY+1)-SCH4(NY))*FRACYR 6275.
6272     FN2O=SN2O(NY)+(SN2O(NY+1)-SN2O(NY))*FRACYR 6276.
6273     FF11=SF11(NY)+(SF11(NY+1)-SF11(NY))*FRACYR 6277.
6274     FF12=SF12(NY)+(SF12(NY+1)-SF12(NY))*FRACYR 6278.
6275     FSUN=UPPM(NY)+(UPPM(NY+1)-UPPM(NY))*FRACYR 6279.
6276     FVOL=TAUM(MO)+(TAUM(MO+1)-TAUM(MO))*FRACMO 6280.
6277     C 6281.
6278     C-----------------------------------------------------------------------6282.
6279     C OUTPUT FORCING DATA6283.
6280     C-----------------------------------------------------------------------6284.
6281     C 6285.
6282     IF(KCO2.GT.0) FULGAS(2)=FCO2/RRCO2 6286.
6283     IF(KN2O.GT.0) FULGAS(6)=FN2O/RN2O 6287.
6284     IF(KCH4.GT.0) FULGAS(7)=FCH4/RCH4 6288.
6285     IF(KF11.GT.0) FULGAS(8)=FF11/RF11 6289.
6286     IF(KF12.GT.0) FULGAS(9)=FF12/RF12 6290.
6287     IF(KVOL.GT.0) FGOLDH(1)=(RVOL+FVOL)/RVOL 6291.
6288     IF(KSUN.GT.0) S0=S00+S00*0.03*(FSUN-0.2) 6292.
6289     C 6293.
6290     RETURN 6294.
6291     END 6295.
6292     SUBROUTINE HGAER1(XMU,TAU,G,GG) 6301.
6293     C 6302.
6294     DIMENSION C05T00(51),C06T00(51),C07T00(51),C08T00(51),C09T00(51) 6303.
6295     DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6304.
6296     DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6305.
6297     DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6306.
6298     DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6307.
6299     DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6308.
6300     DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6309.
6301     DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6310.
6302     DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6311.
6303     DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6312.
6304     DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6313.
6305     C 6314.
6306     DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6315.
6307     DIMENSION C09TAU(51,11) 6316.
6308     C 6317.
6309     DIMENSION GTAU(51,11,5) 6318.
6310     C 6319.
6311     EQUIVALENCE (C05TAU(1, 1),C05T00(1)),(C05TAU(1, 2),C05T01(1)) 6320.
6312     EQUIVALENCE (C05TAU(1, 3),C05T02(1)),(C05TAU(1, 4),C05T03(1)) 6321.
6313     EQUIVALENCE (C05TAU(1, 5),C05T04(1)),(C05TAU(1, 6),C05T05(1)) 6322.
6314     EQUIVALENCE (C05TAU(1, 7),C05T06(1)),(C05TAU(1, 8),C05T07(1)) 6323.
6315     EQUIVALENCE (C05TAU(1, 9),C05T08(1)),(C05TAU(1,10),C05T09(1)) 6324.
6316     EQUIVALENCE (C05TAU(1,11),C05T10(1)) 6325.
6317     C 6326.
6318     EQUIVALENCE (C06TAU(1, 1),C06T00(1)),(C06TAU(1, 2),C06T01(1)) 6327.
6319     EQUIVALENCE (C06TAU(1, 3),C06T02(1)),(C06TAU(1, 4),C06T03(1)) 6328.
6320     EQUIVALENCE (C06TAU(1, 5),C06T04(1)),(C06TAU(1, 6),C06T05(1)) 6329.
6321     EQUIVALENCE (C06TAU(1, 7),C06T06(1)),(C06TAU(1, 8),C06T07(1)) 6330.
6322     EQUIVALENCE (C06TAU(1, 9),C06T08(1)),(C06TAU(1,10),C06T09(1)) 6331.
6323     EQUIVALENCE (C06TAU(1,11),C06T10(1)) 6332.
6324     C 6333.
6325     EQUIVALENCE (C07TAU(1, 1),C07T00(1)),(C07TAU(1, 2),C07T01(1)) 6334.
6326     EQUIVALENCE (C07TAU(1, 3),C07T02(1)),(C07TAU(1, 4),C07T03(1)) 6335.
6327     EQUIVALENCE (C07TAU(1, 5),C07T04(1)),(C07TAU(1, 6),C07T05(1)) 6336.
6328     EQUIVALENCE (C07TAU(1, 7),C07T06(1)),(C07TAU(1, 8),C07T07(1)) 6337.
6329     EQUIVALENCE (C07TAU(1, 9),C07T08(1)),(C07TAU(1,10),C07T09(1)) 6338.
6330     EQUIVALENCE (C07TAU(1,11),C07T10(1)) 6339.
6331     C 6340.
6332     EQUIVALENCE (C08TAU(1, 1),C08T00(1)),(C08TAU(1, 2),C08T01(1)) 6341.
6333     EQUIVALENCE (C08TAU(1, 3),C08T02(1)),(C08TAU(1, 4),C08T03(1)) 6342.
6334     EQUIVALENCE (C08TAU(1, 5),C08T04(1)),(C08TAU(1, 6),C08T05(1)) 6343.
6335     EQUIVALENCE (C08TAU(1, 7),C08T06(1)),(C08TAU(1, 8),C08T07(1)) 6344.
6336     EQUIVALENCE (C08TAU(1, 9),C08T08(1)),(C08TAU(1,10),C08T09(1)) 6345.
6337     EQUIVALENCE (C08TAU(1,11),C08T10(1)) 6346.
6338     C 6347.
6339     EQUIVALENCE (C09TAU(1, 1),C09T00(1)),(C09TAU(1, 2),C09T01(1)) 6348.
6340     EQUIVALENCE (C09TAU(1, 3),C09T02(1)),(C09TAU(1, 4),C09T03(1)) 6349.
6341     EQUIVALENCE (C09TAU(1, 5),C09T04(1)),(C09TAU(1, 6),C09T05(1)) 6350.
6342     EQUIVALENCE (C09TAU(1, 7),C09T06(1)),(C09TAU(1, 8),C09T07(1)) 6351.
6343     EQUIVALENCE (C09TAU(1, 9),C09T08(1)),(C09TAU(1,10),C09T09(1)) 6352.
6344     EQUIVALENCE (C09TAU(1,11),C09T10(1)) 6353.
6345     C 6354.
6346     EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6355.
6347     EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6356.
6348     EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6357.
6349     C 6358.
6350     C 6359.
6351     DATA C05T00/0.0, 6360.
6352     1 .0179,.0379,.0574,.0767,.0958,.1147,.1334,.1520,.1703,.1884, 6361.
6353     2 .2062,.2238,.2410,.2580,.2747,.2910,.3070,.3226,.3380,.3530, 6362.
6354     3 .3675,.3819,.3958,.4094,.4227,.4355,.4481,.4603,.4722,.4838, 6363.
6355     4 .4950,.5059,.5166,.5269,.5370,.5468,.5563,.5655,.5745,.5832, 6364.
6356     5 .5917,.5999,.6079,.6157,.6233,.6306,.6378,.6445,.6513,.6578/ 6365.
6357     C 6366.
6358     DATA C05T01/0.0, 6367.
6359     1 .0000,.0226,.0463,.0679,.0885,.1084,.1278,.1469,.1655,.1838, 6368.
6360     2 .2018,.2194,.2367,.2537,.2704,.2866,.3026,.3182,.3335,.3484, 6369.
6361     3 .3630,.3773,.3911,.4047,.4180,.4308,.4433,.4556,.4675,.4791, 6370.
6362     4 .4904,.5014,.5121,.5224,.5326,.5424,.5520,.5613,.5703,.5792, 6371.
6363     5 .5877,.5961,.6041,.6120,.6197,.6271,.6344,.6414,.6483,.6550/ 6372.
6364     C 6373.
6365     DATA C05T02/0.0, 6374.
6366     1 .0000,.0207,.0434,.0649,.0856,.1057,.1252,.1444,.1632,.1816, 6375.
6367     2 .1996,.2173,.2346,.2516,.2683,.2845,.3005,.3161,.3313,.3463, 6376.
6368     3 .3608,.3750,.3889,.4024,.4156,.4284,.4410,.4532,.4651,.4767, 6377.
6369     4 .4880,.4990,.5097,.5201,.5303,.5401,.5497,.5591,.5682,.5771, 6378.
6370     5 .5857,.5941,.6022,.6102,.6179,.6254,.6327,.6398,.6467,.6535/ 6379.
6371     C 6380.
6372     DATA C05T03/0.0, 6381.
6373     1 .0095,.0317,.0517,.0712,.0904,.1095,.1283,.1469,.1651,.1832, 6382.
6374     2 .2009,.2184,.2355,.2523,.2688,.2849,.3008,.3162,.3313,.3461, 6383.
6375     3 .3605,.3747,.3885,.4019,.4151,.4278,.4403,.4525,.4643,.4759, 6384.
6376     4 .4872,.4981,.5089,.5192,.5294,.5392,.5488,.5582,.5673,.5762, 6385.
6377     5 .5848,.5932,.6013,.6093,.6170,.6246,.6319,.6391,.6460,.6528/ 6386.
6378     C 6387.
6379     DATA C05T04/0.0, 6388.
6380     1 .0260,.0472,.0656,.0833,.1008,.1183,.1359,.1534,.1709,.1882, 6389.
6381     2 .2053,.2223,.2389,.2554,.2715,.2873,.3029,.3181,.3330,.3476, 6390.
6382     3 .3619,.3759,.3895,.4028,.4158,.4284,.4408,.4529,.4647,.4762, 6391.
6383     4 .4873,.4982,.5089,.5192,.5293,.5391,.5487,.5580,.5671,.5759, 6392.
6384     5 .5845,.5929,.6010,.6090,.6167,.6243,.6316,.6388,.6457,.6525/ 6393.
6385     C 6394.
6386     DATA C05T05/0.0, 6395.
6387     1 .0428,.0635,.0812,.0978,.1140,.1302,.1465,.1629,.1793,.1958, 6396.
6388     2 .2121,.2284,.2444,.2603,.2760,.2914,.3066,.3214,.3360,.3504, 6397.
6389     3 .3643,.3781,.3915,.4046,.4175,.4299,.4422,.4541,.4657,.4771, 6398.
6390     4 .4882,.4990,.5095,.5197,.5298,.5395,.5490,.5583,.5673,.5761, 6399.
6391     5 .5846,.5930,.6011,.6090,.6167,.6243,.6316,.6387,.6457,.6524/ 6400.
6392     C 6401.
6393     DATA C05T06/0.0, 6402.
6394     1 .0590,.0796,.0969,.1129,.1283,.1435,.1588,.1741,.1896,.2051, 6403.
6395     2 .2206,.2360,.2514,.2667,.2818,.2967,.3114,.3258,.3401,.3541, 6404.
6396     3 .3677,.3812,.3943,.4072,.4198,.4321,.4441,.4559,.4673,.4786, 6405.
6397     4 .4895,.5002,.5106,.5207,.5306,.5403,.5497,.5589,.5678,.5766, 6406.
6398     5 .5850,.5934,.6014,.6093,.6170,.6244,.6317,.6388,.6458,.6525/ 6407.
6399     C 6408.
6400     DATA C05T07/0.0, 6409.
6401     1 .0742,.0948,.1120,.1277,.1427,.1572,.1716,.1861,.2007,.2153, 6410.
6402     2 .2300,.2447,.2594,.2740,.2885,.3028,.3171,.3310,.3448,.3584, 6411.
6403     3 .3717,.3849,.3977,.4103,.4227,.4347,.4465,.4581,.4693,.4804, 6412.
6404     4 .4912,.5017,.5120,.5220,.5318,.5413,.5506,.5597,.5686,.5772, 6413.
6405     5 .5856,.5939,.6019,.6097,.6173,.6247,.6320,.6390,.6459,.6526/ 6414.
6406     C 6415.
6407     DATA C05T08/0.0, 6416.
6408     1 .0885,.1090,.1263,.1418,.1565,.1705,.1844,.1982,.2121,.2260, 6417.
6409     2 .2400,.2540,.2680,.2819,.2958,.3096,.3233,.3368,.3502,.3633, 6418.
6410     3 .3763,.3890,.4015,.4138,.4259,.4377,.4493,.4606,.4717,.4825, 6419.
6411     4 .4931,.5035,.5136,.5235,.5331,.5425,.5517,.5607,.5695,.5780, 6420.
6412     5 .5864,.5945,.6024,.6102,.6177,.6251,.6323,.6393,.6461,.6528/ 6421.
6413     C 6422.
6414     DATA C05T09/0.0, 6423.
6415     1 .1017,.1223,.1395,.1550,.1695,.1833,.1968,.2101,.2234,.2367, 6424.
6416     2 .2501,.2634,.2768,.2902,.3035,.3167,.3299,.3429,.3558,.3686, 6425.
6417     3 .3811,.3935,.4057,.4176,.4295,.4409,.4523,.4634,.4742,.4849, 6426.
6418     4 .4952,.5054,.5154,.5251,.5346,.5439,.5530,.5618,.5705,.5789, 6427.
6419     5 .5871,.5952,.6031,.6107,.6182,.6255,.6326,.6396,.6464,.6530/ 6428.
6420     C 6429.
6421     DATA C05T10/0.0, 6430.
6422     1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6431.
6423     2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6432.
6424     3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6433.
6425     4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6434.
6426     5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6435.
6427     C 6436.
6428     DATA C06T00/0.0, 6437.
6429     1 .0250,.0525,.0792,.1056,.1316,.1572,.1823,.2070,.2311,.2547, 6438.
6430     2 .2776,.3000,.3217,.3427,.3631,.3827,.4019,.4201,.4378,.4550, 6439.
6431     3 .4713,.4872,.5024,.5170,.5312,.5446,.5576,.5701,.5820,.5936, 6440.
6432     4 .6047,.6153,.6257,.6354,.6450,.6541,.6628,.6713,.6794,.6873, 6441.
6433     5 .6948,.7021,.7091,.7159,.7224,.7287,.7348,.7407,.7462,.7516/ 6442.
6434     C 6443.
6435     DATA C06T01/0.0, 6444.
6436     1 .0000,.0339,.0652,.0941,.1216,.1480,.1737,.1987,.2229,.2466, 6445.
6437     2 .2694,.2918,.3134,.3344,.3548,.3744,.3935,.4118,.4295,.4467, 6446.
6438     3 .4632,.4792,.4945,.5092,.5236,.5372,.5504,.5631,.5753,.5871, 6447.
6439     4 .5984,.6093,.6198,.6299,.6396,.6490,.6580,.6667,.6751,.6832, 6448.
6440     5 .6909,.6984,.7056,.7126,.7194,.7259,.7322,.7382,.7441,.7498/ 6449.
6441     C 6450.
6442     DATA C06T02/0.0, 6451.
6443     1 .0000,.0307,.0608,.0893,.1168,.1433,.1690,.1941,.2183,.2420, 6452.
6444     2 .2648,.2871,.3087,.3296,.3500,.3696,.3887,.4070,.4247,.4420, 6453.
6445     3 .4584,.4745,.4898,.5047,.5191,.5328,.5461,.5590,.5713,.5832, 6454.
6446     4 .5947,.6057,.6164,.6266,.6365,.6460,.6552,.6641,.6726,.6808, 6455.
6447     5 .6887,.6964,.7038,.7110,.7178,.7245,.7309,.7371,.7431,.7489/ 6456.
6448     C 6457.
6449     DATA C06T03/0.0, 6458.
6450     1 .0130,.0424,.0692,.0953,.1210,.1462,.1709,.1952,.2188,.2420, 6459.
6451     2 .2645,.2865,.3078,.3285,.3486,.3680,.3870,.4051,.4228,.4399, 6460.
6452     3 .4563,.4723,.4877,.5025,.5169,.5306,.5440,.5569,.5692,.5812, 6461.
6453     4 .5927,.6038,.6146,.6248,.6348,.6444,.6537,.6626,.6712,.6796, 6462.
6454     5 .6876,.6954,.7028,.7101,.7170,.7238,.7303,.7366,.7427,.7486/ 6463.
6455     C 6464.
6456     DATA C06T04/0.0, 6465.
6457     1 .0314,.0594,.0842,.1080,.1315,.1549,.1781,.2012,.2238,.2461, 6466.
6458     2 .2678,.2892,.3099,.3302,.3499,.3690,.3876,.4055,.4230,.4399, 6467.
6459     3 .4561,.4720,.4872,.5019,.5163,.5299,.5432,.5561,.5684,.5804, 6468.
6460     4 .5918,.6029,.6137,.6240,.6340,.6436,.6529,.6619,.6705,.6790, 6469.
6461     5 .6870,.6948,.7023,.7096,.7167,.7235,.7300,.7364,.7425,.7485/ 6470.
6462     C 6471.
6463     DATA C06T05/0.0, 6472.
6464     1 .0503,.0777,.1014,.1237,.1456,.1673,.1889,.2105,.2319,.2531, 6473.
6465     2 .2739,.2944,.3145,.3341,.3533,.3718,.3901,.4076,.4247,.4413, 6474.
6466     3 .4573,.4730,.4880,.5025,.5167,.5302,.5434,.5562,.5684,.5803, 6475.
6467     4 .5917,.6028,.6135,.6238,.6338,.6434,.6527,.6617,.6703,.6787, 6476.
6468     5 .6868,.6946,.7021,.7095,.7165,.7233,.7299,.7363,.7425,.7485/ 6477.
6469     C 6478.
6470     DATA C06T06/0.0, 6479.
6471     1 .0686,.0956,.1188,.1403,.1611,.1814,.2017,.2220,.2421,.2622, 6480.
6472     2 .2820,.3016,.3208,.3397,.3582,.3762,.3939,.4110,.4276,.4439, 6481.
6473     3 .4596,.4749,.4897,.5040,.5180,.5313,.5443,.5569,.5690,.5808, 6482.
6474     4 .5921,.6031,.6138,.6240,.6339,.6435,.6527,.6617,.6703,.6787, 6483.
6475     5 .6868,.6946,.7021,.7094,.7165,.7233,.7300,.7364,.7425,.7485/ 6484.
6476     C 6485.
6477     DATA C06T07/0.0, 6486.
6478     1 .0859,.1128,.1357,.1567,.1767,.1961,.2154,.2345,.2535,.2725, 6487.
6479     2 .2913,.3099,.3283,.3464,.3642,.3816,.3987,.4153,.4315,.4473, 6488.
6480     3 .4626,.4776,.4920,.5061,.5198,.5329,.5457,.5582,.5701,.5818, 6489.
6481     4 .5930,.6038,.6144,.6245,.6344,.6439,.6530,.6620,.6705,.6789, 6490.
6482     5 .6869,.6947,.7022,.7095,.7166,.7234,.7300,.7364,.7426,.7486/ 6491.
6483     C 6492.
6484     DATA C06T08/0.0, 6493.
6485     1 .1022,.1290,.1517,.1723,.1919,.2107,.2291,.2473,.2654,.2834, 6494.
6486     2 .3013,.3191,.3366,.3539,.3710,.3877,.4042,.4202,.4360,.4513, 6495.
6487     3 .4662,.4808,.4950,.5087,.5221,.5350,.5476,.5598,.5715,.5830, 6496.
6488     4 .5941,.6048,.6152,.6252,.6350,.6444,.6535,.6624,.6709,.6792, 6497.
6489     5 .6872,.6949,.7024,.7097,.7167,.7235,.7301,.7365,.7427,.7486/ 6498.
6490     C 6499.
6491     DATA C06T09/0.0, 6500.
6492     1 .1173,.1440,.1666,.1871,.2063,.2246,.2425,.2600,.2773,.2945, 6501.
6493     2 .3116,.3285,.3453,.3619,.3783,.3943,.4102,.4257,.4409,.4558, 6502.
6494     3 .4703,.4845,.4982,.5116,.5248,.5374,.5497,.5617,.5732,.5845, 6503.
6495     4 .5954,.6060,.6163,.6262,.6358,.6451,.6541,.6629,.6713,.6796, 6504.
6496     5 .6875,.6952,.7026,.7099,.7168,.7236,.7302,.7365,.7427,.7487/ 6505.
6497     C 6506.
6498     DATA C06T10/0.0, 6507.
6499     1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6508.
6500     2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6509.
6501     3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6510.
6502     4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6511.
6503     5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6512.
6504     C 6513.
6505     DATA C07T00/0.0, 6514.
6506     1 .0360,.0751,.1129,.1498,.1858,.2209,.2546,.2873,.3183,.3484, 6515.
6507     2 .3767,.4040,.4296,.4540,.4773,.4990,.5199,.5392,.5577,.5753, 6516.
6508     3 .5916,.6073,.6220,.6358,.6492,.6615,.6733,.6845,.6950,.7051, 6517.
6509     4 .7147,.7237,.7324,.7406,.7484,.7559,.7630,.7698,.7762,.7824, 6518.
6510     5 .7883,.7940,.7994,.8046,.8096,.8144,.8190,.8234,.8276,.8317/ 6519.
6511     C 6520.
6512     DATA C07T01/0.0, 6521.
6513     1 .0000,.0500,.0929,.1323,.1696,.2052,.2391,.2719,.3029,.3329, 6522.
6514     2 .3612,.3886,.4144,.4390,.4625,.4845,.5058,.5256,.5445,.5626, 6523.
6515     3 .5795,.5957,.6109,.6253,.6392,.6521,.6644,.6762,.6872,.6979, 6524.
6516     4 .7079,.7174,.7266,.7351,.7434,.7513,.7587,.7659,.7727,.7793, 6525.
6517     5 .7855,.7915,.7971,.8026,.8079,.8129,.8177,.8223,.8268,.8310/ 6526.
6518     C 6527.
6519     DATA C07T02/0.0, 6528.
6520     1 .0000,.0433,.0845,.1233,.1604,.1958,.2296,.2623,.2932,.3232, 6529.
6521     2 .3515,.3788,.4047,.4294,.4530,.4753,.4967,.5168,.5360,.5544, 6530.
6522     3 .5715,.5881,.6037,.6184,.6327,.6459,.6586,.6707,.6821,.6931, 6531.
6523     4 .7034,.7133,.7228,.7316,.7402,.7484,.7561,.7636,.7706,.7774, 6532.
6524     5 .7839,.7901,.7960,.8017,.8071,.8123,.8173,.8221,.8267,.8311/ 6533.
6525     C 6534.
6526     DATA C07T03/0.0, 6535.
6527     1 .0139,.0544,.0915,.1272,.1620,.1958,.2284,.2601,.2903,.3197, 6536.
6528     2 .3475,.3745,.4001,.4246,.4481,.4703,.4918,.5119,.5311,.5496, 6537.
6529     3 .5669,.5836,.5993,.6142,.6287,.6420,.6550,.6673,.6789,.6901, 6538.
6530     4 .7006,.7107,.7204,.7294,.7382,.7465,.7545,.7621,.7693,.7763, 6539.
6531     5 .7829,.7893,.7953,.8012,.8067,.8121,.8172,.8221,.8269,.8314/ 6540.
6532     C 6541.
6533     DATA C07T04/0.0, 6542.
6534     1 .0339,.0723,.1065,.1393,.1714,.2028,.2336,.2637,.2927,.3210, 6543.
6535     2 .3480,.3743,.3993,.4234,.4465,.4684,.4897,.5096,.5288,.5471, 6544.
6536     3 .5644,.5811,.5968,.6118,.6263,.6398,.6528,.6652,.6769,.6882, 6545.
6537     4 .6988,.7090,.7188,.7280,.7369,.7454,.7534,.7612,.7685,.7756, 6546.
6538     5 .7823,.7888,.7950,.8009,.8066,.8120,.8173,.8223,.8271,.8317/ 6547.
6539     C 6548.
6540     DATA C07T05/0.0, 6549.
6541     1 .0546,.0920,.1246,.1553,.1852,.2144,.2432,.2715,.2990,.3260, 6550.
6542     2 .3519,.3772,.4015,.4249,.4474,.4689,.4897,.5093,.5283,.5464, 6551.
6543     3 .5635,.5801,.5957,.6106,.6251,.6386,.6516,.6640,.6757,.6871, 6552.
6544     4 .6978,.7080,.7179,.7272,.7361,.7447,.7528,.7606,.7680,.7752, 6553.
6545     5 .7820,.7886,.7948,.8008,.8065,.8121,.8174,.8224,.8273,.8320/ 6554.
6546     C 6555.
6547     DATA C07T06/0.0, 6556.
6548     1 .0749,.1117,.1434,.1728,.2010,.2284,.2554,.2820,.3079,.3335, 6557.
6549     2 .3582,.3825,.4058,.4284,.4502,.4711,.4914,.5106,.5292,.5470, 6558.
6550     3 .5639,.5802,.5957,.6105,.6248,.6382,.6511,.6635,.6752,.6865, 6559.
6551     4 .6972,.7075,.7174,.7267,.7357,.7442,.7524,.7603,.7677,.7750, 6560.
6552     5 .7818,.7884,.7947,.8008,.8065,.8121,.8174,.8226,.8275,.8322/ 6561.
6553     C 6562.
6554     DATA C07T07/0.0, 6563.
6555     1 .0943,.1306,.1617,.1902,.2173,.2434,.2689,.2940,.3185,.3427, 6564.
6556     2 .3662,.3893,.4117,.4334,.4545,.4747,.4944,.5131,.5312,.5486, 6565.
6557     3 .5651,.5812,.5964,.6110,.6252,.6384,.6512,.6635,.6752,.6864, 6566.
6558     4 .6971,.7073,.7172,.7265,.7355,.7440,.7522,.7601,.7676,.7748, 6567.
6559     5 .7817,.7883,.7946,.8007,.8065,.8121,.8175,.8227,.8276,.8324/ 6568.
6560     C 6569.
6561     DATA C07T08/0.0, 6570.
6562     1 .1125,.1486,.1793,.2071,.2334,.2585,.2828,.3066,.3299,.3529, 6571.
6563     2 .3753,.3973,.4186,.4395,.4597,.4792,.4982,.5164,.5340,.5510, 6572.
6564     3 .5672,.5829,.5978,.6122,.6261,.6392,.6518,.6640,.6755,.6867, 6573.
6565     4 .6973,.7074,.7172,.7265,.7354,.7440,.7522,.7600,.7675,.7748, 6574.
6566     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8277,.8325/ 6575.
6567     C 6576.
6568     DATA C07T09/0.0, 6577.
6569     1 .1296,.1655,.1958,.2232,.2489,.2732,.2966,.3194,.3416,.3635, 6578.
6570     2 .3848,.4058,.4262,.4462,.4656,.4844,.5028,.5203,.5374,.5539, 6579.
6571     3 .5697,.5850,.5997,.6137,.6274,.6403,.6527,.6647,.6761,.6872, 6580.
6572     4 .6977,.7077,.7175,.7267,.7356,.7441,.7522,.7601,.7675,.7748, 6581.
6573     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6582.
6574     C 6583.
6575     DATA C07T10/0.0, 6584.
6576     1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 6585.
6577     2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 6586.
6578     3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 6587.
6579     4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 6588.
6580     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6589.
6581     C 6590.
6582     DATA C08T00/0.0, 6591.
6583     1 .0568,.1172,.1747,.2295,.2813,.3300,.3748,.4169,.4547,.4903, 6592.
6584     2 .5220,.5517,.5784,.6030,.6257,.6460,.6652,.6825,.6985,.7134, 6593.
6585     3 .7269,.7396,.7513,.7621,.7723,.7816,.7904,.7987,.8064,.8137, 6594.
6586     4 .8204,.8268,.8329,.8385,.8439,.8490,.8538,.8584,.8627,.8668, 6595.
6587     5 .8707,.8744,.8780,.8814,.8846,.8877,.8906,.8934,.8961,.8987/ 6596.
6588     C 6597.
6589     DATA C08T01/0.0, 6598.
6590     1 .0045,.0786,.1413,.1980,.2505,.2994,.3445,.3870,.4255,.4620, 6599.
6591     2 .4948,.5257,.5538,.5798,.6039,.6258,.6464,.6650,.6823,.6985, 6600.
6592     3 .7132,.7270,.7398,.7516,.7629,.7730,.7826,.7917,.8000,.8080, 6601.
6593     4 .8153,.8223,.8289,.8350,.8408,.8463,.8514,.8564,.8610,.8654, 6602.
6594     5 .8696,.8736,.8773,.8809,.8843,.8876,.8907,.8937,.8965,.8992/ 6603.
6595     C 6604.
6596     DATA C08T02/0.0, 6605.
6597     1 .0000,.0639,.1239,.1794,.2314,.2799,.3249,.3675,.4063,.4431, 6606.
6598     2 .4766,.5081,.5370,.5637,.5888,.6115,.6330,.6525,.6707,.6878, 6607.
6599     3 .7032,.7179,.7314,.7440,.7559,.7667,.7769,.7865,.7954,.8038, 6608.
6600     4 .8117,.8190,.8260,.8325,.8387,.8445,.8499,.8551,.8600,.8647, 6609.
6601     5 .8690,.8733,.8772,.8810,.8845,.8880,.8912,.8943,.8973,.9001/ 6610.
6602     C 6611.
6603     DATA C08T03/0.0, 6612.
6604     1 .0129,.0725,.1266,.1778,.2266,.2730,.3165,.3580,.3962,.4326, 6613.
6605     2 .4659,.4975,.5265,.5536,.5790,.6021,.6241,.6441,.6628,.6804, 6614.
6606     3 .6964,.7116,.7256,.7386,.7510,.7622,.7728,.7828,.7921,.8009, 6615.
6607     4 .8090,.8167,.8240,.8307,.8372,.8432,.8489,.8543,.8594,.8642, 6616.
6608     5 .8688,.8731,.8772,.8811,.8848,.8884,.8917,.8949,.8980,.9009/ 6617.
6609     C 6618.
6610     DATA C08T04/0.0, 6619.
6611     1 .0338,.0901,.1399,.1870,.2320,.2754,.3165,.3561,.3930,.4283, 6620.
6612     2 .4609,.4920,.5207,.5477,.5730,.5962,.6184,.6385,.6575,.6753, 6621.
6613     3 .6916,.7071,.7214,.7347,.7474,.7589,.7698,.7801,.7896,.7987, 6622.
6614     4 .8071,.8150,.8225,.8294,.8361,.8423,.8481,.8537,.8589,.8639, 6623.
6615     5 .8686,.8731,.8773,.8813,.8851,.8887,.8922,.8955,.8986,.9016/ 6624.
6616     C 6625.
6617     DATA C08T05/0.0, 6626.
6618     1 .0561,.1105,.1578,.2017,.2435,.2838,.3224,.3597,.3948,.4287, 6627.
6619     2 .4602,.4904,.5185,.5450,.5699,.5930,.6150,.6351,.6541,.6720, 6628.
6620     3 .6884,.7040,.7185,.7319,.7448,.7565,.7676,.7781,.7877,.7970, 6629.
6621     4 .8056,.8136,.8213,.8284,.8352,.8416,.8476,.8533,.8586,.8637, 6630.
6622     5 .8685,.8731,.8774,.8815,.8854,.8891,.8926,.8960,.8991,.9022/ 6631.
6623     C 6632.
6624     DATA C08T06/0.0, 6633.
6625     1 .0782,.1314,.1770,.2187,.2581,.2958,.3319,.3670,.4002,.4324, 6634.
6626     2 .4626,.4917,.5189,.5447,.5691,.5918,.6134,.6334,.6522,.6700, 6635.
6627     3 .6864,.7020,.7165,.7300,.7430,.7548,.7660,.7766,.7864,.7957, 6636.
6628     4 .8044,.8126,.8204,.8276,.8345,.8410,.8471,.8529,.8583,.8635, 6637.
6629     5 .8684,.8731,.8774,.8816,.8856,.8893,.8929,.8963,.8996,.9027/ 6638.
6630     C 6639.
6631     DATA C08T07/0.0, 6640.
6632     1 .0994,.1518,.1962,.2363,.2739,.3095,.3436,.3765,.4080,.4385, 6641.
6633     2 .4673,.4951,.5213,.5463,.5700,.5921,.6134,.6329,.6515,.6691, 6642.
6634     3 .6854,.7009,.7154,.7289,.7418,.7536,.7649,.7755,.7854,.7948, 6643.
6635     4 .8036,.8118,.8197,.8270,.8340,.8405,.8467,.8526,.8581,.8634, 6644.
6636     5 .8683,.8731,.8775,.8817,.8857,.8896,.8932,.8967,.8999,.9031/ 6645.
6637     C 6646.
6638     DATA C08T08/0.0, 6647.
6639     1 .1197,.1714,.2148,.2538,.2899,.3238,.3562,.3874,.4172,.4461, 6648.
6640     2 .4735,.5001,.5253,.5493,.5722,.5937,.6144,.6335,.6518,.6691, 6649.
6641     3 .6852,.7005,.7148,.7283,.7412,.7529,.7642,.7748,.7847,.7942, 6650.
6642     4 .8030,.8113,.8192,.8265,.8336,.8402,.8464,.8524,.8579,.8632, 6651.
6643     5 .8682,.8730,.8775,.8818,.8858,.8897,.8934,.8969,.9002,.9034/ 6652.
6644     C 6653.
6645     DATA C08T09/0.0, 6654.
6646     1 .1387,.1899,.2326,.2705,.3055,.3382,.3691,.3988,.4271,.4546, 6655.
6647     2 .4808,.5061,.5302,.5533,.5754,.5962,.6163,.6350,.6528,.6698, 6656.
6648     3 .6855,.7007,.7148,.7281,.7409,.7526,.7638,.7744,.7843,.7937, 6657.
6649     4 .8025,.8109,.8188,.8262,.8333,.8399,.8462,.8521,.8577,.8631, 6658.
6650     5 .8681,.8730,.8775,.8818,.8859,.8898,.8935,.8971,.9004,.9036/ 6659.
6651     C 6660.
6652     DATA C08T10/0.0, 6661.
6653     1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 6662.
6654     2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 6663.
6655     3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 6664.
6656     4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 6665.
6657     5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 6666.
6658     C 6667.
6659     DATA C09T00/0.0, 6668.
6660     1 .1151,.2302,.3312,.4172,.4903,.5514,.6016,.6447,.6796,.7102, 6669.
6661     2 .7355,.7578,.7769,.7935,.8085,.8212,.8330,.8432,.8524,.8609, 6670.
6662     3 .8683,.8752,.8815,.8872,.8926,.8974,.9019,.9061,.9100,.9136, 6671.
6663     4 .9170,.9201,.9231,.9258,.9284,.9309,.9332,.9354,.9374,.9394, 6672.
6664     5 .9412,.9430,.9446,.9462,.9477,.9492,.9506,.9519,.9531,.9543/ 6673.
6665     C 6674.
6666     DATA C09T01/0.0, 6675.
6667     1 .0245,.1526,.2576,.3468,.4239,.4902,.5461,.5952,.6357,.6717, 6676.
6668     2 .7017,.7283,.7513,.7712,.7891,.8043,.8183,.8304,.8413,.8512, 6677.
6669     3 .8599,.8680,.8753,.8818,.8880,.8934,.8985,.9032,.9075,.9116, 6678.
6670     4 .9153,.9187,.9220,.9250,.9278,.9305,.9329,.9353,.9375,.9396, 6679.
6671     5 .9415,.9434,.9451,.9468,.9484,.9499,.9513,.9527,.9540,.9552/ 6680.
6672     C 6681.
6673     DATA C09T02/0.0, 6682.
6674     1 .0057,.1184,.2173,.3044,.3816,.4494,.5078,.5598,.6035,.6428, 6683.
6675     2 .6758,.7053,.7309,.7532,.7733,.7904,.8062,.8197,.8320,.8432, 6684.
6676     3 .8529,.8619,.8700,.8772,.8841,.8901,.8956,.9008,.9055,.9099, 6685.
6677     4 .9139,.9177,.9212,.9244,.9274,.9302,.9329,.9354,.9377,.9399, 6686.
6678     5 .9419,.9439,.9457,.9475,.9491,.9507,.9521,.9535,.9549,.9561/ 6687.
6679     C 6688.
6680     DATA C09T03/0.0, 6689.
6681     1 .0177,.1190,.2077,.2880,.3610,.4269,.4847,.5372,.5820,.6227, 6690.
6682     2 .6574,.6886,.7157,.7396,.7612,.7796,.7967,.8113,.8246,.8367, 6691.
6683     3 .8472,.8570,.8657,.8735,.8809,.8873,.8933,.8989,.9039,.9086, 6692.
6684     4 .9129,.9168,.9205,.9239,.9271,.9301,.9329,.9355,.9379,.9402, 6693.
6685     5 .9423,.9444,.9462,.9481,.9497,.9514,.9529,.9543,.9557,.9570/ 6694.
6686     C 6695.
6687     DATA C09T04/0.0, 6696.
6688     1 .0383,.1335,.2145,.2879,.3553,.4173,.4729,.5241,.5685,.6094, 6697.
6689     2 .6446,.6766,.7046,.7294,.7519,.7713,.7891,.8046,.8186,.8314, 6698.
6690     3 .8425,.8529,.8621,.8704,.8782,.8850,.8913,.8972,.9025,.9074, 6699.
6691     4 .9119,.9161,.9200,.9235,.9269,.9300,.9328,.9356,.9381,.9405, 6700.
6692     5 .9427,.9448,.9467,.9486,.9503,.9520,.9535,.9550,.9564,.9577/ 6701.
6693     C 6702.
6694     DATA C09T05/0.0, 6703.
6695     1 .0614,.1528,.2288,.2967,.3590,.4167,.4692,.5181,.5613,.6013, 6704.
6696     2 .6363,.6684,.6966,.7219,.7449,.7648,.7832,.7993,.8138,.8271, 6705.
6697     3 .8387,.8495,.8591,.8678,.8759,.8830,.8896,.8958,.9013,.9064, 6706.
6698     4 .9111,.9154,.9195,.9232,.9266,.9298,.9328,.9356,.9382,.9407, 6707.
6699     5 .9429,.9451,.9471,.9490,.9508,.9525,.9541,.9556,.9570,.9583/ 6708.
6700     C 6709.
6701     DATA C09T06/0.0, 6710.
6702     1 .0849,.1736,.2461,.3098,.3680,.4217,.4710,.5172,.5586,.5974, 6711.
6703     2 .6316,.6632,.6913,.7166,.7398,.7599,.7787,.7951,.8100,.8236, 6712.
6704     3 .8355,.8467,.8566,.8656,.8740,.8813,.8882,.8945,.9002,.9055, 6713.
6705     4 .9104,.9148,.9190,.9228,.9264,.9297,.9328,.9356,.9383,.9408, 6714.
6706     5 .9431,.9454,.9474,.9494,.9512,.9529,.9545,.9561,.9575,.9589/ 6715.
6707     C 6716.
6708     DATA C09T07/0.0, 6717.
6709     1 .1078,.1944,.2643,.3249,.3797,.4300,.4764,.5199,.5594,.5965, 6718.
6710     2 .6296,.6605,.6881,.7132,.7362,.7565,.7753,.7918,.8069,.8208, 6719.
6711     3 .8330,.8443,.8545,.8637,.8723,.8799,.8869,.8934,.8992,.9047, 6720.
6712     4 .9097,.9143,.9186,.9225,.9262,.9295,.9327,.9356,.9384,.9409, 6721.
6713     5 .9433,.9456,.9477,.9497,.9515,.9533,.9549,.9565,.9579,.9593/ 6722.
6714     C 6723.
6715     DATA C09T08/0.0, 6724.
6716     1 .1297,.2146,.2824,.3405,.3927,.4402,.4839,.5250,.5625,.5979, 6725.
6717     2 .6298,.6597,.6866,.7113,.7340,.7541,.7729,.7895,.8046,.8186, 6726.
6718     3 .8309,.8424,.8528,.8621,.8709,.8786,.8858,.8924,.8984,.9040, 6727.
6719     4 .9091,.9138,.9182,.9222,.9259,.9294,.9326,.9356,.9384,.9410, 6728.
6720     5 .9434,.9457,.9479,.9499,.9518,.9536,.9552,.9568,.9583,.9597/ 6729.
6721     C 6730.
6722     DATA C09T09/0.0, 6731.
6723     1 .1505,.2340,.2999,.3561,.4060,.4512,.4927,.5315,.5672,.6009, 6732.
6724     2 .6315,.6603,.6865,.7105,.7328,.7526,.7713,.7878,.8029,.8169, 6733.
6725     3 .8293,.8409,.8513,.8608,.8697,.8775,.8848,.8916,.8976,.9033, 6734.
6726     4 .9085,.9133,.9178,.9219,.9257,.9292,.9325,.9356,.9384,.9411, 6735.
6727     5 .9435,.9459,.9480,.9501,.9520,.9538,.9555,.9571,.9586,.9600/ 6736.
6728     C 6737.
6729     DATA C09T10/0.0, 6738.
6730     1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 6739.
6731     2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 6740.
6732     3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 6741.
6733     4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 6742.
6734     5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 6743.
6735     C 6744.
6736     C 6745.
6737     IF(TAU.GT.1.0) THEN 6746.
6738     CALL HGCLD1(XMU,TAU,G,GG) 6747.
6739     GO TO 130 6748.
6740     ENDIF 6749.
6741     C 6750.
6742     C ---------------------------------------------------------------- 6751.
6743     C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 6752.
6744     C FOR AEROSOL ALBEDOS FOR OPTICAL THICKNESSES OF (0.0 < TAU < 1.0) 6753.
6745     C ---------------------------------------------------------------- 6754.
6746     C 6755.
6747     C 6756.
6748     C ------------------------------------------- 6757.
6749     C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 6758.
6750     C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 6759.
6751     C ------------------------------------------- 6760.
6752     C 6761.
6753     XI=XMU*50.0+0.9999 6762.
6754     IX=XI 6763.
6755     IF(IX.LT.1) IX=1 6764.
6756     JX=IX+1 6765.
6757     WXJ=XI-IX 6766.
6758     WXI=1.0-WXJ 6767.
6759     C 6768.
6760     C ------------------------- 6769.
6761     C AEROSOL TAU INTERPOLATION 6770.
6762     C 0.10 ON (0.0 < XMU < 1.0) 6771.
6763     C ------------------------- 6772.
6764     C 6773.
6765     TI=TAU*10.0+0.9999 6774.
6766     IT=TI 6775.
6767     IF(IT.LT.1) IT=1 6776.
6768     IF(IT.GT.11) IT=11 6777.
6769     JT=IT+1 6778.
6770     IF(JT.GT.11) JT=11 6779.
6771     WTJ=TI-IT 6780.
6772     WTI=1.0-WTJ 6781.
6773     C 6782.
6774     C ------------------------------- 6783.
6775     C COSBAR DEPENDENCE INTERPOLATION 6784.
6776     C 0.10 ON (0.5 < COSBAR < 0.9) 6785.
6777     C LINEAR FOR (0.0 < COSBAR < 0.5) 6786.
6778     C ------------------------------- 6787.
6779     C 6788.
6780     GI=G*10.0 6789.
6781     IF(GI.GT.5.0) GO TO 110 6790.
6782     JG=1 6791.
6783     GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6792.
6784     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6793.
6785     GG=GG+GG 6794.
6786     GO TO 130 6795.
6787     C 6796.
6788     110 IG=GI 6797.
6789     WGJ=GI-IG 6798.
6790     WGI=1.0-WGJ 6799.
6791     IG=IG-4 6800.
6792     JG=IG+1 6801.
6793     IF(IG.GT.4) GO TO 120 6802.
6794     C 6803.
6795     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6804.
6796     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6805.
6797     + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6806.
6798     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6807.
6799     GO TO 130 6808.
6800     C 6809.
6801     120 IG=5 6810.
6802     C 6811.
6803     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6812.
6804     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6813.
6805     + +WGJ 6814.
6806     C 6815.
6807     130 CONTINUE 6816.
6808     C 6817.
6809     RETURN 6818.
6810     END 6819.
6811     SUBROUTINE HGCLD1(XMU,TAU,G,GG) 6820.
6812     C 6821.
6813     DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6822.
6814     DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6823.
6815     DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6824.
6816     DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6825.
6817     DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6826.
6818     DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6827.
6819     DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6828.
6820     DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6829.
6821     DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6830.
6822     DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6831.
6823     DIMENSION C05T99(51),C06T99(51),C07T99(51),C08T99(51),C09T99(51) 6832.
6824     C 6833.
6825     DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6834.
6826     DIMENSION C09TAU(51,11) 6835.
6827     C 6836.
6828     DIMENSION GTAU(51,11,5) 6837.
6829     C 6838.
6830     EQUIVALENCE (C05TAU(1, 1),C05T01(1)),(C05TAU(1, 2),C05T02(1)) 6839.
6831     EQUIVALENCE (C05TAU(1, 3),C05T03(1)),(C05TAU(1, 4),C05T04(1)) 6840.
6832     EQUIVALENCE (C05TAU(1, 5),C05T05(1)),(C05TAU(1, 6),C05T06(1)) 6841.
6833     EQUIVALENCE (C05TAU(1, 7),C05T07(1)),(C05TAU(1, 8),C05T08(1)) 6842.
6834     EQUIVALENCE (C05TAU(1, 9),C05T09(1)),(C05TAU(1,10),C05T10(1)) 6843.
6835     EQUIVALENCE (C05TAU(1,11),C05T99(1)) 6844.
6836     C 6845.
6837     EQUIVALENCE (C06TAU(1, 1),C06T01(1)),(C06TAU(1, 2),C06T02(1)) 6846.
6838     EQUIVALENCE (C06TAU(1, 3),C06T03(1)),(C06TAU(1, 4),C06T04(1)) 6847.
6839     EQUIVALENCE (C06TAU(1, 5),C06T05(1)),(C06TAU(1, 6),C06T06(1)) 6848.
6840     EQUIVALENCE (C06TAU(1, 7),C06T07(1)),(C06TAU(1, 8),C06T08(1)) 6849.
6841     EQUIVALENCE (C06TAU(1, 9),C06T09(1)),(C06TAU(1,10),C06T10(1)) 6850.
6842     EQUIVALENCE (C06TAU(1,11),C06T99(1)) 6851.
6843     C 6852.
6844     EQUIVALENCE (C07TAU(1, 1),C07T01(1)),(C07TAU(1, 2),C07T02(1)) 6853.
6845     EQUIVALENCE (C07TAU(1, 3),C07T03(1)),(C07TAU(1, 4),C07T04(1)) 6854.
6846     EQUIVALENCE (C07TAU(1, 5),C07T05(1)),(C07TAU(1, 6),C07T06(1)) 6855.
6847     EQUIVALENCE (C07TAU(1, 7),C07T07(1)),(C07TAU(1, 8),C07T08(1)) 6856.
6848     EQUIVALENCE (C07TAU(1, 9),C07T09(1)),(C07TAU(1,10),C07T10(1)) 6857.
6849     EQUIVALENCE (C07TAU(1,11),C07T99(1)) 6858.
6850     C 6859.
6851     EQUIVALENCE (C08TAU(1, 1),C08T01(1)),(C08TAU(1, 2),C08T02(1)) 6860.
6852     EQUIVALENCE (C08TAU(1, 3),C08T03(1)),(C08TAU(1, 4),C08T04(1)) 6861.
6853     EQUIVALENCE (C08TAU(1, 5),C08T05(1)),(C08TAU(1, 6),C08T06(1)) 6862.
6854     EQUIVALENCE (C08TAU(1, 7),C08T07(1)),(C08TAU(1, 8),C08T08(1)) 6863.
6855     EQUIVALENCE (C08TAU(1, 9),C08T09(1)),(C08TAU(1,10),C08T10(1)) 6864.
6856     EQUIVALENCE (C08TAU(1,11),C08T99(1)) 6865.
6857     C 6866.
6858     EQUIVALENCE (C09TAU(1, 1),C09T01(1)),(C09TAU(1, 2),C09T02(1)) 6867.
6859     EQUIVALENCE (C09TAU(1, 3),C09T03(1)),(C09TAU(1, 4),C09T04(1)) 6868.
6860     EQUIVALENCE (C09TAU(1, 5),C09T05(1)),(C09TAU(1, 6),C09T06(1)) 6869.
6861     EQUIVALENCE (C09TAU(1, 7),C09T07(1)),(C09TAU(1, 8),C09T08(1)) 6870.
6862     EQUIVALENCE (C09TAU(1, 9),C09T09(1)),(C09TAU(1,10),C09T10(1)) 6871.
6863     EQUIVALENCE (C09TAU(1,11),C09T99(1)) 6872.
6864     C 6873.
6865     EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6874.
6866     EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6875.
6867     EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6876.
6868     C 6877.
6869     C 6878.
6870     DATA C05T01/0.0, 6879.
6871     1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6880.
6872     2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6881.
6873     3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6882.
6874     4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6883.
6875     5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6884.
6876     C 6885.
6877     DATA C05T02/0.0, 6886.
6878     1 .1981,.2188,.2361,.2514,.2656,.2788,.2912,.3031,.3145,.3255, 6887.
6879     2 .3362,.3466,.3569,.3669,.3768,.3865,.3962,.4057,.4151,.4244, 6888.
6880     3 .4337,.4428,.4519,.4609,.4698,.4785,.4872,.4958,.5043,.5127, 6889.
6881     4 .5209,.5290,.5371,.5450,.5528,.5604,.5679,.5753,.5826,.5898, 6890.
6882     5 .5968,.6037,.6105,.6171,.6237,.6301,.6364,.6425,.6486,.6545/ 6891.
6883     C 6892.
6884     DATA C05T03/0.0, 6893.
6885     1 .2435,.2639,.2809,.2960,.3099,.3227,.3348,.3463,.3571,.3676, 6894.
6886     2 .3777,.3874,.3969,.4060,.4150,.4237,.4323,.4407,.4489,.4570, 6895.
6887     3 .4650,.4728,.4806,.4882,.4957,.5031,.5104,.5177,.5248,.5319, 6896.
6888     4 .5388,.5457,.5525,.5592,.5659,.5724,.5788,.5852,.5915,.5977, 6897.
6889     5 .6038,.6098,.6157,.6215,.6273,.6330,.6385,.6440,.6494,.6547/ 6898.
6890     C 6899.
6891     DATA C05T04/0.0, 6900.
6892     1 .2714,.2914,.3081,.3229,.3365,.3491,.3608,.3719,.3824,.3925, 6901.
6893     2 .4022,.4115,.4205,.4292,.4377,.4459,.4540,.4618,.4694,.4769, 6902.
6894     3 .4842,.4914,.4985,.5054,.5122,.5189,.5255,.5320,.5384,.5447, 6903.
6895     4 .5509,.5570,.5631,.5690,.5749,.5807,.5865,.5921,.5977,.6033, 6904.
6896     5 .6087,.6141,.6194,.6246,.6298,.6349,.6399,.6448,.6497,.6545/ 6905.
6897     C 6906.
6898     DATA C05T05/0.0, 6907.
6899     1 .2900,.3097,.3262,.3408,.3541,.3664,.3778,.3887,.3989,.4088, 6908.
6900     2 .4181,.4272,.4358,.4442,.4524,.4602,.4680,.4754,.4827,.4898, 6909.
6901     3 .4967,.5035,.5101,.5166,.5230,.5293,.5354,.5415,.5474,.5533, 6910.
6902     4 .5590,.5647,.5703,.5757,.5812,.5865,.5918,.5970,.6021,.6071, 6911.
6903     5 .6121,.6171,.6219,.6267,.6315,.6361,.6407,.6453,.6498,.6542/ 6912.
6904     C 6913.
6905     DATA C05T06/0.0, 6914.
6906     1 .3033,.3228,.3390,.3534,.3665,.3786,.3898,.4005,.4105,.4201, 6915.
6907     2 .4292,.4380,.4465,.4546,.4625,.4701,.4776,.4848,.4918,.4986, 6916.
6908     3 .5053,.5118,.5182,.5244,.5305,.5364,.5423,.5480,.5537,.5592, 6917.
6909     4 .5646,.5700,.5753,.5804,.5855,.5905,.5955,.6004,.6052,.6099, 6918.
6910     5 .6146,.6192,.6237,.6282,.6326,.6370,.6413,.6456,.6498,.6539/ 6919.
6911     C 6920.
6912     DATA C05T07/0.0, 6921.
6913     1 .3133,.3325,.3485,.3627,.3757,.3876,.3987,.4092,.4190,.4284, 6922.
6914     2 .4374,.4460,.4543,.4622,.4700,.4774,.4846,.4916,.4984,.5051, 6923.
6915     3 .5115,.5178,.5240,.5300,.5359,.5416,.5472,.5528,.5582,.5635, 6924.
6916     4 .5687,.5738,.5789,.5838,.5887,.5935,.5982,.6029,.6074,.6119, 6925.
6917     5 .6164,.6208,.6251,.6293,.6335,.6377,.6418,.6458,.6498,.6537/ 6926.
6918     C 6927.
6919     DATA C05T08/0.0, 6928.
6920     1 .3210,.3400,.3559,.3699,.3827,.3945,.4054,.4158,.4255,.4348, 6929.
6921     2 .4436,.4521,.4602,.4680,.4756,.4829,.4900,.4968,.5034,.5099, 6930.
6922     3 .5162,.5224,.5284,.5342,.5400,.5455,.5510,.5564,.5616,.5667, 6931.
6923     4 .5718,.5767,.5816,.5864,.5911,.5957,.6003,.6047,.6091,.6135, 6932.
6924     5 .6177,.6219,.6261,.6302,.6342,.6381,.6421,.6459,.6497,.6535/ 6933.
6925     C 6934.
6926     DATA C05T09/0.0, 6935.
6927     1 .3271,.3460,.3618,.3757,.3883,.4000,.4108,.4211,.4306,.4398, 6936.
6928     2 .4485,.4569,.4649,.4726,.4800,.4872,.4941,.5008,.5074,.5137, 6937.
6929     3 .5199,.5259,.5318,.5375,.5431,.5486,.5539,.5591,.5642,.5693, 6938.
6930     4 .5742,.5790,.5837,.5884,.5930,.5974,.6018,.6062,.6104,.6146, 6939.
6931     5 .6188,.6228,.6268,.6308,.6347,.6385,.6423,.6460,.6497,.6533/ 6940.
6932     C 6941.
6933     DATA C05T10/0.0, 6942.
6934     1 .3321,.3509,.3665,.3803,.3929,.4045,.4152,.4253,.4348,.4439, 6943.
6935     2 .4525,.4607,.4686,.4762,.4836,.4906,.4975,.5041,.5105,.5168, 6944.
6936     3 .5229,.5288,.5345,.5401,.5457,.5510,.5562,.5614,.5664,.5713, 6945.
6937     4 .5761,.5808,.5854,.5900,.5944,.5988,.6031,.6073,.6115,.6156, 6946.
6938     5 .6196,.6236,.6275,.6313,.6351,.6388,.6425,.6461,.6497,.6532/ 6947.
6939     C 6948.
6940     DATA C05T99/0.0, 6949.
6941     1 .3759,.3933,.4078,.4204,.4320,.4425,.4522,.4614,.4699,.4781, 6950.
6942     2 .4857,.4930,.5000,.5067,.5131,.5192,.5252,.5309,.5364,.5417, 6951.
6943     3 .5469,.5519,.5568,.5615,.5661,.5705,.5749,.5791,.5832,.5873, 6952.
6944     4 .5912,.5950,.5988,.6024,.6060,.6095,.6130,.6164,.6196,.6229, 6953.
6945     5 .6260,.6292,.6322,.6352,.6381,.6410,.6439,.6467,.6494,.6521/ 6954.
6946     C 6955.
6947     DATA C06T01/0.0, 6956.
6948     1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6957.
6949     2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6958.
6950     3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6959.
6951     4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6960.
6952     5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6961.
6953     C 6962.
6954     DATA C06T02/0.0, 6963.
6955     1 .2301,.2561,.2779,.2973,.3151,.3317,.3472,.3620,.3761,.3897, 6964.
6956     2 .4028,.4155,.4279,.4399,.4518,.4633,.4747,.4858,.4968,.5076, 6965.
6957     3 .5182,.5287,.5389,.5490,.5589,.5686,.5781,.5875,.5967,.6057, 6966.
6958     4 .6144,.6230,.6315,.6397,.6478,.6556,.6633,.6708,.6781,.6853, 6967.
6959     5 .6922,.6991,.7057,.7121,.7184,.7246,.7306,.7364,.7421,.7476/ 6968.
6960     C 6969.
6961     DATA C06T03/0.0, 6970.
6962     1 .2848,.3100,.3311,.3497,.3668,.3825,.3971,.4110,.4240,.4365, 6971.
6963     2 .4484,.4599,.4710,.4816,.4921,.5021,.5119,.5214,.5308,.5399, 6972.
6964     3 .5488,.5575,.5661,.5745,.5828,.5908,.5988,.6066,.6142,.6217, 6973.
6965     4 .6291,.6364,.6435,.6505,.6574,.6641,.6707,.6772,.6835,.6898, 6974.
6966     5 .6959,.7019,.7077,.7135,.7191,.7246,.7300,.7353,.7404,.7455/ 6975.
6967     C 6976.
6968     DATA C06T04/0.0, 6977.
6969     1 .3189,.3434,.3639,.3819,.3983,.4134,.4273,.4406,.4529,.4647, 6978.
6970     2 .4759,.4867,.4970,.5069,.5165,.5258,.5348,.5435,.5519,.5602, 6979.
6971     3 .5682,.5761,.5837,.5912,.5985,.6057,.6127,.6196,.6263,.6330, 6980.
6972     4 .6395,.6459,.6521,.6583,.6644,.6703,.6761,.6819,.6875,.6931, 6981.
6973     5 .6985,.7039,.7091,.7143,.7194,.7243,.7292,.7340,.7387,.7433/ 6982.
6974     C 6983.
6975     DATA C06T05/0.0, 6984.
6976     1 .3420,.3660,.3859,.4034,.4193,.4339,.4474,.4601,.4720,.4833, 6985.
6977     2 .4940,.5043,.5141,.5235,.5326,.5413,.5498,.5579,.5658,.5736, 6986.
6978     3 .5810,.5883,.5954,.6023,.6091,.6157,.6221,.6285,.6346,.6407, 6987.
6979     4 .6466,.6525,.6582,.6638,.6693,.6747,.6800,.6853,.6904,.6955, 6988.
6980     5 .7004,.7053,.7101,.7148,.7194,.7240,.7285,.7329,.7372,.7415/ 6989.
6981     C 6990.
6982     DATA C06T06/0.0, 6991.
6983     1 .3586,.3821,.4016,.4187,.4342,.4484,.4615,.4739,.4854,.4964, 6992.
6984     2 .5067,.5166,.5260,.5350,.5438,.5521,.5602,.5680,.5755,.5829, 6993.
6985     3 .5899,.5968,.6036,.6101,.6165,.6227,.6287,.6347,.6405,.6462, 6994.
6986     4 .6517,.6571,.6625,.6677,.6729,.6779,.6828,.6877,.6925,.6972, 6995.
6987     5 .7018,.7063,.7108,.7152,.7195,.7237,.7279,.7320,.7360,.7400/ 6996.
6988     C 6997.
6989     DATA C06T07/0.0, 6998.
6990     1 .3711,.3942,.4133,.4301,.4453,.4592,.4720,.4841,.4953,.5060, 6999.
6991     2 .5160,.5256,.5348,.5435,.5520,.5600,.5678,.5753,.5826,.5896, 7000.
6992     3 .5964,.6031,.6095,.6157,.6219,.6278,.6336,.6392,.6447,.6501, 7001.
6993     4 .6554,.6606,.6657,.6706,.6755,.6802,.6849,.6895,.6940,.6985, 7002.
6994     5 .7028,.7071,.7113,.7154,.7195,.7235,.7274,.7313,.7351,.7388/ 7003.
6995     C 7004.
6996     DATA C06T08/0.0, 7005.
6997     1 .3808,.4036,.4224,.4390,.4539,.4676,.4801,.4920,.5029,.5134, 7006.
6998     2 .5232,.5326,.5415,.5500,.5582,.5660,.5736,.5809,.5880,.5948, 7007.
6999     3 .6014,.6078,.6140,.6200,.6259,.6316,.6372,.6427,.6480,.6532, 7008.
7000     4 .6582,.6632,.6681,.6728,.6775,.6820,.6865,.6909,.6952,.6994, 7009.
7001     5 .7036,.7077,.7117,.7156,.7195,.7233,.7270,.7307,.7343,.7379/ 7010.
7002     C 7011.
7003     DATA C06T09/0.0, 7012.
7004     1 .3886,.4111,.4297,.4460,.4607,.4742,.4865,.4982,.5089,.5192, 7013.
7005     2 .5288,.5380,.5467,.5551,.5631,.5708,.5782,.5853,.5922,.5988, 7014.
7006     3 .6052,.6115,.6175,.6234,.6291,.6347,.6401,.6454,.6505,.6555, 7015.
7007     4 .6604,.6652,.6699,.6745,.6790,.6834,.6877,.6920,.6961,.7002, 7016.
7008     5 .7042,.7081,.7119,.7157,.7195,.7231,.7267,.7303,.7337,.7372/ 7017.
7009     C 7018.
7010     DATA C06T10/0.0, 7019.
7011     1 .3949,.4172,.4356,.4517,.4663,.4796,.4917,.5032,.5138,.5239, 7020.
7012     2 .5334,.5424,.5510,.5592,.5671,.5746,.5819,.5888,.5955,.6021, 7021.
7013     3 .6083,.6144,.6203,.6261,.6317,.6371,.6424,.6475,.6525,.6574, 7022.
7014     4 .6622,.6668,.6714,.6759,.6802,.6845,.6887,.6928,.6968,.7008, 7023.
7015     5 .7046,.7085,.7122,.7159,.7195,.7230,.7265,.7299,.7333,.7366/ 7024.
7016     C 7025.
7017     DATA C06T99/0.0, 7026.
7018     1 .4509,.4707,.4871,.5013,.5141,.5256,.5362,.5461,.5551,.5638, 7027.
7019     2 .5718,.5794,.5866,.5934,.6000,.6062,.6122,.6178,.6233,.6286, 7028.
7020     3 .6336,.6386,.6433,.6478,.6523,.6565,.6607,.6647,.6686,.6724, 7029.
7021     4 .6761,.6797,.6832,.6866,.6900,.6932,.6964,.6995,.7025,.7055, 7030.
7022     5 .7084,.7112,.7140,.7167,.7194,.7220,.7245,.7270,.7295,.7319/ 7031.
7023     C 7032.
7024     DATA C07T01/0.0, 7033.
7025     1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 7034.
7026     2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 7035.
7027     3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 7036.
7028     4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 7037.
7029     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 7038.
7030     C 7039.
7031     DATA C07T02/0.0, 7040.
7032     1 .2601,.2939,.3219,.3466,.3691,.3898,.4090,.4272,.4442,.4606, 7041.
7033     2 .4762,.4912,.5057,.5198,.5334,.5466,.5596,.5721,.5843,.5963, 7042.
7034     3 .6078,.6192,.6302,.6410,.6515,.6616,.6715,.6811,.6904,.6995, 7043.
7035     4 .7083,.7168,.7251,.7331,.7409,.7483,.7556,.7626,.7694,.7760, 7044.
7036     5 .7824,.7885,.7945,.8002,.8058,.8111,.8163,.8214,.8262,.8309/ 7045.
7037     C 7046.
7038     DATA C07T03/0.0, 7047.
7039     1 .3256,.3578,.3842,.4074,.4283,.4473,.4648,.4813,.4966,.5111, 7048.
7040     2 .5248,.5379,.5504,.5624,.5740,.5851,.5959,.6063,.6163,.6262, 7049.
7041     3 .6357,.6450,.6540,.6628,.6715,.6798,.6880,.6960,.7037,.7113, 7050.
7042     4 .7187,.7259,.7330,.7398,.7465,.7530,.7594,.7656,.7716,.7774, 7051.
7043     5 .7831,.7887,.7940,.7993,.8044,.8093,.8141,.8188,.8233,.8278/ 7052.
7044     C 7053.
7045     DATA C07T04/0.0, 7054.
7046     1 .3675,.3983,.4235,.4455,.4652,.4831,.4995,.5149,.5290,.5424, 7055.
7047     2 .5550,.5670,.5783,.5892,.5996,.6096,.6192,.6284,.6374,.6461, 7056.
7048     3 .6544,.6626,.6705,.6781,.6857,.6929,.7000,.7070,.7137,.7204, 7057.
7049     4 .7268,.7331,.7393,.7453,.7512,.7569,.7625,.7680,.7734,.7786, 7058.
7050     5 .7837,.7887,.7936,.7983,.8030,.8075,.8119,.8163,.8205,.8246/ 7059.
7051     C 7060.
7052     DATA C07T05/0.0, 7061.
7053     1 .3963,.4260,.4503,.4714,.4902,.5073,.5228,.5374,.5507,.5634, 7062.
7054     2 .5752,.5864,.5970,.6071,.6168,.6260,.6349,.6434,.6516,.6596, 7063.
7055     3 .6672,.6746,.6818,.6888,.6956,.7022,.7086,.7149,.7210,.7270, 7064.
7056     4 .7328,.7384,.7440,.7494,.7547,.7599,.7650,.7699,.7748,.7796, 7065.
7057     5 .7842,.7887,.7932,.7976,.8018,.8060,.8101,.8141,.8180,.8218/ 7066.
7058     C 7067.
7059     DATA C07T06/0.0, 7068.
7060     1 .4172,.4461,.4696,.4900,.5082,.5246,.5395,.5535,.5662,.5783, 7069.
7061     2 .5895,.6001,.6102,.6198,.6289,.6376,.6460,.6540,.6617,.6691, 7070.
7062     3 .6763,.6832,.6899,.6964,.7028,.7089,.7148,.7206,.7263,.7318, 7071.
7063     4 .7371,.7424,.7475,.7525,.7574,.7622,.7668,.7714,.7759,.7803, 7072.
7064     5 .7846,.7888,.7929,.7969,.8009,.8048,.8086,.8123,.8159,.8195/ 7073.
7065     C 7074.
7066     DATA C07T07/0.0, 7075.
7067     1 .4331,.4613,.4842,.5040,.5216,.5375,.5520,.5654,.5777,.5893, 7076.
7068     2 .6001,.6104,.6200,.6291,.6379,.6462,.6542,.6618,.6691,.6762, 7077.
7069     3 .6830,.6896,.6959,.7021,.7081,.7138,.7194,.7249,.7302,.7354, 7078.
7070     4 .7404,.7453,.7502,.7548,.7594,.7639,.7683,.7726,.7768,.7809, 7079.
7071     5 .7849,.7888,.7927,.7965,.8002,.8038,.8074,.8109,.8143,.8177/ 7080.
7072     C 7081.
7073     DATA C07T08/0.0, 7082.
7074     1 .4455,.4731,.4955,.5148,.5320,.5475,.5616,.5747,.5866,.5979, 7083.
7075     2 .6083,.6182,.6275,.6363,.6448,.6528,.6605,.6678,.6748,.6816, 7084.
7076     3 .6881,.6944,.7005,.7064,.7121,.7176,.7230,.7282,.7332,.7382, 7085.
7077     4 .7430,.7476,.7522,.7566,.7610,.7652,.7694,.7735,.7774,.7813, 7086.
7078     5 .7851,.7889,.7925,.7961,.7996,.8030,.8064,.8097,.8130,.8162/ 7087.
7079     C 7088.
7080     DATA C07T09/0.0, 7089.
7081     1 .4555,.4826,.5046,.5235,.5404,.5555,.5692,.5820,.5936,.6046, 7090.
7082     2 .6147,.6244,.6334,.6420,.6502,.6579,.6654,.6725,.6793,.6859, 7091.
7083     3 .6921,.6982,.7041,.7098,.7153,.7206,.7257,.7308,.7356,.7404, 7092.
7084     4 .7449,.7494,.7538,.7581,.7622,.7663,.7703,.7742,.7780,.7817, 7093.
7085     5 .7853,.7889,.7924,.7958,.7992,.8024,.8057,.8088,.8119,.8150/ 7094.
7086     C 7095.
7087     DATA C07T10/0.0, 7096.
7088     1 .4637,.4903,.5120,.5306,.5471,.5620,.5754,.5879,.5993,.6101, 7097.
7089     2 .6200,.6294,.6382,.6466,.6546,.6621,.6694,.6763,.6829,.6893, 7098.
7090     3 .6954,.7013,.7070,.7125,.7179,.7230,.7280,.7328,.7375,.7421, 7099.
7091     4 .7465,.7509,.7551,.7592,.7632,.7672,.7710,.7747,.7784,.7820, 7100.
7092     5 .7855,.7889,.7923,.7956,.7988,.8020,.8051,.8081,.8111,.8140/ 7101.
7093     C 7102.
7094     DATA C07T99/0.0, 7103.
7095     1 .5366,.5590,.5770,.5924,.6060,.6180,.6289,.6389,.6480,.6565, 7104.
7096     2 .6643,.6717,.6785,.6850,.6912,.6969,.7025,.7077,.7127,.7175, 7105.
7097     3 .7220,.7264,.7306,.7347,.7386,.7423,.7460,.7495,.7529,.7562, 7106.
7098     4 .7594,.7625,.7655,.7684,.7712,.7740,.7767,.7793,.7818,.7843, 7107.
7099     5 .7867,.7891,.7914,.7937,.7959,.7981,.8002,.8022,.8043,.8062/ 7108.
7100     C 7109.
7101     DATA C08T01/0.0, 7110.
7102     1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 7111.
7103     2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 7112.
7104     3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 7113.
7105     4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 7114.
7106     5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 7115.
7107     C 7116.
7108     DATA C08T02/0.0, 7117.
7109     1 .2878,.3342,.3718,.4041,.4329,.4588,.4824,.5045,.5249,.5442, 7118.
7110     2 .5623,.5797,.5962,.6120,.6272,.6417,.6559,.6693,.6823,.6949, 7119.
7111     3 .7069,.7186,.7298,.7405,.7509,.7606,.7701,.7792,.7879,.7963, 7120.
7112     4 .8042,.8118,.8191,.8260,.8327,.8390,.8451,.8509,.8564,.8617, 7121.
7113     5 .8667,.8716,.8762,.8806,.8848,.8888,.8926,.8963,.8998,.9032/ 7122.
7114     C 7123.
7115     DATA C08T03/0.0, 7124.
7116     1 .3656,.4087,.4432,.4725,.4984,.5215,.5422,.5614,.5789,.5954, 7125.
7117     2 .6106,.6251,.6387,.6517,.6641,.6758,.6872,.6981,.7085,.7187, 7126.
7118     3 .7283,.7378,.7468,.7555,.7641,.7722,.7801,.7878,.7951,.8022, 7127.
7119     4 .8091,.8157,.8221,.8282,.8342,.8399,.8454,.8507,.8558,.8608, 7128.
7120     5 .8655,.8700,.8744,.8786,.8826,.8865,.8903,.8939,.8973,.9006/ 7129.
7121     C 7130.
7122     DATA C08T04/0.0, 7131.
7123     1 .4167,.4573,.4895,.5167,.5405,.5616,.5805,.5979,.6136,.6283, 7132.
7124     2 .6419,.6547,.6668,.6781,.6890,.6992,.7091,.7184,.7274,.7361, 7133.
7125     3 .7444,.7525,.7602,.7677,.7750,.7820,.7888,.7954,.8018,.8080, 7134.
7126     4 .8139,.8197,.8254,.8308,.8361,.8412,.8462,.8510,.8556,.8601, 7135.
7127     5 .8645,.8687,.8728,.8767,.8805,.8842,.8877,.8912,.8945,.8977/ 7136.
7128     C 7137.
7129     DATA C08T05/0.0, 7138.
7130     1 .4528,.4913,.5218,.5473,.5696,.5893,.6069,.6230,.6375,.6511, 7139.
7131     2 .6635,.6752,.6862,.6965,.7063,.7156,.7245,.7329,.7409,.7487, 7140.
7132     3 .7561,.7633,.7703,.7769,.7834,.7896,.7957,.8015,.8072,.8127, 7141.
7133     4 .8180,.8232,.8283,.8332,.8379,.8426,.8470,.8514,.8556,.8598, 7142.
7134     5 .8638,.8677,.8714,.8751,.8787,.8821,.8855,.8887,.8919,.8950/ 7143.
7135     C 7144.
7136     DATA C08T06/0.0, 7145.
7137     1 .4795,.5164,.5454,.5697,.5909,.6095,.6261,.6412,.6548,.6675, 7146.
7138     2 .6791,.6901,.7003,.7098,.7190,.7275,.7357,.7435,.7509,.7581, 7147.
7139     3 .7648,.7714,.7778,.7838,.7898,.7954,.8009,.8063,.8115,.8165, 7148.
7140     4 .8214,.8261,.8307,.8352,.8395,.8437,.8479,.8519,.8558,.8596, 7149.
7141     5 .8633,.8669,.8704,.8738,.8772,.8804,.8836,.8866,.8896,.8925/ 7150.
7142     C 7151.
7143     DATA C08T07/0.0, 7152.
7144     1 .5000,.5356,.5635,.5868,.6070,.6248,.6406,.6550,.6679,.6800, 7153.
7145     2 .6909,.7013,.7109,.7199,.7285,.7365,.7442,.7515,.7584,.7651, 7154.
7146     3 .7715,.7776,.7835,.7892,.7947,.7999,.8051,.8100,.8148,.8195, 7155.
7147     4 .8240,.8284,.8327,.8368,.8408,.8448,.8486,.8523,.8560,.8595, 7156.
7148     5 .8630,.8663,.8696,.8728,.8759,.8790,.8820,.8849,.8877,.8905/ 7157.
7149     C 7158.
7150     DATA C08T08/0.0, 7159.
7151     1 .5162,.5507,.5777,.6002,.6197,.6368,.6519,.6657,.6781,.6896, 7160.
7152     2 .7001,.7100,.7191,.7277,.7359,.7435,.7508,.7577,.7643,.7706, 7161.
7153     3 .7766,.7824,.7880,.7933,.7986,.8035,.8083,.8130,.8175,.8219, 7162.
7154     4 .8261,.8302,.8343,.8381,.8419,.8456,.8492,.8527,.8561,.8595, 7163.
7155     5 .8627,.8659,.8690,.8720,.8750,.8778,.8806,.8834,.8861,.8887/ 7164.
7156     C 7165.
7157     DATA C08T09/0.0, 7166.
7158     1 .5293,.5629,.5891,.6109,.6298,.6464,.6610,.6743,.6862,.6974, 7167.
7159     2 .7074,.7169,.7257,.7340,.7418,.7491,.7561,.7627,.7690,.7750, 7168.
7160     3 .7807,.7863,.7916,.7967,.8016,.8063,.8109,.8154,.8196,.8238, 7169.
7161     4 .8278,.8317,.8356,.8392,.8428,.8463,.8497,.8531,.8563,.8595, 7170.
7162     5 .8625,.8656,.8685,.8714,.8742,.8769,.8796,.8822,.8847,.8872/ 7171.
7163     C 7172.
7164     DATA C08T10/0.0, 7173.
7165     1 .5401,.5729,.5985,.6197,.6381,.6542,.6684,.6813,.6929,.7036, 7174.
7166     2 .7134,.7226,.7311,.7390,.7466,.7536,.7604,.7667,.7728,.7786, 7175.
7167     3 .7841,.7894,.7945,.7994,.8042,.8087,.8131,.8173,.8214,.8254, 7176.
7168     4 .8292,.8330,.8366,.8401,.8436,.8469,.8502,.8534,.8564,.8595, 7177.
7169     5 .8624,.8653,.8681,.8708,.8735,.8761,.8787,.8812,.8836,.8860/ 7178.
7170     C 7179.
7171     DATA C08T99/0.0, 7180.
7172     1 .6384,.6631,.6821,.6978,.7111,.7227,.7328,.7420,.7501,.7576, 7181.
7173     2 .7644,.7707,.7765,.7819,.7870,.7918,.7963,.8005,.8045,.8084, 7182.
7174     3 .8120,.8154,.8187,.8219,.8250,.8278,.8307,.8334,.8360,.8385, 7183.
7175     4 .8409,.8432,.8455,.8477,.8498,.8519,.8539,.8559,.8578,.8596, 7184.
7176     5 .8614,.8632,.8648,.8665,.8681,.8697,.8712,.8728,.8742,.8757/ 7185.
7177     C 7186.
7178     DATA C09T01/0.0, 7187.
7179     1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 7188.
7180     2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 7189.
7181     3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 7190.
7182     4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 7191.
7183     5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 7192.
7184     C 7193.
7185     DATA C09T02/0.0, 7194.
7186     1 .3174,.3895,.4438,.4879,.5256,.5583,.5872,.6136,.6374,.6597, 7195.
7187     2 .6802,.6995,.7175,.7345,.7506,.7655,.7798,.7930,.8055,.8173, 7196.
7188     3 .8281,.8385,.8481,.8570,.8655,.8731,.8804,.8872,.8935,.8994, 7197.
7189     4 .9049,.9099,.9148,.9191,.9233,.9271,.9307,.9341,.9373,.9402, 7198.
7190     5 .9430,.9456,.9480,.9503,.9524,.9544,.9563,.9581,.9598,.9613/ 7199.
7191     C 7200.
7192     DATA C09T03/0.0, 7201.
7193     1 .4078,.4729,.5209,.5592,.5915,.6191,.6431,.6649,.6842,.7022, 7202.
7194     2 .7185,.7339,.7481,.7614,.7741,.7859,.7972,.8078,.8178,.8274, 7203.
7195     3 .8364,.8451,.8532,.8608,.8682,.8750,.8815,.8877,.8934,.8989, 7204.
7196     4 .9040,.9089,.9135,.9177,.9218,.9256,.9292,.9326,.9358,.9388, 7205.
7197     5 .9416,.9443,.9468,.9491,.9514,.9535,.9554,.9573,.9591,.9607/ 7206.
7198     C 7207.
7199     DATA C09T04/0.0, 7208.
7200     1 .4692,.5288,.5723,.6066,.6353,.6597,.6807,.6997,.7163,.7318, 7209.
7201     2 .7457,.7588,.7708,.7821,.7927,.8026,.8121,.8210,.8295,.8376, 7210.
7202     3 .8452,.8525,.8595,.8661,.8724,.8784,.8841,.8896,.8948,.8998, 7211.
7203     4 .9044,.9089,.9132,.9172,.9210,.9247,.9281,.9314,.9345,.9374, 7212.
7204     5 .9402,.9429,.9453,.9477,.9500,.9521,.9541,.9560,.9579,.9596/ 7213.
7205     C 7214.
7206     DATA C09T05/0.0, 7215.
7207     1 .5136,.5690,.6090,.6404,.6666,.6886,.7076,.7246,.7394,.7532, 7216.
7208     2 .7655,.7771,.7877,.7976,.8069,.8156,.8239,.8316,.8390,.8461, 7217.
7209     3 .8528,.8592,.8653,.8711,.8767,.8820,.8871,.8920,.8967,.9012, 7218.
7210     4 .9054,.9095,.9134,.9171,.9207,.9241,.9274,.9305,.9335,.9363, 7219.
7211     5 .9390,.9416,.9440,.9464,.9486,.9507,.9527,.9546,.9565,.9582/ 7220.
7212     C 7221.
7213     DATA C09T06/0.0, 7222.
7214     1 .5473,.5993,.6366,.6658,.6900,.7102,.7277,.7432,.7568,.7693, 7223.
7215     2 .7805,.7910,.8006,.8095,.8179,.8257,.8332,.8401,.8468,.8531, 7224.
7216     3 .8591,.8648,.8703,.8755,.8806,.8853,.8899,.8944,.8986,.9027, 7225.
7217     4 .9066,.9103,.9140,.9174,.9207,.9239,.9270,.9299,.9327,.9354, 7226.
7218     5 .9380,.9405,.9429,.9451,.9473,.9494,.9514,.9533,.9551,.9568/ 7227.
7219     C 7228.
7220     DATA C09T07/0.0, 7229.
7221     1 .5737,.6230,.6581,.6855,.7081,.7271,.7433,.7577,.7703,.7819, 7230.
7222     2 .7922,.8019,.8107,.8189,.8266,.8338,.8406,.8470,.8530,.8588, 7231.
7223     3 .8643,.8695,.8745,.8793,.8839,.8883,.8925,.8966,.9004,.9042, 7232.
7224     4 .9078,.9113,.9146,.9178,.9209,.9239,.9268,.9295,.9322,.9348, 7233.
7225     5 .9372,.9396,.9419,.9441,.9462,.9482,.9502,.9520,.9538,.9555/ 7234.
7226     C 7235.
7227     DATA C09T08/0.0, 7236.
7228     1 .5950,.6420,.6754,.7013,.7226,.7405,.7557,.7693,.7811,.7919, 7237.
7229     2 .8016,.8106,.8188,.8265,.8337,.8403,.8466,.8525,.8582,.8635, 7238.
7230     3 .8686,.8734,.8781,.8825,.8868,.8908,.8947,.8985,.9021,.9056, 7239.
7231     4 .9089,.9121,.9153,.9183,.9212,.9240,.9267,.9293,.9318,.9343, 7240.
7232     5 .9366,.9389,.9411,.9432,.9452,.9472,.9490,.9509,.9526,.9543/ 7241.
7233     C 7242.
7234     DATA C09T09/0.0, 7243.
7235     1 .6125,.6576,.6894,.7142,.7345,.7514,.7659,.7787,.7899,.8001, 7244.
7236     2 .8093,.8177,.8255,.8327,.8394,.8457,.8516,.8572,.8624,.8675, 7245.
7237     3 .8722,.8767,.8811,.8852,.8892,.8930,.8966,.9002,.9035,.9068, 7246.
7238     4 .9100,.9130,.9159,.9187,.9215,.9241,.9267,.9292,.9316,.9339, 7247.
7239     5 .9361,.9383,.9404,.9424,.9443,.9462,.9481,.9498,.9515,.9532/ 7248.
7240     C 7249.
7241     DATA C09T10/0.0, 7250.
7242     1 .6272,.6706,.7012,.7249,.7443,.7605,.7743,.7866,.7972,.8069, 7251.
7243     2 .8156,.8236,.8310,.8378,.8442,.8501,.8558,.8610,.8660,.8708, 7252.
7244     3 .8752,.8795,.8836,.8875,.8913,.8949,.8983,.9016,.9048,.9079, 7253.
7245     4 .9109,.9137,.9165,.9192,.9218,.9243,.9267,.9291,.9314,.9336, 7254.
7246     5 .9357,.9378,.9398,.9417,.9436,.9454,.9472,.9489,.9506,.9522/ 7255.
7247     C 7256.
7248     DATA C09T99/0.0, 7257.
7249     1 .7681,.7934,.8109,.8243,.8350,.8439,.8514,.8579,.8636,.8687, 7258.
7250     2 .8732,.8774,.8812,.8847,.8880,.8910,.8938,.8964,.8989,.9013, 7259.
7251     3 .9035,.9056,.9076,.9095,.9113,.9130,.9147,.9163,.9178,.9193, 7260.
7252     4 .9207,.9221,.9234,.9247,.9260,.9271,.9283,.9294,.9305,.9316, 7261.
7253     5 .9326,.9336,.9346,.9355,.9364,.9373,.9382,.9390,.9398,.9406/ 7262.
7254     C 7263.
7255     C 7264.
7256     C ---------------------------------------------------------------- 7265.
7257     C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 7266.
7258     C FOR CLOUD ALBEDOS FOR OPTICAL THICKNESS FROM (1.0 < TAU < 99.0) 7267.
7259     C ---------------------------------------------------------------- 7268.
7260     C 7269.
7261     C 7270.
7262     C ------------------------------------------- 7271.
7263     C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 7272.
7264     C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 7273.
7265     C ------------------------------------------- 7274.
7266     C 7275.
7267     XI=XMU*50.0+0.9999 7276.
7268     IX=XI 7277.
7269     IF(IX.LT.1) IX=1 7278.
7270     JX=IX+1 7279.
7271     WXJ=XI-IX 7280.
7272     WXI=1.0-WXJ 7281.
7273     C 7282.
7274     C ----------------------- 7283.
7275     C CLOUD TAU INTERPOLATION 7284.
7276     C 1.0 OVER (1 < TAU < 10) 7285.
7277     C LINEAR (10 < TAU < 100) 7286.
7278     C ----------------------- 7287.
7279     C 7288.
7280     TI=TAU 7289.
7281     IT=TI 7290.
7282     IF(IT.LT.1) IT=1 7291.
7283     WTJ=TI-IT 7292.
7284     IF(IT.GT.9) THEN 7293.
7285     WTJ=(TAU-10.0)/90.0 7294.
7286     IT=10 7295.
7287     ENDIF 7296.
7288     WTI=1.0-WTJ 7297.
7289     JT=IT+1 7298.
7290     C 7299.
7291     C ------------------------------- 7300.
7292     C COSBAR DEPENDENCE INTERPOLATION 7301.
7293     C 0.10 ON (0.5 < COSBAR < 0.9) 7302.
7294     C LINEAR FOR (0.0 < COSBAR < 0.5) 7303.
7295     C ------------------------------- 7304.
7296     C 7305.
7297     GI=G*10.0 7306.
7298     IF(GI.GT.5.0) GO TO 110 7307.
7299     JG=1 7308.
7300     GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7309.
7301     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7310.
7302     GG=GG+GG 7311.
7303     GO TO 130 7312.
7304     C 7313.
7305     110 IG=GI 7314.
7306     WGJ=GI-IG 7315.
7307     WGI=1.0-WGJ 7316.
7308     IG=IG-4 7317.
7309     JG=IG+1 7318.
7310     IF(IG.GT.4) GO TO 120 7319.
7311     C 7320.
7312     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7321.
7313     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7322.
7314     + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7323.
7315     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7324.
7316     GO TO 130 7325.
7317     C 7326.
7318     120 IG=5 7327.
7319     C 7328.
7320     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7329.
7321     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7330.
7322     + +WGJ 7331.
7323     C 7332.
7324     130 CONTINUE 7333.
7325     C 7334.
7326     RETURN 7335.
7327     END 7336.
  ViewVC Help
Powered by ViewVC 1.1.22