/[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.3 - (hide annotations) (download)
Wed Sep 2 15:30:28 2009 UTC (15 years, 10 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +12 -1 lines 
use NIR albedo from seaice model, in accord with changes to thsice pkg
1 jscott 1.3 C $Header$
2     C $Name$
3    
4 jscott 1.1 #include "ctrparam.h"
5    
6     ! ==========================================================
7     !
8     ! R95MIT.F: Model II radiation: 1958 Atmosphere and mean
9     ! strat aeros (.012) Zenith angle dependence
10     ! for aerosols not used.
11     !
12     ! ----------------------------------------------------------
13     !
14     ! Author of Chemistry Modules: Chien Wang
15     !
16     ! ----------------------------------------------------------
17     !
18     ! Important Note: Because the original components of chemistry
19     ! module in this file are used by some runs not using
20     ! interactive chemistry-climate model, therefore, the
21     ! cpp header CPL_CHEM is barely applied. Instead,
22     ! PREDICTED_GASES is appearing at related places.
23     !
24     ! Chien Wang
25     ! 080100
26     !
27     ! Revision History:
28     !
29     ! When Who What
30     ! ---- ---------- -------
31     ! 073100 Chien Wang repack based on CliChem3 & M24x11,
32     ! add cpp, and float -> dble
33     ! 093001 Chien Wang add bc & oc and rewrote aerosol/radiation
34     ! interface including S(VI)
35     ! 062604 Chien Wang merge with current igsm module
36     !
37     ! ==========================================================
38    
39    
40     C**** R83XX B83XX R83ZA 02/4/93 0.1
41     C**** OPT(3) 0.2
42     C**** 0.3
43     C**** Model II radiation: 1958 Atmosphere and mean strat aeros (.012) 0.4
44     C**** Zenith angle dependence for aerosols not used. 0.5
45     ***** R83ZA B83XX R83ZA 12/23/91 0.1
46     ***** OPT(3) 0.2
47     ***** 0.3
48     ***** Model II radiation with 1958 Atmosphere, mean strat aeros (.012). 0.4
49     ***** Aerosols: Zenith angle dependence and other changes implemented 0.5
50     C SUBROUTINE RCOMP1(NFTTTR,NFTTSR,NFTFOR) 1.
51     c 6/20/2005
52     SUBROUTINE RCOMP1(NFTTTR,NFTTSR,NFTFOR,KTREND)
53    
54     #include "chem_para"
55     #include "chem_com"
56     #include "B83XX.COM" 1012.
57    
58     c DOUBLE PRECISION PFOFTK,TKOFPF,WAVNA,WAVNB,TK,PFWI 64.
59     DATA WAVNA/850.0/,WAVNB/900.0/ 64.5
60     C 65.
61     NKSR=6 66.
62     C ----------------------------------------------------- 67.
63     C READ IN GAS TAU TABLE AND DISTRIBUTED PLANCK FUNCTION 68.
64     C ALSO THERMAL RAD AEROSOL, CLOUD & SURFACE ALBEDO DATA 69.
65     C 70.
66     C IF(NFTTTR.GE.1) TAU TABLE DATA ARE READ (UNIT=NFTTTR) 71.
67     C WINDOW FLUX B TEMP CONVERSION FACTORS 72.
68     C ARE ALSO COMPUTED AT THIS TIME 73.
69     C 74.
70     C IF(NFTTTR.LT.1) TAU TABLE DATA ARE NOT READ FROM DISK 75.
71     C WINDOW FLUX B TEMP CONVERSION FACTORS 76.
72     C ARE NOT COMPUTED 77.
73     C COMMON/RADCOM/PARAMETERS CAN BE RESET 78.
74     C MORE CONVENIENTLY 79.
75     C ----------------------------------------------------- 80.
76     C 81.
77     IF(NFTTTR.LT.1) GO TO 110 82.
78     C 83.
79     C$ REWIND NFTTTR 84.
80     C$ READ (NFTTTR) ITRHDR,TAUTBL,PLANCK,TRAQEX,TRAQSC,TRACOS 85.
81     C$ + ,TRCQEX,TRCQSC,TRCCOS,AOCEAN,AGSIDV,CLDALB 86.
82     C$ + ,TRACEG 87.
83     REWIND NFTTTR 88.
84     READ (NFTTTR) TAUTBL 89.
85     REWIND NFTTTR 89.5
86     C 90.
87     NFTTTP=NFTTTR+1 91.
88     REWIND NFTTTP 92.
89     READ (NFTTTP) PLANCK 93.
90     REWIND NFTTTP 93.5
91     C 94.
92     C 95.
93     C$ IF(NFTTSR.GT.1) REWIND NFTTSR 96.
94     C$ IF(NFTTSR.GT.1) READ (NFTTSR) ISRHDR,SRTBL 97.
95     C 98.
96     ID5(1)=8304 99.
97     ID5(2)=8106 100.
98     ID5(3)=8106 101.
99     C 102.
100     NKTR =25 103.
101     IT0 =123 104.
102     ITNEXT=250 105.
103     C 106.
104     C --------------------------------------------------------------- 107.
105     C DEFINE WINDOW FLUX TO BRIGHTNESS TEMPERATURE CONVERSION FACTORS 108.
106     C --------------------------------------------------------------- 109.
107     C 110.
108     DO 100 I=1,630 111.
109     PFWI=0.001*I 112.
110     IF(I.GT.100) PFWI=(0.1+0.01*(I-100)) 113.
111     IF(I.GT.190) PFWI=(1.0+0.10*(I-190)) 114.
112     100 TKPFW(I)=TKOFPF(WAVNA,WAVNB,PFWI) 115.
113     110 CONTINUE 116.
114     C --------------------------------------------------- 117.
115     C SET ALBEDO,GAS,AEROSOL DISTRIBUTIONS & COEFFICIENTS 118.
116     C ALSO CALLED ARE ALBDAY,O3DDAY,O3DLAT FOR JDAY,JLAT 119.
117     C-------------------------------------------------------------------- 120.
118     C 121.
119     IF(KFORCE.GT.0) CALL SETFOR(NFTFOR) 122.
120     IF(LASTVC.GE.0) CALL SETATM 123.
121     C **************** Print *******
122     c print *,' from RCOMP1'
123     c print *,'JMLAT=',JMLAT
124     c print *,'DLAT'
125     c print *,DLAT
126     C **************** Print *******
127     CALL SETALB 124.
128     c CALL SETGAS 125.
129     c 6/202005
130     ! print *,' Before CALL SETGAS'
131     CALL SETGAS(KTREND)
132     ! print *,' After CALL SETGAS'
133     CALL SETAER 126.
134    
135     C----------------- 127.
136     RETURN 128.
137     C 129.
138     C----------------------------------------------------------------------- 130.
139     C RESET SEASON (JDAY) DEPENDENT QUANTITIES AS NEEDED 131.
140     ENTRY RCOMPT 132.
141     c print *,' from RCOMPT JDAY=',JDAY
142     c print *,'PPMV58 from RCOMPT'
143     c print *,PPMV58
144     C----------------------------------------------------------------------- 133.
145     C 134.
146     IF(KFORCE.GT.0) CALL GETFOR 135.
147     IF(LAPGAS.EQ.2) CALL SETLAP 136.
148     CALL ALBDAY 137.
149     CALL O3DDAY 138.
150    
151     #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
152     C--Addition by CEForest (18Mar98)
153     call getforcedozone(jyear,jday)
154     C--End of Addition
155     #endif
156    
157     RETURN 139.
158     C 140.
159     C----------------------------------------------------------------------- 141.
160     C RESET LATITUDE (JLAT) DEPENDENT QUANTITIES AS NEEDED 142.
161     ENTRY RCOMPJ 143.
162     C----------------------------------------------------------------------- 144.
163     CALL O3DLAT 145.
164     RETURN 146.
165     C 147.
166     C----------------------------------------------------------------------- 148.
167     C GET ALBEDO,GAS AEROSOL DATA THEN COMPUTE THERML/SOLAR 149.
168     ENTRY RCOMPX 150.
169     C----------------------------------------------------------------------- 151.
170     CALL GETALB 152.
171     CALL GETGAS 153.
172     CALL GETAER 154.
173     C -------------------------------------------- 155.
174     C SPECIFY SURFACE LAYER GAS ABSORPTION AMOUNTS 156.
175     C -------------------------------------------- 157.
176     DO 350 K=1,11 158.
177     TAUSL(K)=RATQSL*FRACSL*TAUN(1+K*NL-NL) 159.
178     350 TAUN(1+K*NL-NL)=TAUN(1+K*NL-NL)-TAUSL(K) 160.
179     DO 360 K=12,NKTR 161.
180     TAUSL(K)= FRACSL*TAUN(1+K*NL-NL) 162.
181     360 TAUN(1+K*NL-NL)=TAUN(1+K*NL-NL)-TAUSL(K) 163.
182     C----------------- 164.
183     CALL THERML 165.
184     C----------------- 166.
185     IF(KGASSR.GT.0) CALL SOLGAS 167.
186     C 168.
187     C$ ****************************COMMENTED OUT CARDS INTERPOLATE SOLAR TAU 169.
188     C$ DO 300 I=1,600 170.
189     C$300 SRTAU(I)=0. 171.
190     C$ CALL SRGAS (NL,PL,DPL,TLM,ULGAS,SRTAU,SRTBL,1,3) 172.
191     C---------------- 173.
192     CALL SOLAR 174.
193     C---------------- 175.
194     C 176.
195    
196     RETURN 177.
197     END 178.
198     SUBROUTINE SETALB 179.
199     COMMON/ADDALB/BVSURFA,XVSURFA,BNSURFA,XNSURFA
200    
201     #include "B83XX.COM" 180.
202     #include "chem_para"
203     #include "chem_com"
204 jscott 1.3 #if ( defined OCEAN_3D )
205     PARAMETER (IM0=01,JM0=N_LAT,LM0=N_LEV,IO0=N_LON0,KAIJ0=75)
206     #include "AGRID.h"
207     #endif
208 jscott 1.1 #if ( defined CLM )
209 jscott 1.2 #include "CLM.h"
210 jscott 1.1 #endif
211    
212     DIMENSION ALVISK(11,4),ALNIRK(11,4),FIELDC(11,3),VTMASK(11) 241.
213     C$$ DIMENSION ALMEAN(11,4),RATIRV(11,4) 242.
214     C 243.
215     EQUIVALENCE 244.
216     + (VADATA(1,1,1),ALVISK(1,1)),(VADATA(1,1,2),ALNIRK(1,1)) 245.
217     +, (VADATA(1,1,3),FIELDC(1,1)),(VADATA(1,4,3),VTMASK(1)) 246.
218     C$$ + (VADATA(1,1,1),ALMEAN(1,1)),(VADATA(1,1,2),RATIRV(1,1)) 247.
219     C$$ +, (VADATA(1,1,3),VTMASK(1)),(VADATA(1,2,3),FIELDC(1,1)) 248.
220     C 249.
221     EQUIVALENCE 250.
222     + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 251.
223     +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 252.
224     +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 253.
225     +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 254.
226     +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 255.
227     +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 256.
228     C 257.
229     EQUIVALENCE 258.
230     + (BXA(1),BOCVIS),(BXA(5),BEAVIS),(BXA( 9),BOIVIS),(BXA(13),BLIVIS) 259.
231     +,(BXA(2),BOCNIR),(BXA(6),BEANIR),(BXA(10),BOINIR),(BXA(14),BLINIR) 260.
232     +,(BXA(3),XOCVIS),(BXA(7),XEAVIS),(BXA(11),XOIVIS),(BXA(15),XLIVIS) 261.
233     +,(BXA(4),XOCNIR),(BXA(8),XEANIR),(BXA(12),XOINIR),(BXA(16),XLINIR) 262.
234     C 263.
235     +, (BXA(17),EXPSNE),(BXA(18),EXPSNO),(BXA(19),EXPSNL) 264.
236     C 265.
237     +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 266.
238     +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 267.
239     C 268.
240     EQUIVALENCE (ASNALB(1),ASNVIS),(ASNALB(2),ASNNIR) 269.
241     EQUIVALENCE (AOIALB(1),AOIVIS),(AOIALB(2),AOINIR) 270.
242     EQUIVALENCE (ALIALB(1),ALIVIS),(ALIALB(2),ALINIR) 271.
243     DIMENSION SRBALB(6),SRXALB(6) 272.
244     C 273.
245     EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 274.
246     C 275.
247     C 1 2 3 4 276.
248     C WINTER SPRING SUMMER AUTUMN 277.
249     REAL SEASON(4)/ 15.00, 105.0, 196.0, 288.0/ 278.
250     C 279.
251     C----------------------------------------------------------------------- 280.
252     C SOLAR: OCEAN ALBEDO DEPENDENCE ON ZENITH ANGLE & WIND SPEED 281.
253     C 282.
254     BVH2O(WMAG)=.0488+.0974/(5.679+WMAG)+.0004/(.3333+WMAG) 283.
255     XVH2O(WMAG,X)=.021+X*X*(.0421+X*(.1283+X*(-.04+X*(3.117/ 284.
256     + (5.679+WMAG)+X*.025/(.3333+WMAG))))) 285.
257     C----------------------------------------------------------------------- 286.
258     C 287.
259     data IFFF0 /1/
260     data ICLM /1/
261     C **************** Print *******
262     cprint *,' from SETALB'
263     cprint *,'DLAT'
264     cprint *,DLAT
265     cprint *,'VTMASK'
266     cprint *,VTMASK
267     cprint *,'FIELDC'
268     cprint *,FIELDC
269     C **************** Print *******
270     JNORTH=JMLAT/2+1 288.
271     VISNIR=MEANAL 289.
272     C 290.
273     C**** FOR OLD ALBEDO FILES COMPUTE VISUAL AND NEAR-IR ALBEDOS 290.8
274     c print *,' SETALB NV=',NV
275     c print *,' ALVISK=',ALVISK
276     c print *,' ALNIRK=',ALNIRK
277     IF (VADATA(4,2,3).GT.100.) GO TO 101 290.9
278     DO 100 L=1,4 291.
279     DO 100 K=1,8 292.
280     ALMEAN=ALVISK(K,L) 292.1
281     RATIRV=ALNIRK(K,L) 292.2
282     ALVISK(K,L)=ALMEAN/(0.6+0.4*RATIRV) 293.
283     100 ALNIRK(K,L)=ALMEAN/(0.4+0.6/RATIRV) 294.
284     101 CONTINUE 294.1
285     C 295.
286     C----------------------------------------------------------------------- 296.
287     C DEFINE SEASONAL ALBEDO (ALVISD,ALNIRD) FOR VEG TYPES 297.
288     ENTRY ALBDAY 298.
289     C----------------------------------------------------------------------- 299.
290     C 300.
291     XJDAY=JDAY 301.
292     c print *,'from ALBDAY XJDAY=',XJDAY
293     SEASN1=-77.0 302.
294     DO 110 K=1,4 303.
295     SEASN2=SEASON(K) 304.
296     IF(XJDAY.LE.SEASN2) GO TO 120 305.
297     110 SEASN1=SEASN2 306.
298     K=1 307.
299     SEASN2=380.0 308.
300     120 WT2=(XJDAY-SEASN1)/(SEASN2-SEASN1) 309.
301     WT1=1.-WT2 310.
302     KS1=1+MOD(K,4) 311.
303     KS2=1+MOD(K+1,4) 312.
304     KN1=1+MOD(K+2,4) 313.
305     KN2=K 314.
306     DO 130 K=1,NV 315.
307     C------------------------ 316.
308     C SOUTHERN HEMISPHERE 317.
309     C------------------------ 318.
310     ALVISD(K )=WT1*ALVISK(K,KS1)+WT2*ALVISK(K,KS2) 319.
311     ALNIRD(K )=WT1*ALNIRK(K,KS1)+WT2*ALNIRK(K,KS2) 320.
312     C------------------------ 321.
313     C NORTHERN HEMISPHERE 322.
314     C------------------------ 323.
315     ALVISD(K+NV)=WT1*ALVISK(K,KN1)+WT2*ALVISK(K,KN2) 324.
316     130 ALNIRD(K+NV)=WT1*ALNIRK(K,KN1)+WT2*ALNIRK(K,KN2) 325.
317     c print *,' ALVISK=',ALVISK
318     c print *,' ALNIRK=',ALNIRK
319     c print *,' ALVISD=',ALVISD
320     c print *,' ALNIRD=',ALNIRD
321     RETURN 326.
322     C 327.
323     C----------------------------------------------------------------------- 328.
324     C ALBEDO,THERMAL FLUX,FLUX DERIVATIVE FOR EACH SURF TYPE 329.
325     ENTRY GETALB 330.
326     C----------------------------------------------------------------------- 331.
327     C 332.
328     LATHEM=NV 333.
329     IF(JLAT.LT.JNORTH) LATHEM=0 334.
330     c print *,'From GETALB JLAT=',JLAT
331     c print *,POCEAN,PEARTH,POICE,PLICE
332     C 335.
333     C ------------------------- 336.
334     C SNOW ALBEDO SPECIFICATION 337.
335     C ------------------------- 338.
336     Ccc ASNAGE=0.35*EXP(-0.2*AGESN) 339.
337     if(IFFF0.eq.1)then
338     print *,' FRSNALB=',FRSNALB
339     print *,' ASNALB(1)=',ASNALB(1),' ASNALB(2)=',ASNALB(2)
340     print *,' AOIALB(1)=',AOIALB(1),' AOIALB(2)=',AOIALB(2)
341     print *,' ALIALB(1)=',ALIALB(1),' ALIALB(2)=',ALIALB(2)
342     IFFF0=0
343     endif
344     ASNAGE=FRSNALB*EXP(-0.2*AGESN)
345     BSNVIS=ASNVIS+ASNAGE 340.
346     BSNNIR=ASNNIR+ASNAGE 341.
347     XSNVIS=BSNVIS 342.
348     XSNNIR=BSNNIR 343.
349     C 344.
350     EXPSNE=1. 345.
351     EXPSNO=1. 346.
352     EXPSNL=1. 347.
353     C 348.
354     DO 200 I=1,16 349.
355     200 BXA(I)=0. 350.
356     C 351.
357     DO 210 K=1,NKTR 352.
358     TRGALB(K)=0. 353.
359     BGFEMD(K)=0. 354.
360     210 BGFEMT(K)=0. 355.
361     C 356.
362     BOCSUM=0. 357.
363     BEASUM=0. 358.
364     BOISUM=0. 359.
365     BLISUM=0. 360.
366     C 361.
367     DO 220 K=1,4 362.
368     220 DTRUFG(K)=0. 363.
369     C 364.
370     C -------------------------- 365.
371     C OCEAN ALBEDO SPECIFICATION 366.
372     C -------------------------- 367.
373     IF(POCEAN.LT.1.E-04) GO TO 400 368.
374     X=0.5+(0.5-COSZ)*ZOCSRA 369.
375     BOCVIS=BVH2O(WMAG) 370.
376     XOCVIS=XVH2O(WMAG,X) 371.
377     BOCNIR=BOCVIS 372.
378     XOCNIR=XOCVIS 373.
379     C 374.
380     X=1./(1.+WMAG) 375.
381     AV=(-.0147087*X*X+.0292266*X-.0081079)*EOCTRA 376.
382     BV=(1.01673-0.0083652*WMAG)*EOCTRA 377.
383     C 378.
384     ITOC=TGO 379.
385     WTOC=TGO-ITOC 380.
386     ITOC=ITOC-IT0 381.
387     BOCSUM=0. 382.
388     BOCM=0. 383.
389     BOCP=0. 384.
390     C 385.
391     DO 310 K=1,NKTR 386.
392     TRAPOC=AV+BV*AOCEAN(K) 387.
393     BOCM1 =(PLANCK(ITOC-1)-(PLANCK(ITOC-1)-PLANCK(ITOC ))*WTOC) 388.
394     + *(1.-TRAPOC) 389.
395     BOCM =BOCM+BOCM1 390.
396     BOCP1 =(PLANCK(ITOC+1)-(PLANCK(ITOC+1)-PLANCK(ITOC+2))*WTOC) 391.
397     + *(1.-TRAPOC) 392.
398     BOCP =BOCP+BOCP1 393.
399     BOC =(PLANCK(ITOC )-(PLANCK(ITOC )-PLANCK(ITOC+1))*WTOC) 394.
400     + *(1.-TRAPOC) 395.
401     BOCSUM=BOCSUM+BOC 396.
402     ITOC=ITOC+ITNEXT 397.
403     C 398.
404     TRGALB(K)=TRGALB(K)+POCEAN*TRAPOC 399.
405     BGFEMD(K)=BGFEMD(K)+POCEAN*(BOCP1-BOCM1) 400.
406     310 BGFEMT(K)=BGFEMT(K)+POCEAN*BOC 401.
407     DTRUFG(1)=0.5*(BOCP-BOCM) 402.
408     C ----------------------------- 403.
409     C SOIL/VEG ALBEDO SPECIFICATION 404.
410     C ----------------------------- 405.
411     400 DSFRAC=PVT(1) 406.
412     VGFRAC=1.-DSFRAC 407.
413     IF(PEARTH.LT.1.E-04) GO TO 500 408.
414     IF(SNOWE .GT.1.E-04) GO TO 420 409.
415     C 410.
416     BEAVIS=PVT(1)*ALVISD(1+LATHEM)*(1.0-0.5*WEARTH*WETSRA) 411.
417     BEANIR=PVT(1)*ALNIRD(1+LATHEM)*(1.0-0.5*WEARTH*WETSRA) 412.
418     DO 410 K=2,NV 413.
419     BEAVIS=BEAVIS+PVT(K)*ALVISD(K+LATHEM) 414.
420     410 BEANIR=BEANIR+PVT(K)*ALNIRD(K+LATHEM) 415.
421     GO TO 440 416.
422     420 VTFRAC=PVT(1)*EXP(-SNOWE/VTMASK(1)) 417.
423     EXPSNE=VTFRAC 418.
424     DSFRAC=VTFRAC 419.
425     C$ BEAVIS=VTFRAC*ALVISD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 420.
426     BEAVIS=PVT(1)*ALVISD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 421.
427     + *(1.-VTFRAC) 422.
428     C$ BEANIR=VTFRAC*ALNIRD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 423.
429     BEANIR=PVT(1)*ALNIRD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 424.
430     + *(1.-VTFRAC) 425.
431     DO 430 K=2,NV 426.
432     VTFRAC=PVT(K)*EXP(-SNOWE/VTMASK(K)) 427.
433     BEAVIS=BEAVIS+PVT(K)*ALVISD(K+LATHEM)*(1.-VTFRAC) 428.
434     C$ BEAVIS=BEAVIS+VTFRAC*ALVISD(K+LATHEM) *******************CORRECT 429.
435     BEANIR=BEANIR+PVT(K)*ALNIRD(K+LATHEM)*(1.-VTFRAC) 430.
436     C$ BEANIR=BEANIR+VTFRAC*ALNIRD(K+LATHEM) *******************CORRECT 431.
437     430 EXPSNE=EXPSNE+VTFRAC 432.
438     C 433.
439     440 XEAVIS=BEAVIS 434.
440     XEANIR=BEANIR 435.
441     C$ BEAVIS=BEAVIS+BSNVIS*(1.-EXPSNE) 436.
442     C$ BEANIR=BEANIR+BSNNIR*(1.-EXPSNE) 437.
443     C$ XEAVIS=XEAVIS+XSNVIS*(1.-EXPSNE) 438.
444     C$ XEANIR=XEANIR+XSNNIR*(1.-EXPSNE) 439.
445     BEAVIS=BEAVIS*EXPSNE+BSNVIS*(1.-EXPSNE) 440.
446     BEANIR=BEANIR*EXPSNE+BSNNIR*(1.-EXPSNE) 441.
447     XEAVIS=XEAVIS*EXPSNE+XSNVIS*(1.-EXPSNE) 442.
448     XEANIR=XEANIR*EXPSNE+XSNNIR*(1.-EXPSNE) 443.
449     VGFRAC=EXPSNE-DSFRAC 444.
450    
451     #if ( defined CLM )
452     c if(ncallclm.ge.1)then
453 jscott 1.2 i=1
454     BEAVIS=0.7*asdirclm(i,JLAT)+0.3*asdifclm(i,JLAT)
455     BEANIR=0.7*aldirclm(i,JLAT)+0.3*aldifclm(i,JLAT)
456 jscott 1.1 XEAVIS=BEAVIS
457     XEANIR=BEANIR
458     c endif
459     c if(ncallclm.eq.0)then
460     c print *,JLAT,BEAVIS,BEANIR
461     c endif
462     #endif
463    
464     C 445.
465     ITEA=TGE 446.
466     WTEA=TGE-ITEA 447.
467     ITEA=ITEA-IT0 448.
468     BEASUM=0. 449.
469     BEAM=0. 450.
470     BEAP=0. 451.
471     C 452.
472     C 467.
473     DO 450 K=1,NKTR 453.
474     TRAPEA=AGSIDV(K,1)*(1.-EXPSNE) 454.
475     + +AGSIDV(K,3)*DSFRAC*(1.-WETTRA*WEARTH) 455.
476     + +AGSIDV(K,4)*VGFRAC 456.
477     BEAM1 =(PLANCK(ITEA-1)-(PLANCK(ITEA-1)-PLANCK(ITEA ))*WTEA) 457.
478     + *(1.-TRAPEA) 458.
479     BEAM =BEAM+BEAM1 459.
480     BEAP1 =(PLANCK(ITEA+1)-(PLANCK(ITEA+1)-PLANCK(ITEA+2))*WTEA) 460.
481     + *(1.-TRAPEA) 461.
482     BEAP =BEAP+BEAP1 462.
483     BEA =(PLANCK(ITEA )-(PLANCK(ITEA )-PLANCK(ITEA+1))*WTEA) 463.
484     + *(1.-TRAPEA) 464.
485     BEASUM=BEASUM+BEA 465.
486     ITEA=ITEA+ITNEXT 466.
487     TRGALB(K)=TRGALB(K)+PEARTH*TRAPEA 468.
488     BGFEMD(K)=BGFEMD(K)+PEARTH*(BEAP1-BEAM1) 469.
489     450 BGFEMT(K)=BGFEMT(K)+PEARTH*BEA 470.
490     DTRUFG(2)=0.5*(BEAP-BEAM) 471.
491     if(ncallclm.eq.-1)then
492     print *,'471 JLAT=',JLAT
493     print *,(ITEA-1),(ITEA),(ITEA+1)
494     print *,PLANCK(ITEA-1),PLANCK(ITEA),PLANCK(ITEA+1)
495     print *,' VGFRAC=',VGFRAC,' DSFRAC=',DSFRAC
496     print *,' WTEA=',WTEA,' WEARTH=',WEARTH
497     print *,' SNOWE=',SNOWE,' EXPSNE=',EXPSNE
498     c print *,JLAT,' BEAVIS=',BEAVIS,' BEANIR=',BEANIR
499     endif
500     C 472.
501     C ------------------------------ 473.
502     C OCEAN ICE ALBEDO SPECIFICATION 474.
503     C ------------------------------ 475.
504     500 CONTINUE 476.
505     IF(POICE.LT.1.E-04) GO TO 600 477.
506     EXPSNO=EXP(-SNOWOI/DMOICE) 478.
507     BOIVIS=AOIVIS*EXPSNO+BSNVIS*(1.-EXPSNO) 479.
508     BOINIR=AOINIR*EXPSNO+BSNNIR*(1.-EXPSNO) 480.
509 jscott 1.3 Cnext lines - use albedos from ice model
510     #if ( defined OCEAN_3D )
511     BOIVIS=mmsAlb(JLAT)
512     BOINIR=mmsAlbNIR(JLAT)
513     #endif
514 jscott 1.1 XOIVIS=BOIVIS 481.
515     XOINIR=BOINIR 482.
516     C 483.
517     ITOI=TGOI 484.
518     WTOI=TGOI-ITOI 485.
519     ITOI=ITOI-IT0 486.
520     BOISUM=0. 487.
521     BOIM=0. 488.
522     BOIP=0. 489.
523     C 490.
524     DO 510 K=1,NKTR 491.
525     TRAPOI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNO) 492.
526     + +AGSIDV(K,2)*EICTRA*EXPSNO 493.
527     BOIM1 =(PLANCK(ITOI-1)-(PLANCK(ITOI-1)-PLANCK(ITOI ))*WTOI) 494.
528     + *(1.-TRAPOI) 495.
529     BOIM =BOIM+BOIM1 496.
530     BOIP1 =(PLANCK(ITOI+1)-(PLANCK(ITOI+1)-PLANCK(ITOI+2))*WTOI) 497.
531     + *(1.-TRAPOI) 498.
532     BOIP =BOIP+BOIP1 499.
533     BOI =(PLANCK(ITOI )-(PLANCK(ITOI )-PLANCK(ITOI+1))*WTOI) 500.
534     + *(1.-TRAPOI) 501.
535     BOISUM=BOISUM+BOI 502.
536     ITOI=ITOI+ITNEXT 503.
537     C 504.
538     TRGALB(K)=TRGALB(K)+POICE*TRAPOI 505.
539     BGFEMD(K)=BGFEMD(K)+POICE*(BOIP1-BOIM1) 506.
540     510 BGFEMT(K)=BGFEMT(K)+POICE*BOI 507.
541     DTRUFG(3)=0.5*(BOIP-BOIM) 508.
542     C 509.
543     C ----------------------------- 510.
544     C LAND ICE ALBEDO SPECIFICATION 511.
545     C ----------------------------- 512.
546     600 CONTINUE 513.
547     IF(PLICE.LT.1.E-04) GO TO 700 514.
548     EXPSNL=EXP(-SNOWLI/DMLICE) 515.
549     BLIVIS=ALIVIS*EXPSNL+BSNVIS*(1.-EXPSNL) 516.
550     BLINIR=ALINIR*EXPSNL+BSNNIR*(1.-EXPSNL) 517.
551    
552     #if ( defined CLM )
553     c if(ncallclm.ge.1)then
554 jscott 1.2 i=1
555     BLIVIS=0.7*asdirclm(i,JLAT)+0.3*asdifclm(i,JLAT)
556     BLINIR=0.7*aldirclm(i,JLAT)+0.3*aldifclm(i,JLAT)
557 jscott 1.1 c endif
558     #endif
559    
560     XLIVIS=BLIVIS 518.
561     XLINIR=BLINIR 519.
562     C 520.
563     ITLI=TGLI 521.
564     WTLI=TGLI-ITLI 522.
565     ITLI=ITLI-IT0 523.
566     C 524.
567     BLISUM=0. 525.
568     BLIM=0. 526.
569     BLIP=0. 527.
570     BGF=0. 528.
571     C 529.
572     DO 610 K=1,NKTR 530.
573     TRAPLI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNL) 531.
574     + +AGSIDV(K,2)*EICTRA*EXPSNL 532.
575     BLIM1 =(PLANCK(ITLI-1)-(PLANCK(ITLI-1)-PLANCK(ITLI ))*WTLI) 533.
576     + *(1.-TRAPLI) 534.
577     BLIM =BLIM+BLIM1 535.
578     BLIP1 =(PLANCK(ITLI+1)-(PLANCK(ITLI+1)-PLANCK(ITLI+2))*WTLI) 536.
579     + *(1.-TRAPLI) 537.
580     BLIP =BLIP+BLIP1 538.
581     BLI =(PLANCK(ITLI )-(PLANCK(ITLI )-PLANCK(ITLI+1))*WTLI) 539.
582     + *(1.-TRAPLI) 540.
583     BLISUM=BLISUM+BLI 541.
584     ITLI=ITLI+ITNEXT 542.
585     C 543.
586     TRGALB(K)=TRGALB(K)+PLICE*TRAPLI 544.
587     BGFEMD(K)=BGFEMD(K)+PLICE*(BLIP1-BLIM1) 545.
588     610 BGFEMT(K)=BGFEMT(K)+PLICE*BLI 546.
589     DTRUFG(4)=0.5*(BLIP-BLIM) 547.
590     C 548.
591     700 CONTINUE 549.
592     BVSURF=POCEAN*BOCVIS +PEARTH*BEAVIS +POICE*BOIVIS +PLICE*BLIVIS 550.
593     XVSURF=POCEAN*XOCVIS +PEARTH*XEAVIS +POICE*XOIVIS +PLICE*XLIVIS 551.
594     BNSURF=POCEAN*BOCNIR +PEARTH*BEANIR +POICE*BOINIR +PLICE*BLINIR 552.
595     XNSURF=POCEAN*XOCNIR +PEARTH*XEANIR +POICE*XOINIR +PLICE*XLINIR 553.
596    
597     #if ( !defined CPL_CHEM ) && ( (defined SVI_ALBEDO || defined GHS_ALB) )
598     IF(COSZ.GE.0.01) then
599     XALBEDO=0.6*XVSURF+0.4*XNSURF
600     SECZ=1./COSZ
601     if(JLAT.le.-2)then
602     print *,' JLAT=',JLAT
603     print *,' COSZ=',COSZ
604     print*,POCEAN,PEARTH,POICE,PLICE
605     print *,' XALBEDO=',XALBEDO
606     print *,BVSURF,XVSURF,BNSURF,XNSURF
607     endif
608     BVSURF=BVSURF+BVSURFA*(1.-XALBEDO)**2*SECZ
609     XVSURF=XVSURF+XVSURFA*(1.-XALBEDO)**2*SECZ
610     BNSURF=BNSURF+BNSURFA*(1.-XALBEDO)**2*SECZ
611     XNSURF=XNSURF+XNSURFA*(1.-XALBEDO)**2*SECZ
612     if(JLAT.eq.-10)then
613     print *,' After add'
614     print *,'BVSURFA=',BVSURFA
615     print *,'DAsrf=',BVSURFA*(1.-XALBEDO)**2*SECZ
616     print *,BVSURF,XVSURF,BNSURF,XNSURF
617     endif
618     endif
619     #endif
620    
621     C ---------------------------------------------------------------- 554.
622     C SPECTRAL DISTRIBUTION ASSUMES THAT: AMEAN = 0.6*AVIS + 0.4*ANIR 555.
623     C ---------------------------------------------------------------- 556.
624     C 557.
625     IF(KEEPAL.EQ.1) GO TO 800 558.
626     SRBALB(6)=BVSURF+0.4*VISNIR*(BNSURF-BVSURF) 559.
627     SRXALB(6)=XVSURF+0.4*VISNIR*(XNSURF-XVSURF) 560.
628     DO 710 I=1,5 561.
629     SRBALB(I)=BNSURF-0.6*VISNIR*(BNSURF-BVSURF) 562.
630     710 SRXALB(I)=XNSURF-0.6*VISNIR*(XNSURF-XVSURF) 563.
631     IF(KALVIS.EQ.0) GO TO 800 564.
632     SRBALB(4)=SRBALB(6) 565.
633     SRXALB(4)=SRXALB(6) 566.
634     C 567.
635     C-------------------------------------------------------------------- 568.
636     C DEFINE SURFACE FLUX FACTORS, FLUX DERIVATIVES FOR EACH SURFTYPE 569.
637     C-------------------------------------------------------------------- 570.
638     800 BGF=0. 571.
639     DO 810 K=1,NKTR 572.
640     BGFEMD(K)=BGFEMD(K)*0.5 573.
641     810 BGF=BGF+BGFEMT(K) 574.
642     C 575.
643     BGM=BOCM*POCEAN+BEAM*PEARTH+BOIM*POICE+BLIM*PLICE 576.
644     BGP=BOCP*POCEAN+BEAP*PEARTH+BOIP*POICE+BLIP*PLICE 577.
645     TTRUFG=0.5*(BGP-BGM) 578.
646     C 579.
647     FTRUFG(1)=BOCSUM/BGF 580.
648     FTRUFG(2)=BEASUM/BGF 581.
649     FTRUFG(3)=BOISUM/BGF 582.
650     FTRUFG(4)=BLISUM/BGF 583.
651     C 584.
652     RETURN 585.
653     END 586.
654     c SUBROUTINE SETGAS 587.
655     c 20/06/2005
656     SUBROUTINE SETGAS(KTREND)
657    
658     #include "B83XX.COM" 588.
659     #include "chem_para"
660     #include "chem_com"
661    
662     EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 649.
663     EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 650.
664     C 651.
665     C 652.
666     C---------------------------------------------------------------------- 653.
667     C GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS 654.
668     C---------------------------------------------------------------------- 655.
669     C 656.
670     COMMON/O3GLOB/ PLB0(40),TLM0(40),U0GAS3(40) 656.11
671     DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 657.
672     DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 658.
673     + ,3.7338E-03/ 659.
674     DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/ 660.
675     DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 661.
676     DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 662.
677     DATA HPCON/34.16319/ 663.
678     DATA PI/3.1415926/ 664.
679     DATA P0/1013.25/ 665.
680     C 666.
681     DIMENSION KGAS(9,3) 667.
682     DATA KGAS/ 1, 2, 3, 0, 0, 9, 11, 12, 13 668.
683     + , 4, 6, 8, 0, 0,10, 0, 0, 0 669.
684     + , 5, 7, 0, 0, 0, 0, 0, 0, 0/ 670.
685     C 671.
686     C ----------------------------------------------------- 672.
687     C USE PLB TO FIX STANDARD HEIGHTS FOR GAS DISTRIBUTIONS 673.
688     C ----------------------------------------------------- 674.
689     C 675.
690     c print *,'FROM SETGAS PREDICTED_GASES=',PREDICTED_GASES
691     c 6/20/2005
692     if(KTREND.le.0)then
693     C assign background GHGs
694     PPMV58(2)=GHGBGR(1) ! CO2
695     PPMV58(6)=GHGBGR(2) ! N2O
696     PPMV58(7)=GHGBGR(3) ! CH4
697     PPMV58(8)=GHGBGR(4) ! F11
698     PPMV58(9)=GHGBGR(5) ! F12
699     endif
700     print *,'PPMV58 from SETGAS'
701     print *,PPMV58
702     NLP=NL+1 676.
703     NLMOD=NLP-LAYRAD 677.
704     PS0=PLB(1) 678.
705     PTOP=PLB(NLP-LAYRAD) 679.
706     C 680.
707     DO 100 L=1,NL 681.
708     DPL(L)=PLB(L)-PLB(L+1) 682.
709     100 PL(L)=(PLB(L)+PLB(L+1))*0.5 683.
710     NLNKTR=NL*NKTR 684.
711     C 685.
712     IF(LASTVC.GE.0) GO TO 107 686.
713     C 687.
714     DO 105 L=1,NL 688.
715     P=PLB(L) 689.
716     DO 101 N=2,8 690.
717     IF(P.GT.SPLB(N)) GO TO 102 691.
718     101 CONTINUE 691.5
719     N=9 692.
720     102 N=N-1 693.
721     IF(ABS(SDLB(N)).LT.1.E-04) GO TO 103 694.
722     H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 695.
723     GO TO 104 696.
724     C ALOG
725     103 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 697.
726     C ALOG
727     104 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 698.
728     TLB(L)=T 699.
729     105 HLB(L)=H 700.
730     ! print *,' After 105'
731     HLB(1)=1.E-10 701.
732     HLB(NL+1)=99.99 702.
733     TLB(NL+1)=STLB(8) 703.
734     DO 106 L=1,NL 704.
735     TLT(L)=TLB(L+1) 705.
736     106 TLM(L)=0.5*(TLB(L)+TLT(L)) 706.
737     TLB(NL+1)=TLT(NL) 707.
738     C 708.
739     107 NLAY=LASTVC/100000 709.
740     NATM=(LASTVC-NLAY*100000)/10000 710.
741     IF(NATM.GT.0) GO TO 112 711.
742     C 712.
743     C--------------------------------------------------------------------- 713.
744     C DEFINE GLOBAL MEAN GAS AMOUNTS FOR TRACEGAS & OVERLAP ABSORPTION 714.
745     C--------------------------------------------------------------------- 715.
746     C 716.
747     C ---------------------------- 717.
748     C GLOBAL MEAN H2O DISTRIBUTION 718.
749     C ---------------------------- 719.
750     RHP=0.77 720.
751     EST=10.0**(9.4051-2353.0/TLB(1)) 721.
752     FWB=0.662*RHP*EST/(PLB(1)-RHP*EST) 722.
753     DO 111 L=1,NL 723.
754     PLT=PLB(L+1) 724.
755     DP=PLB(L)-PLT 725.
756     RHP=0.77*(PLT/P0-0.02)/.98 726.
757     EST=10.0**(9.4051-2353.0/TLT(L)) 727.
758     FWT=0.662*RHP*EST/(PLT-RHP*EST) 728.
759     IF(FWT.GT.3.E-06) GO TO 110 729.
760     FWT=3.E-06 730.
761     RHP=FWT*PLT/(EST*(FWT+0.662)) 731.
762     110 ULGASL=0.5*(FWB+FWT)*DP*1270. 732.
763     C$110 ULGASL=0.5*(FWB+FWT)*DP*1268.75 733.
764     U0GAS(L,1)=ULGASL 734.
765     SHL(L)=ULGASL/(ULGASL+1268.75*DP) 735.
766     EQ=0.5*(PLB(L)+PLT)*SHL(L)/(0.662+0.378*SHL(L)) 736.
767     ES=10.**(9.4051-2353./TLM(L)) 737.
768     RHL(L)=EQ/ES 738.
769     111 FWB=FWT 739.
770     112 CONTINUE 740.
771     C ---------------------------- 741.
772     C GLOBAL MEAN O3 DISTRIBUTION 742.
773     C---------------- ---------------------------- 743.
774     ! print *,' Before SETO3D'
775     CALL SETO3D 744.
776     ! print *,' After SETO3D'
777     C---------------- 745.
778     JJLAT=JLAT 746.
779     C IF(JDAY.LT.1) KEEP SETATM O3 DISTRIBUTION 747.
780     C ------------------------------------------ 748.
781     IF(JDAY.LT.1) GO TO 125 749.
782     C---------------- 750.
783     ! print *,' Before O3DDAY'
784     CALL O3DDAY 751.
785     ! print *,' After O3DDAY'
786     C---------------- 752.
787     C 753.
788     DO 120 J=1,JMLAT 754.
789     RADLAT=PI*DLAT(J)/180. 755.
790     120 COSLAT(J)=0.5+0.5*SIN(RADLAT) 756.
791     C 757.
792     DO 121 N=1,NL 758.
793     121 UO3L(N)=0. 759.
794     DO 123 JLAT=1,JMLAT 760.
795     C---------------- 761.
796     ! print *,' Before O3DLAT'
797     CALL O3DLAT 762.
798     ! print *,' After O3DLAT'
799     C---------------- 763.
800     JB=JLAT+1 764.
801     JA=JLAT-1 765.
802     IF(JB.GT.JMLAT) JB=JMLAT 766.
803     IF(JA.LT.1 ) JA=1 767.
804     WTLAT=0.5*(COSLAT(JB)-COSLAT(JA)) 768.
805     DO 122 N=1,NL 769.
806     122 UO3L(N)=UO3L(N)+U0GAS(N,3)*WTLAT 770.
807     123 CONTINUE 771.
808     DO 124 N=1,NL 772.
809     124 U0GAS(N,3)=UO3L(N) 773.
810     125 JLAT=JJLAT 774.
811     ! print *,' After 774'
812     XXXX=SETAO3(OCM) 775.
813     ! print *,' After 775'
814     C 775.11
815     C SAVE GLOBAL MEAN P,T,O3 FOR UPDATING LAPGAS TAU TABLE IN SETLAP 775.12
816     C --------------------------------------------------------------- 775.13
817     C 775.14
818     DO 126 N=1,NL 775.15
819     PLB0(N)=PLB(N) 775.16
820     TLM0(N)=TLM(N) 775.17
821     126 U0GAS3(N)=U0GAS(N,3) 775.18
822     PLB0(NLP)=PLB(NLP) 775.19
823     C ---------------------------- 776.
824     C GLOBAL MEAN NO2 DISTRIBUTION 777.
825     C ---------------------------- 778.
826     ! print *,' After 778'
827     ACM=0.0 779.
828     HI=0.0 780.
829     FI=CMANO2(1) 781.
830     HL=HLB(2) 782.
831     L=1 783.
832     J=1 784.
833     130 J=J+1 785.
834     IF(J.GT.42) GO TO 133 786.
835     HJ=HI+2.0 787.
836     FJ=CMANO2(J) 788.
837     131 DH=HJ-HI 789.
838     IF(HJ.GT.HL) GO TO 132 790.
839     ACM=ACM+(FI+FJ)*DH*0.5 791.
840     HI=HJ 792.
841     FI=FJ 793.
842     GO TO 130 794.
843     132 FF=FI+(FJ-FI)*(HL-HI)/DH 795.
844     DH=HL-HI 796.
845     ACM=ACM+(FI+FJ)*DH*0.5 797.
846     U0GAS(L,5)=ACM 798.
847     ACM=0.0 799.
848     HI=HL 800.
849     FI=FF 801.
850     IF(L.EQ.NL) GO TO 133 802.
851     L=L+1 803.
852     HL=HLB(L+1) 804.
853     GO TO 131 805.
854     133 U0GAS(L,5)=ACM 806.
855     ACM=0.0 807.
856     L=L+1 808.
857     IF(L.LT.NLP) GO TO 133 809.
858     ! print *,' After 809'
859     C ----------------------------------------- 810.
860     C (CO2,O2) UNIFORMLY MIXED GAS DISTRIBUTION 811.
861     C ----------------------------------------- 812.
862     DO 141 K=2,4,2 813.
863     DO 140 N=1,NL 814.
864     140 U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 815.
865     141 CONTINUE 816.
866     C PRINT
867     print *,' CO2',PPMV58(2)
868     c print *,'NLMOD=',NLMOD
869     c print *,'PSIG'
870     c print *,(PSIG(L),L=1,NLMOD+1)
871     c print *,'PLB'
872     c print *,(PLB(L),L=1,NLMOD+1)
873     c print *,(U0GAS(n,2),n=1,nl)
874     C PRINT
875     C ----------------------------------------------------- 817.
876     C (N20,CH4,F11,F12) SPECIFIED VERTICAL GAS DISTRIBUTION 818.
877     C ----------------------------------------------------- 819.
878     DO 151 K=6,9 820.
879     DO 150 N=1,NL 821.
880     U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 822.
881     ZT=(HLB(N+1)-Z0(K))/ZH(K) 823.
882     IF(ZT.LE.0.) GO TO 150 824.
883     ZB=(HLB(N)-Z0(K))/ZH(K) 825.
884     EXPZT=EXP(-ZT) 826.
885     EXPZB=EXP(-ZB) 827.
886     IF(ZB.LT.0.) EXPZB=1.-ZB 828.
887     U0GAS(N,K)=U0GAS(N,K)*(EXPZB-EXPZT)/(ZT-ZB) 829.
888     150 CONTINUE 830.
889     151 CONTINUE 831.
890     C ------------------------------------------------ 832.
891     C SPECIFIED GAS AMOUNTS (INCLUDING SCALING FACTOR) 833.
892     C ------------------------------------------------ 834.
893     C 835.
894     DO 161 K=1,9 836.
895     DO 160 N=1,NL 837.
896     160 ULGAS(N,K)=U0GAS(N,K)*FULGAS(K) 838.
897     161 CONTINUE 839.
898     C PRINT
899     ! print *,' after 161'
900     ! print *,(ULGAS(n,2),n=1,nl)
901     C PRINT
902     C 840.
903     C------------------------------- 841.
904     CALL SETAO2(ULGAS(1,4),NL) 842.
905     C------------------------------- 843.
906     C 844.
907     C -------------------------------------------------------------- 845.
908     C OVERLAP ABSORPTION (ILGAS1,ILGAS2) FOR GLOBAL MEAN GAS AMOUNTS 846.
909     C -------------------------------------------------------------- 847.
910     DO 170 K=1,30 848.
911     170 MLGAS(K)=0 849.
912     IF(LAPGAS.LT.1) GO TO 174 850.
913     DO 172 L=1,3 851.
914     DO 171 K=ILGAS1,ILGAS2 852.
915     M=KGAS(K,L) 853.
916     IF(M.GT.3) MLGAS(M)=1 854.
917     171 CONTINUE 855.
918     172 CONTINUE 856.
919     DO 173 K=1,15 857.
920     173 MLGAS(15+K)=MLGAS(K) 858.
921     174 CONTINUE 859.
922     C 860.
923     C ---------------------------------------------------------------- 861.
924     C TAULAP=OVERLAP ABSORPTION KEPT AS INITIALIZED (NO CHANGES LATER) 862.
925     C ---------------------------------------------------------------- 863.
926     C 864.
927     DO 180 I=1,1000 865.
928     TAULAP(I)=0. 866.
929     180 TAUN(I)=0. 867.
930     C 868.
931     C-------------------------------- 869.
932     IF(LAPGAS.GT.0) CALL TAUGAS 870.
933     C-------------------------------- 871.
934     C 872.
935     DO 181 I=1,NLNKTR 873.
936     181 TAULAP(I)=TAUN(I) 874.
937     C 875.
938     C ---------------------------------------------------------- 876.
939     C MAIN GAS (IMGAS1,IMGAS2) ABSORPTION INTERPOLATED AS NEEDED 877.
940     C ---------------------------------------------------------- 878.
941     C 879.
942     DO 191 L=1,3 880.
943     DO 190 K=IMGAS1,IMGAS2 881.
944     M=KGAS(K,L) 882.
945     IF(M.GT.0) MLGAS(M)=1 883.
946     190 CONTINUE 884.
947     191 CONTINUE 885.
948     DO 192 K=1,13 886.
949     192 MLGAS(K)=MLGAS(K)*(MLGAS(K)-MLGAS(K+15)) 887.
950     IF(IMGAS1.EQ.1) MLGAS(14)=1 888.
951     IF(KWVCON.EQ.1) MLGAS(15)=1 889.
952     DO 193 K=1,30 890.
953     193 MLLAP(K)=MLGAS(K) 891.
954     C 892.
955     RETURN 893.
956     C 894.
957     C----------------------------------------------------------------------- 895.
958     C REDEFINE TAULAP TABLE: GET ABSORPTION FROM TAUGAS TABLE 896.
959     ENTRY SETLAP 897.
960     C----------------------------------------------------------------------- 898.
961     C 899.
962     IF(LAPGAS.EQ.1) RETURN 900.
963     C 901.
964     DO 200 I=1,1000 902.
965     200 TAULAP(I)=0. 903.
966     IF(LAPGAS.EQ.0) RETURN 904.
967     C 905.
968     DO 210 K=1,15 906.
969     210 MLGAS(K)=MLLAP(K+15) 907.
970     C 908.
971     DO 220 I=1,NLNKTR 909.
972     220 TAUN(I)=TAULAP(I) 910.
973     C 911.
974     DO 230 L=1,NL 912.
975     DPL(L)=PLB0(L)-PLB0(L+1) 912.11
976     PL(L)=(PLB0(L)+PLB0(L+1))*0.5 912.12
977     TLM(L)=TLM0(L) 912.13
978     U0GAS(L,3)=U0GAS3(L) 912.14
979     C 912.15
980     ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 913.
981     ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 914.
982     230 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 915.
983     C 916.
984     c
985     tropmass = 28.97296245*1.e-3*0.8/P0
986     trpm=tropmass*1.e3
987     DO 240 L=1,nlev
988     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
989    
990     #ifdef PREDICTED_GASES
991     pxxx = dpl(l)
992    
993     ULGAS(L,2)=glbgas(l,1)*tropmass/44.0098
994     & *pxxx
995     ULGAS(L,6)=glbgas(l,2)*tropmass/44.0000
996     & *pxxx
997     ULGAS(L,7)=glbgas(l,3)*tropmass/16.0426
998     & *pxxx
999     ULGAS(L,8)=glbgas(l,4)*tropmass/137.3675
1000     & *pxxx
1001     ULGAS(L,9)=glbgas(l,5)*tropmass/120.9054
1002     & *pxxx
1003     #else
1004     !
1005     !prescribed greenhouse
1006     ! gas profiles
1007     !
1008     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2) 918.
1009     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6) 920.
1010     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7) 921.
1011     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8) 922.
1012     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1013     #endif
1014     240 continue
1015     ll=nlev
1016     do 2240 l=nlev+1,NL
1017     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
1018     #ifdef PREDICTED_GASES
1019     pxxx = dpl(l)
1020    
1021     ULGAS(L,2)=glbgas(ll,1)*tropmass/44.0098
1022     & *pxxx
1023     ULGAS(L,6)=glbgas(ll,2)*tropmass/44.0000
1024     & *pxxx
1025     ULGAS(L,7)=glbgas(ll,3)*tropmass/16.0426
1026     & *pxxx
1027     ULGAS(L,8)=glbgas(ll,4)*tropmass/137.3675
1028     & *pxxx
1029     ULGAS(L,9)=glbgas(ll,5)*tropmass/120.9054
1030     & *pxxx
1031     #else
1032     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)
1033     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)
1034     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)
1035     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)
1036     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1037     #endif
1038     2240 continue
1039     C PRINT
1040     c print *,' after 240'
1041     c print *,(ULGAS(n,2),n=1,nl)
1042     C PRINT
1043     C 924.
1044     C----------------- 925.
1045     CALL TAUGAS 926.
1046     C----------------- 927.
1047     C 928.
1048     DO 250 I=1,NLNKTR 929.
1049     250 TAULAP(I)=TAUN(I) 930.
1050     C 931.
1051     DO 260 K=1,15 932.
1052     260 MLGAS(K)=MLLAP(K) 933.
1053     C 934.
1054     RETURN 935.
1055     C 936.
1056     C----------------------------------------------------------------------- 937.
1057     C SPECIFY ULGAS: GET MAINGAS ABSORPTION FROM TAUGAS TABLE 938.
1058     ENTRY GETGAS 939.
1059     C----------------------------------------------------------------------- 940.
1060     C 941.
1061     C----------------- 942.
1062     CALL O3DLON 943.
1063     C----------------- 944.
1064     C 945.
1065     DO 300 L=1,NL 946.
1066     DPL(L)=PLB(L)-PLB(L+1) 947.
1067     300 PL(L)=(PLB(L)+PLB(L+1))*0.5 948.
1068     C 949.
1069     IF(KEEPRH.EQ.1) GO TO 311 950.
1070     DO 310 L=1,NL 951.
1071     310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 952.
1072     C$310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 953.
1073     GO TO 313 954.
1074     311 CONTINUE 955.
1075     DO 312 L=1,NL 956.
1076     ES=10.0**(9.4051-2353.0/TLM(L)) 957.
1077     SHL(L)=0.622*(RHL(L)*ES)/(PL(L)-0.378*(RHL(L)*ES)) 958.
1078     312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 959.
1079     C$312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 960.
1080     313 CONTINUE 961.
1081     C 962.
1082     DO 320 I=1,NLNKTR 963.
1083     320 TAUN(I)=TAULAP(I) 964.
1084     C 965.
1085     DO 330 L=1,NL 966.
1086     ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 967.
1087     ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 968.
1088     330 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 969.
1089     C 970.
1090     PART=(PLB(1)-PTOP)/(PS0-PTOP) 971.
1091    
1092     !
1093     ! --- Chemistry model patch 080895
1094     !
1095     ! --- Note: most of the modifications in following
1096     ! sections were made originally as a part of chemistry
1097     ! module ( PREDICTED_GASES == CPL_CHEM ). However,
1098     ! they can be used by non-interactive
1099     ! chemistry-climate runs now, as far as the prescribed
1100     ! profiles of chemical species and aerosols are
1101     ! available.
1102     !
1103     ! Chien Wang
1104     ! 080100
1105     !
1106    
1107     c ===
1108     c Prescribed gaseous profiles:
1109     c
1110     c DO 340 L=1,NL 972.
1111     c IF(L.EQ.NLMOD) PART=1. 973.
1112     c ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART 974.
1113     c ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART 975.
1114     c ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART 976.
1115     c ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART 977.
1116     c ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART 978.
1117     c ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART 979.
1118     c340 continue
1119     c goto 9341
1120     c
1121     c ===
1122    
1123     !
1124     ! --- Use predicted gaseous profiles:
1125     !
1126     tropmass = 28.97296245*1.e-3*0.8/P0
1127     trpm=tropmass*1.e3
1128    
1129     !
1130     ! --- Use internal point to avoid possible unstable
1131     ! --- problem related to LBC:
1132     !
1133     jyyy = max(3, min(nlat2,JLAT))
1134     !
1135    
1136     do 2340 l=1,nlev
1137     IF(L.EQ.NLMOD) PART=1.
1138    
1139     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1140    
1141     #ifdef PREDICTED_GASES
1142     !
1143     ! --- predicted greenhouse gas profiles
1144     !
1145     pxxx = dpl(l)*part
1146    
1147     c if (JLAT.eq.12) then
1148     c print *,'zco2=',zco2(1,jlat,l)
1149     c endif
1150     ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,l))/44.0098
1151     & *pxxx*tropmass
1152     c if (JLAT.eq.12) then
1153     c print *,'l=',L,' ULGAS(L,2)=',ULGAS(L,2)
1154     c endif
1155    
1156     #ifdef O3_RAD
1157     !
1158     ! === Chien Wang 121797 then 062498 ===
1159     ! === add to use predicted ozone ===
1160     ! === in troposphere only ===
1161     if(l.le.n_tropopause)
1162     & ULGAS(L,3)=dmax1(0.0,o3(ILON,jyyy,l))/48.0
1163     & *pxxx*tropmass
1164     #endif
1165    
1166     !
1167     ! --- Chem adjustmen of N2O and CH4 concentrations
1168     !
1169     xxxo=dmax1(0.0,xn2o(ILON,jyyy,l))
1170     & *tropmass/44.0000*1.25*P0
1171     yyyo=dmax1(0.0,ch4(ILON,jyyy,l))
1172     & *tropmass/16.0426*1.25*P0
1173     call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1174    
1175     ULGAS(L,6)=xxxn*0.8*pxxx/P0
1176     ULGAS(L,7)=yyyn*0.8*pxxx/P0
1177    
1178     #ifdef INC_3GASES
1179     !
1180     ! === if hfc, pfc, and sf6 are included:
1181     !
1182     ! === 032698
1183     ! === add hfc134a, pfc and sf6 to equivilent f11:
1184     ! ===
1185     equi_cfc11 = cfc11(ILON,jyyy,l)
1186     & + hfc134a(ilon,jyyy,l)*dhfc134a_df11
1187     & + pfc (ilon,jyyy,l)*dpfmethane_df11
1188     & + sf6 (ilon,jyyy,l)*dsf6_df11
1189     #else
1190     equi_cfc11 = cfc11(ILON,jyyy,l)
1191     #endif
1192     ! ===
1193     ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1194     & *tropmass/137.3675
1195     & *pxxx
1196     ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,l))
1197     & *tropmass/120.9054
1198     & *pxxx
1199    
1200     #else
1201     !
1202     ! --- prescribed greenhouse gas profiles
1203     !
1204     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1205     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1206     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1207     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1208     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1209     #endif
1210    
1211     #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1212     C-- Added ozone forcing from external source.
1213     C-- changed 18Mar98 CEForest
1214     C NB. ozone is updated daily
1215     C o3 = ppb(m)
1216     C 48 = mol weight of o3
1217     C ULGAS = cm^3 (STP)/cm^2
1218     C
1219     C 15JAN03 CEForest
1220     C changed to use total ozone, rather than anomalies, from GISS data
1221     C
1222     pxxx = dpl(l)*part
1223     ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1224     & *pxxx*tropmass
1225     C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1226     C-- end of change 18Mar98
1227     #endif
1228    
1229     2340 continue
1230    
1231     ll=nlev
1232     do 2342 l=nlev+1,NL
1233     IF(L.EQ.NLMOD) PART=1.
1234    
1235     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1236    
1237     #ifdef PREDICTED_GASES
1238     !
1239     ! --- predicted greenhouse gas profiles
1240     !
1241     pxxx = dpl(l)*part
1242    
1243     ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,ll))
1244     & *tropmass/44.0098
1245     & *pxxx
1246     !
1247     ! --- Chem adjustmen of N2O and CH4 concentrations
1248     !
1249     xxxo=dmax1(0.0,xn2o(ILON,jyyy,ll))
1250     & *tropmass/44.0000*1.25*P0
1251     yyyo=dmax1(0.0,ch4(ILON,jyyy,ll))
1252     & *tropmass/16.0426*1.25*P0
1253     call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1254    
1255     ULGAS(L,6)=xxxn*0.8*pxxx/P0
1256     ULGAS(L,7)=yyyn*0.8*pxxx/P0
1257    
1258     #ifdef INC_3GASES
1259     !
1260     ! === if hfc, pfc, and sf6 are included:
1261     !
1262     ! === 032698
1263     ! === add hfc134a, pfc and sf6 to equivilent f11:
1264     ! ===
1265     equi_cfc11 = cfc11(ILON,jyyy,ll)
1266     & + hfc134a(ilon,jyyy,ll)*dhfc134a_df11
1267     & + pfc (ilon,jyyy,ll)*dpfmethane_df11
1268     & + sf6 (ilon,jyyy,ll)*dsf6_df11
1269     #else
1270     equi_cfc11 = cfc11(ILON,jyyy,ll)
1271     #endif
1272     ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1273     & *tropmass/137.3675
1274     & *pxxx
1275     ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,ll))
1276     & *tropmass/120.9054
1277     & *pxxx
1278     #else
1279     !
1280     ! --- prescribed greenhouse gas profiles
1281     !
1282     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1283     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1284     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1285     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1286     ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1287     #endif
1288    
1289     #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1290     C-- Added ozone forcing from external source.
1291     C-- changed 18Mar98 CEForest
1292     C NB. ozone is updated daily
1293     C o3 = ppb(m)
1294     C 48 = mol weight of o3
1295     C ULGAS = cm^3 (STP)/cm^2
1296     C
1297     C 15JAN03 CEForest
1298     C changed to use total ozone, rather than anomalies, from GISS data
1299     C
1300     C added adjustment to layers (nlev+1:nlev+3) above dynamics layers
1301     pxxx = dpl(l)*part
1302     ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1303     & *pxxx*tropmass
1304     C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1305     C-- end of change 18Mar98
1306     #endif
1307    
1308    
1309     2342 continue
1310    
1311     c
1312     c-------------------------------------------------------
1313    
1314     C----------------- 981.
1315     CALL TAUGAS 982.
1316     C----------------- 983.
1317     C 984.
1318     RETURN 985.
1319     C 986.
1320     C----------------------------------------------------------------------- 987.
1321     C IF(KGASSR.GT.0) REDEFINE ULGAS FOR SOLAR FULGAS VALUES 988.
1322     ENTRY SOLGAS 989.
1323     C----------------------------------------------------------------------- 990.
1324     C 991.
1325     C 992.
1326     DO 400 L=1,NL 993.
1327     ULGAS(L,1)=U0GAS(L,1)*FULGAS(1+9) 994.
1328     ULGAS(L,3)=U0GAS(L,3)*FULGAS(3+9) 995.
1329     400 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5+9) 996.
1330     C 997.
1331     PART=(PLB(1)-PTOP)/(PS0-PTOP) 998.
1332     DO 410 L=1,NL 999.
1333     IF(L.EQ.NLMOD) PART=1. 1000.
1334     ULGAS(L,2)=U0GAS(L,2)*FULGAS(2+9)*PART 1001.
1335     ULGAS(L,4)=U0GAS(L,4)*FULGAS(4+9)*PART 1002.
1336     ULGAS(L,6)=U0GAS(L,6)*FULGAS(6+9)*PART 1003.
1337     ULGAS(L,7)=U0GAS(L,7)*FULGAS(7+9)*PART 1004.
1338     ULGAS(L,8)=U0GAS(L,8)*FULGAS(8+9)*PART 1005.
1339     410 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9+9)*PART 1006.
1340     C 1007.
1341     C 1008.
1342     RETURN 1009.
1343     END 1010.
1344     SUBROUTINE SETAER 1011.
1345    
1346     #include "chem_para"
1347     #include "chem_com"
1348     #include "B83XX.COM" 1012.
1349    
1350     C 1073.
1351     EQUIVALENCE (FEMTRA(1),ECLTRA) 1074.
1352     EQUIVALENCE (ISPARE(2),NEWAQA) 1074.1
1353     EQUIVALENCE (ISPARE(3),NEWCQA) 1074.2
1354     C 1075.
1355     DIMENSION SRAX(40,6,5),SRAS(40,6,5),SRAC(40,6,5) 1076.
1356     C 1077.
1357     C-----------------------------------------------------------------------1078.
1358     C THERMAL: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1079.
1359     C-----------------------------------------------------------------------1080.
1360     C 1081.
1361     DO 100 J=1,NGOLDH 1082.
1362     DO 100 K=1,NKTR 1083.
1363     DO 100 L=1,NL 1084.
1364     100 TRAX(L,K,J)=0. 1085.
1365     C 1086.
1366     DO 103 I=1,NAERO 1087.
1367     DO 103 J=1,NGOLDH 1088.
1368     IF(AGOLDH(I,J).LT.1.E-06) GO TO 103 1089.
1369     C=CGOLDH(I,J) 1090.
1370     BC=EXP(-BGOLDH(I,J)/C) 1091.
1371     ABC=AGOLDH(I,J)*(1.0+BC) 1092.
1372     C 1093.
1373     DO 102 L=1,NL 1094.
1374     C AMIN
1375     ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1376     + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1377     C AMIN
1378     DO 101 K=1,NKTR 1097.
1379     TRANEW=TRACOS(K,I) 1097.5
1380     IF(NEWAQA.GT.0) TRANEW=1.0 1097.6
1381     101 TRAX(L,K,J)=TRAX(L,K,J)+ABCD*(TRAQEX(K,I)-TRANEW*TRAQSC(K,I)) 1098.
1382     102 CONTINUE 1099.
1383     103 CONTINUE 1100.
1384     C 1101.
1385     DO 104 J=1,2 1102.
1386     DO 104 K=1,NKTR 1103.
1387     TRCNEW=TRCCOS(K,J) 1103.5
1388     IF(NEWCQA.GT.0) TRCNEW=1.0 1103.6
1389     104 TRCX(K,J)=TRCQEX(K,J)-TRCNEW*TRCQSC(K,J) 1104.
1390     C 1105.
1391     C-----------------------------------------------------------------------1106.
1392     C SOLAR: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1107.
1393     C-----------------------------------------------------------------------1108.
1394     C 1109.
1395     DO 110 J=1,NGOLDH 1110.
1396     DO 110 K=1,NKSR 1111.
1397     DO 110 L=1,NL 1112.
1398     SRAX(L,K,J)=1.E-30 1113.
1399     SRAS(L,K,J)=1.E-31 1114.
1400     110 SRAC(L,K,J)=0. 1115.
1401     C 1116.
1402     DO 113 I=1,NAERO 1117.
1403     DO 113 J=1,NGOLDH 1118.
1404     IF(AGOLDH(I,J).LT.1.E-06) GO TO 113 1119.
1405     C=CGOLDH(I,J) 1120.
1406     BC=EXP(-BGOLDH(I,J)/C) 1121.
1407     ABC=AGOLDH(I,J)*(1.0+BC) 1122.
1408     C 1123.
1409     DO 112 L=1,NL 1124.
1410     C AMIN
1411     ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1412     + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1413     C AMIN
1414     DO 111 K=1,NKSR 1127.
1415     SRAX(L,K,J)=SRAX(L,K,J)+ABCD*SRAQEX(K,I) 1128.
1416     SRAS(L,K,J)=SRAS(L,K,J)+ABCD*SRAQSC(K,I) 1129.
1417     111 SRAC(L,K,J)=SRAC(L,K,J)+ABCD*SRACOS(K,I)*SRAQSC(K,I) 1130.
1418     112 CONTINUE 1131.
1419     113 CONTINUE 1132.
1420     C 1133.
1421     DO 114 J=1,NGOLDH 1134.
1422     DO 114 K=1,NKSR 1135.
1423     DO 114 L=1,NL 1136.
1424     114 SRAC(L,K,J)=SRAC(L,K,J)/SRAS(L,K,J) 1137.
1425     C 1138.
1426     C----------------- 1139.
1427     ENTRY GETAER 1140.
1428     C----------------- 1141.
1429     C 1142.
1430     C-----------------------------------------------------------------------1143.
1431     C GET CLOUD & AEROSOL AMOUNTS & DISTRIBUTIONS1144.
1432     C-----------------------------------------------------------------------1145.
1433     LBOTCL=0 1146.
1434     LTOPCL=0 1147.
1435     DO 203 L=1,NL 1148.
1436     KCLD=1 1149.
1437     IF(TLM(L).LT.TKCICE) KCLD=2 1150.
1438     IF(CLDTAU(NLP-L).GT.0.1) LTOPCL=NLP-L 1151.
1439     C$ IF(CLDTAU(NLP-L).GT.0.1) LBOTCL=NLP-L *******************CORRECT1152.
1440     IF(CLDTAU( L).GT.0.1) LBOTCL=L 1153.
1441     C$ IF(CLDTAU( L).GT.0.1) LTOPCL=L ***********************CORRECT1154.
1442     C (THERMAL) 1155.
1443     C --------- 1156.
1444     DO 202 K=1,NKTR 1157.
1445     SUMEXT=1.E-30 1158.
1446     DO 201 J=1,NGOLDH 1159.
1447     201 SUMEXT=SUMEXT+FGOLDH(J)*TRAX(L,K,J) 1160.
1448     TRAEXT(L,K)=SUMEXT+CLDTAU(L)*TRCX(K,KCLD)*FCLDTR 1161.
1449     202 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+TRAEXT(L,K) 1162.
1450     203 CONTINUE 1163.
1451     C 1164.
1452     C-----------------------------------------------------------------------1165.
1453     C CLOUD ALBEDO & SURFACE LAYER FOG SPECIFICATION1166.
1454     C-----------------------------------------------------------------------1167.
1455     C 1168.
1456     DO 204 K=1,NKTR 1169.
1457     204 FTAUSL(K)=FOGTSL*TRCX(K,1)*FCLDTR 1170.
1458     IF(LTOPCL.GT.0) GO TO 206 1171.
1459     DO 205 K=1,NKTR 1172.
1460     205 TRCALB(K)=0. 1173.
1461     GO TO 210 1174.
1462     206 KCLD=1 1175.
1463     IF(TLM(LTOPCL).LT.TKCICE) KCLD=2 1176.
1464     DO 207 K=1,NKTR 1177.
1465     207 TRCALB(K)=(1.0-EXP(-CLDTAU(LTOPCL)*TRCX(K,KCLD)))*CLDALB(K,KCLD) 1178.
1466     + *ECLTRA*FCLDTR 1179.
1467     210 CONTINUE 1180.
1468     C (SOLAR) 1181.
1469     C ------- 1182.
1470     KSR=9*KAERSR 1183.
1471     DO 9212 K=1,NKSR 1184.
1472     DO 212 L=1,NL 1185.
1473     EXTSUM=1.E-30 1186.
1474     SCTSUM=1.E-31 1187.
1475     COSSUM=0. 1188.
1476     DO 211 J=1,NGOLDH 1189.
1477     EXTSUM=EXTSUM+FGOLDH(J+KSR)*SRAX(L,K,J) 1190.
1478     SCTSUM=SCTSUM+FGOLDH(J+KSR)*SRAS(L,K,J) 1191.
1479     211 COSSUM=COSSUM+FGOLDH(J+KSR)*SRAS(L,K,J)*SRAC(L,K,J) 1192.
1480    
1481     #if ( defined PREDICTED_BC || defined PREDICTED_AEROSOL)
1482     !
1483     ! --- Chemistry model patch, 092901
1484     !
1485     ! === Chien Wang
1486     ! === (1) add to type 3 aerosol with
1487     ! === chemistry model predicted S(VI);
1488     ! === (2) add type 11 aerosol with
1489     ! === chemistry model predicted bcarbon
1490     ! ===
1491     if ( L .le. nlev1 ) then
1492     !
1493     ! === add as global aerosol
1494     ! Note: if needed the AGOLDH for prescribed
1495     ! tropospheric S(VI), SLFT1 & SLFT2, can be
1496     ! set to zero in later part of the code
1497     !
1498     ! FAERSOL/svi_intensity is added for using
1499     ! FAERSOL to switch between diagnostic/prognostic loops
1500     ! while normalize it to 1 in prognostic loop
1501     ! FBC added for black carbon 7/22/04
1502     !
1503     dsviod = 0.0
1504     dbcod = 0.0
1505    
1506     #if ( defined PREDICTED_AEROSOL )
1507     dsviod = max(0.0,
1508     & (sviod(1,jlat,L) - sviod(1,jlat,L+1))
1509     & *FAERSOL )
1510     #endif
1511    
1512     #if ( defined PREDICTED_BC)
1513     dbcod = max(0.0,
1514     & (bcod(1,jlat,L) - bcod(1,jlat,L+1))
1515     & *FBC )
1516     #endif
1517    
1518     EXTSUM = EXTSUM
1519     & + dsviod*SRAQEX(K,3)
1520     & + dbcod*SRAQEX(K,11)
1521     SCTSUM = SCTSUM
1522     & + dsviod*SRAQSC(K,3)
1523     & + dbcod*SRAQSC(K,11)
1524     COSSUM = COSSUM
1525     & + dsviod*SRAQSC(K,3)*SRACOS(K,3)
1526     & + dbcod*SRAQSC(K,11)*SRACOS(K,11)
1527    
1528     if(jlat.eq.-22.or.jlat.eq.-33)then
1529     if(L.eq.1.and.k.eq.1)then
1530     print *,'From r95 jlat=',jlat,' L=',L
1531     c print *,' LATHEM=',LATHEM, ' JNORTH=',JNORTH
1532     c print *,'FAERSOL=',FAERSOL,' FBC=',FBC
1533     print *,sviod(1,jlat,L),sviod(1,jlat,L+1)
1534     c print *,dsviod,SRAQEX(K,3)
1535     print *,bcod(1,jlat,L),bcod(1,jlat,L+1)
1536     c print *,dbcod,SRAQEX(K,11)
1537     c print *,SRAQSC(K,11),SRACOS(K,11)
1538     endif
1539     endif
1540     end if
1541     #endif
1542    
1543     EXTAER(L,K)=EXTSUM 1193.
1544     SCTAER(L,K)=SCTSUM 1194.
1545     COSAER(L,K)=COSSUM/SCTSUM 1195.
1546    
1547     212 continue
1548     9212 continue
1549     c
1550     c ======================================================
1551    
1552     IF(NTRACE.GT.0) GO TO 300 1196.
1553     C 1197.
1554     C----------- 1198.
1555     RETURN 1199.
1556     C----------- 1200.
1557     C 1201.
1558     300 CONTINUE 1202.
1559     C-----------------------------------------------------------------------1203.
1560     C ADD TRACER AEROSOL THERMAL & SOLAR CONTRIBUTIONS 1204.
1561     C-----------------------------------------------------------------------1205.
1562     DO 303 JJ=1,NTRACE 1206.
1563     J=NGOLDH+JJ 1207.
1564     I=ITR(JJ) 1208.
1565     C (THERMAL) 1209.
1566     C --------- 1210.
1567     DO 302 K=1,NKTR 1211.
1568     C$ SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRACOS(K,I)*TRAQSC(K,I)) 1212.
1569     SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRAQSC(K,I)) 1212.11
1570     DO 301 L=1,NL 1213.
1571     301 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+SUMEXT*TRACER(L,JJ) 1214.
1572     302 CONTINUE 1215.
1573     303 CONTINUE 1216.
1574     C 1217.
1575     C (SOLAR) 1218.
1576     C ------- 1219.
1577     DO 305 K=1,NKSR 1220.
1578     DO 305 L=1,NL 1221.
1579     EXTSUM=EXTAER(L,K) 1222.
1580     SCTSUM=SCTAER(L,K) 1223.
1581     COSSUM=COSAER(L,K)*SCTAER(L,K) 1224.
1582     DO 304 JJ=1,NTRACE 1225.
1583     J=NGOLDH+JJ 1226.
1584     I=ITR(JJ) 1227.
1585     EXTSUM=EXTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQEX(K,I) 1228.
1586     SCTSUM=SCTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I) 1229.
1587     304 COSSUM=COSSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I)*SRACOS(K,I) 1230.
1588     EXTAER(L,K)=EXTSUM 1231.
1589     SCTAER(L,K)=SCTSUM 1232.
1590     305 COSAER(L,K)=COSSUM/SCTSUM 1233.
1591     RETURN 1234.
1592     END 1235.
1593     SUBROUTINE TAUGAS 1236.
1594    
1595     #include "B83XX.COM"
1596    
1597     C TAUGAS INPUT REQUIRES: NL,TLM,ULGAS,TRACEG,PL,DPL,TAUTBL,MLGAS 1295.11
1598     C TAUGAS OUTPUT DATA IS: TAUN 1295.12
1599     C 1296.
1600     DIMENSION IGASX(11),KGX(11),NUX(11),IGUX(11),NGX(3),IG1X(3) 1297.
1601     DIMENSION ULOX(165),DUX(165),PX(15),H2OCON(25) 1298.
1602     C 1299.
1603     DATA NTX/8/, TLOX/181./,DTX/23./ 1300.
1604     DATA NPX/15/, PX/1000., 975., 910., 800., 645., 1301.
1605     * 480., 330., 205., 110., 40., 1302.
1606     * 7.5, 3.5, 1.0, 0.1, .001/ 1303.
1607     C 1304.
1608     DATA NGUX/652/, NPUX/15/ 1305.
1609     DATA NGX/10,10,04/, IG1X/2,12,22/ 1306.
1610     DATA 1307.
1611     * IGASX/ 1, 2, 3, 1, 1, 2, 2, 3, 6, 6, 7/, 1308.
1612     * KGX/ 1, 2, 3, 2, 3, 1, 3, 2, 1, 2, 1/, 1309.
1613     * NUX/ 25, 9, 9, 9, 9, 5, 5, 5, 1, 1, 1/, 1310.
1614     * IGUX/ 0,250,340,376,466,502,552,572,622,632,642/ 1311.
1615     C 1312.
1616     C 1313.
1617     DATA ULOX/ .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1,.10E+1, 1314.
1618     *.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1315.
1619     *.50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+1,.10E+2,.80E+1, 1316.
1620     *.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3, 1317.
1621     *.40E-3,.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2, 1318.
1622     *.40E-2,.10E-4,.80E-7,.40E-7, .25E+2,.25E+2,.50E+2,.50E+2, 1319.
1623     *.25E+2,.50E+1,.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3, 1320.
1624     *.10E-5,.10E-5, .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1, 1321.
1625     *.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1322.
1626     * .50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2, 1323.
1627     *.80E+1,.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .50E+1, 1324.
1628     *.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2,.80E+1,.10E+1, 1325.
1629     *.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3,.40E-3, 1326.
1630     *.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2,.40E-2, 1327.
1631     *.10E-4,.80E-7,.40E-7, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1, 1328.
1632     *.35E-1,.31E-1,.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4, 1329.
1633     *.44E-6, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1,.35E-1,.31E-1, 1330.
1634     *.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4,.44E-6, 1331.
1635     *.64E-1,.64E-1,.10E+0,.18E+0,.22E+0,.20E+0,.18E+0,.14E+0,.10E+0, 1332.
1636     *.77E-1,.64E-2,.38E-2,.26E-2,.26E-3,.26E-5/ 1333.
1637     C 1334.
1638     DATA DUX/ .75E+2,.75E+2,.10E+3,.10E+3,.75E+2,.50E+2,.10E+2, 1335.
1639     *.20E+1,.20E+0,.10E+0,.50E-1,.10E-1,.40E-2,.40E-3,.40E-4, 1336.
1640     *.50E+1,.50E+1,.80E+1,.10E+2,.10E+2,.10E+2,.10E+2,.10E+2,.80E+1, 1337.
1641     *.50E+1,.35E+1,.25E+0,.25E+0,.10E+0,.10E-1, .30E-3,.30E-3, 1338.
1642     *.50E-3,.80E-3,.10E-2,.16E-2,.64E-2,.16E-2,.25E-1,.25E-1,.25E-1, 1339.
1643     *.45E-2,.25E-2,.10E-2,.25E-4, .24E+3,.24E+3,.30E+3,.30E+3, 1340.
1644     *.24E+3,.15E+3,.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1, 1341.
1645     *.12E-2,.12E-3, .24E+3,.24E+3,.30E+3,.30E+3,.24E+3,.15E+3, 1342.
1646     *.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1,.12E-2,.12E-3, 1343.
1647     * .10E+2,.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2, 1344.
1648     *.16E+2,.10E+2,.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .10E+2, 1345.
1649     *.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2,.16E+2,.10E+2, 1346.
1650     *.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .60E-3,.60E-3,.10E-2, 1347.
1651     *.16E-2,.20E-2,.32E-2,.13E-1,.32E-1,.50E-1,.50E-1,.50E-1,.90E-2, 1348.
1652     *.50E-2,.20E-2,.50E-4, 45*0./ 1349.
1653     C 1350.
1654     DATA H2OCON/ .767116, .322401, .572299,.58537, .48869, 1351.
1655     * .43539, .44322, .64072, .89293, 1.12733,1.65550, .865210, 1352.
1656     * 1.38403,1.80159,1.99196, 2.03403, 2.20561,2.42859,2.56883, 1353.
1657     * 2.67157,2.71888, .45534, .44735, .44534, .44365/ 1354.
1658     C 1355.
1659     C-------------------------------------------------------------------- 1356.
1660     C ABSORPTION (TAU) INTERPOLATION FOR GAS AMOUNTS IN ULGAS(N,K) 1357.
1661     C-------------------------------------------------------------------- 1358.
1662     C 1359.
1663     IPX=2 1360.
1664     DO 100 IP=1,NL 1361.
1665     C 1362.
1666     20 WPB = (PL(IP)-PX(IPX))/(PX(IPX-1)-PX(IPX)) 1363.
1667     IF(WPB.GE.0. .OR. IPX.GE.NPX) GO TO 30 1364.
1668     IPX = IPX+1 1365.
1669     GO TO 20 1366.
1670     C 1367.
1671     30 WTB = (TLM(IP)-TLOX)/DTX 1368.
1672     ITX = MIN0(MAX0(INT(WTB),0),NTX-2) 1369.
1673     WTB = WTB-FLOAT(ITX) 1370.
1674     C 1371.
1675     WBB = WPB*WTB 1372.
1676     WBA = WPB-WBB 1373.
1677     WAB = WTB-WBB 1374.
1678     WAA = 1.-(WBB+WBA+WAB) 1375.
1679     C 1376.
1680     IAA = NGUX*(ITX+NTX*(IPX-1)) 1377.
1681     IBA = IAA-NGUX*NTX 1378.
1682     C 1379.
1683     DO 90 IGAS=1,11 1380.
1684     IF(MLGAS(IGAS).LT.1) GO TO 90 1381.
1685     C 1382.
1686     UGAS = ULGAS(IP,IGASX(IGAS)) 1383.
1687     IF(UGAS.LT.1.E-10) GO TO 90 1384.
1688     C 1385.
1689     IU = IPX + NPUX*(IGAS-1) 1386.
1690     NU = NUX(IGAS) 1387.
1691     IF(NU.GT.1) GO TO 40 1388.
1692     XUA = 0. 1389.
1693     XUB = 0. 1390.
1694     GO TO 50 1391.
1695     40 XUA = (UGAS-ULOX(IU))/DUX(IU) 1392.
1696     XUB = (UGAS-ULOX(IU-1))/DUX(IU-1) 1393.
1697     50 IUA = INT(XUA) 1394.
1698     IUB = INT(XUB) 1395.
1699     C 1396.
1700     QAA = 1. 1397.
1701     QAB = 1. 1398.
1702     IF(XUA.GT.0. .AND. IUA.LT.NU-1) GO TO 60 1399.
1703     c XUA = DMIN1(DMAX1(XUA,0.),FLOAT(NU-1)) 1400.
1704     XUA = DMIN1(DMAX1(XUA,0.),dble(NU-1)) 1400.
1705     IUA = MIN0(INT(XUA),NU-2) 1401.
1706     QAA = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA)) 1402.
1707     QAB = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA+1)) 1403.
1708     C 1404.
1709     60 QBA = 1. 1405.
1710     QBB = 1. 1406.
1711     IF(XUB.GT.0. .AND. IUB.LT.NU-1) GO TO 70 1407.
1712     c XUB = DMIN1(DMAX1(XUB,0.),FLOAT(NU-1)) 1408.
1713     XUB = DMIN1(DMAX1(XUB,0.),dble(NU-1)) 1408.
1714     IUB = MIN0(INT(XUB),NU-2) 1409.
1715     QBA = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB)) 1410.
1716     QBB = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB+1)) 1411.
1717     C 1412.
1718     70 UAB = XUA-FLOAT(IUA) 1413.
1719     UBB = XUB-FLOAT(IUB) 1414.
1720     UAA = 1.-UAB 1415.
1721     UBA = 1.-UBB 1416.
1722     C 1417.
1723     C 1418.
1724     WAAA = WAA*UAA*QAA 1419.
1725     WAAB = WAA*UAB*QAB 1420.
1726     WABA = WAB*UAA*QAA 1421.
1727     WABB = WAB*UAB*QAB 1422.
1728     WBAA = WBA*UBA*QBA 1423.
1729     WBAB = WBA*UBB*QBB 1424.
1730     WBBA = WBB*UBA*QBA 1425.
1731     WBBB = WBB*UBB*QBB 1426.
1732     C 1427.
1733     NG = NGX(KGX(IGAS)) 1428.
1734     IAAA = IAA+IGUX(IGAS) + NG*IUA 1429.
1735     IAAB = IAAA+NG 1430.
1736     IABA = IAAA+NGUX 1431.
1737     IABB = IABA+NG 1432.
1738     IBAA = IBA+IGUX(IGAS) + NG*IUB 1433.
1739     IBAB = IBAA+NG 1434.
1740     IBBA = IBAA+NGUX 1435.
1741     IBBB = IBBA+NG 1436.
1742     C 1437.
1743     C 1438.
1744     IPG = IP+NL*(IG1X(KGX(IGAS))-1) 1439.
1745     DO 80 IG=1,NG 1440.
1746     TAUN(IPG) = TAUN(IPG) 1441.
1747     * + WAAA*TAUTBL(IAAA+IG) 1442.
1748     * + WAAB*TAUTBL(IAAB+IG) 1443.
1749     * + WABA*TAUTBL(IABA+IG) 1444.
1750     * + WABB*TAUTBL(IABB+IG) 1445.
1751     * + WBAA*TAUTBL(IBAA+IG) 1446.
1752     * + WBAB*TAUTBL(IBAB+IG) 1447.
1753     * + WBBA*TAUTBL(IBBA+IG) 1448.
1754     * + WBBB*TAUTBL(IBBB+IG) 1449.
1755     80 IPG = IPG+NL 1450.
1756     90 CONTINUE 1451.
1757     100 CONTINUE 1452.
1758     C 1453.
1759     IF(MLGAS(12).LT.1) GO TO 110 1454.
1760     C------------------------------------------------------------------- 1455.
1761     C PICK UP CCL3F1 (F11) ABSORPTION 1456.
1762     C------------------------------------------------------------------- 1457.
1763     C 1458.
1764     DO 102 K=1,25 1459.
1765     XKPCMA=TRACEG(K,1) 1460.
1766     IF(XKPCMA.LT.1.E-10) GO TO 102 1461.
1767     DO 101 N=1,NL 1462.
1768     NK=N+(K-1)*NL 1463.
1769     101 TAUN(NK)=TAUN(NK)+ULGAS(N,8)*XKPCMA 1464.
1770     102 CONTINUE 1465.
1771     C 1466.
1772     110 IF(MLGAS(13).LT.1) GO TO 120 1467.
1773     C------------------------------------------------------------------- 1468.
1774     C PICK UP CCL2F2 (F12) ABSORPTION 1469.
1775     C------------------------------------------------------------------- 1470.
1776     C 1471.
1777     DO 112 K=1,25 1472.
1778     XKPCMA=TRACEG(K,2) 1473.
1779     IF(XKPCMA.LT.1.E-10) GO TO 112 1474.
1780     DO 111 N=1,NL 1475.
1781     NK=N+(K-1)*NL 1476.
1782     111 TAUN(NK)=TAUN(NK)+ULGAS(N,9)*XKPCMA 1477.
1783     112 CONTINUE 1478.
1784     C 1479.
1785     120 IF(MLGAS(14).LT.1) GO TO 130 1480.
1786     C------------------------------------------------------------------- 1481.
1787     C PICK UP WINDOW H2O GASEOUS ABSORPTION 1482.
1788     C------------------------------------------------------------------- 1483.
1789     C 1484.
1790     DO 121 N=1,NL 1485.
1791     TAUN(N) = TAUN(N) 1486.
1792     121 CONTINUE 1487.
1793     130 CONTINUE 1488.
1794     C------------------------------------------------------------------- 1489.
1795     C PICK UP H2O CONTINUUM ABSORPTION 1490.
1796     C------------------------------------------------------------------- 1491.
1797     C 1492.
1798     IF(MLGAS(15).LT.1) GO TO 140 1493.
1799     DO 131 N=1,NL 1494.
1800     TAUN(N) = TAUN(N) + 2.21866E-11* 1495.
1801     * PL(N)*ULGAS(N,1)*EXP(1800./TLM(N))* 1496.
1802     * (ULGAS(N,1)/DPL(N)+.808563) 1497.
1803     131 CONTINUE 1498.
1804     C 1499.
1805     C$ ********************************REMOVE FOLLOWING STATEMENT TO CORRECT1500.
1806     IF(NL.GT.0) RETURN 1501.
1807     DO 133 N=1,NL 1502.
1808     PH2O=12.38E-4*ULGAS(N,1)*PL(N)/DPL(N) 1503.
1809     TH2O=EXP(1800./TLM(N)-6.081081) 1504.
1810     COEC=PH2O*TH2O+.0015*(PL(N)-PH2O) 1505.
1811     DO 132 K=2,25 1506.
1812     COEF=H2OCON(K)*1.E-5 1507.
1813     NK=N+(K-1)*NL 1508.
1814     132 TAUN(NK)=TAUN(NK)+ULGAS(N,1)*COEC*COEF 1509.
1815     133 CONTINUE 1510.
1816     140 CONTINUE 1511.
1817     C 1512.
1818     RETURN 1513.
1819     END 1514.
1820     SUBROUTINE THERML 1515.
1821    
1822     #include "B83XX.COM"
1823     #if ( defined CLM )
1824 jscott 1.2 #include "CLM.h"
1825 jscott 1.1 #endif
1826    
1827     DATA R6,R24/.1666667,4.166667E-02/ 1577.
1828     DATA A,B,C/0.3825,0.5742,0.0433/ 1578.
1829     C 1579.
1830     C-----------------------------------------------------------------------1580.
1831     C LAYER EDGE TEMPERATURE INTERPOLATION1581.
1832     C-----------------------------------------------------------------------1582.
1833     IF(TLGRAD.LT.0.) GO TO 103 1583.
1834     TA=TLM(1) 1584.
1835     TB=TLM(2) 1585.
1836     P1=PLB(1) 1586.
1837     P2=PLB(2) 1587.
1838     P3=PLB(3) 1588.
1839     DT1CPT=0.5*TA*(EXPBYK(PLB(1))-EXPBYK(PLB(2)))/EXPBYK(PL(1)) 1589.
1840     DTHALF=(TA-TB)*(P1-P2)/(P1-P3) 1590.
1841     IF(DTHALF.GT.DT1CPT) DTHALF=DT1CPT 1591.
1842     TLB(1)=TA+DTHALF*TLGRAD 1592.
1843     TLT(1)=TA-DTHALF*TLGRAD 1593.
1844     DO 101 L=3,NL 1594.
1845     TC=TLM(L) 1595.
1846     P4=PLB(L+1) 1596.
1847     DTHALF=0.5*((TA-TB)/(P1-P3)+(TB-TC)/(P2-P4))*(P2-P3)*TLGRAD 1597.
1848     TLB(L-1)=TB+DTHALF 1598.
1849     TLT(L-1)=TB-DTHALF 1599.
1850     TA=TB 1600.
1851     TB=TC 1601.
1852     P1=P2 1602.
1853     P2=P3 1603.
1854     101 P3=P4 1604.
1855     DTHALF=(TA-TB)*(P2-P3)/(P1-P3)*TLGRAD 1605.
1856     TLB(NL)=TC+DTHALF 1606.
1857     TLT(NL)=TC-DTHALF 1607.
1858     L=NLP 1608.
1859     DO 102 N=1,NL 1609.
1860     L=L-1 1610.
1861     IF(PLB(L).GT.PTLISO) GO TO 103 1611.
1862     TLT(L)=TLM(L) 1612.
1863     102 TLB(L)=TLM(L) 1613.
1864     103 CONTINUE 1614.
1865     C-----------------------------------------------------------------------1615.
1866     C WEIGHT ASSIGNMENTS FOR PLANCK FUNCTION INTERPOLATION1616.
1867     C-----------------------------------------------------------------------1617.
1868     DO 104 L=1,NL 1618.
1869     ITL=TLB(L) 1619.
1870     WTLB(L)=TLB(L)-ITL 1620.
1871     ITLB(L)=ITL-IT0 1621.
1872     ITL=TLT(L) 1622.
1873     WTLT(L)=TLT(L)-ITL 1623.
1874     104 ITLT(L)=ITL-IT0 1624.
1875     ITS=TSL 1625.
1876     WTS=TSL-ITS 1626.
1877     ITS=ITS-IT0 1627.
1878     C 1628.
1879     C ------------------------------------------------------------------1629.
1880     C WINDOW REGION FLUX COMPUTATION1630.
1881     C ------------------------------------------------------------------1631.
1882     C DOWNWARD FLUX1632.
1883     C ------------------------------------------------------------------1633.
1884     K=1 1634.
1885     BG=BGFEMT(K) 1635.
1886     c print *,'1635 K=',k,' PEARTH=',PEARTH
1887     c print *,'BG=',BG
1888     WTS1=1.-WTS 1636.
1889     TRSLTS=0. 1637.
1890     TRSLTG=0. 1638.
1891     TRSLWV=0. 1639.
1892     TRSLBS=0. 1640.
1893     DNA=0. 1641.
1894     DNB=0. 1642.
1895     DNC=0. 1643.
1896     NLK0=0 1644.
1897     NLK=NL 1645.
1898     TRDFLB(NLP)=0. 1646.
1899     100 TAUA=TAUN(NLK) 1647.
1900     IF(TAUA.GT.1.E-05) GO TO 120 1648.
1901     TRDFLB(NLK)=0. 1649.
1902     NLK=NLK-1 1650.
1903     IF(NLK.GT.NLK0) GO TO 100 1651.
1904     110 NLK=NLK+1 1652.
1905     TRUFLB(NLK)=BG 1653.
1906     IF(NLK.LT.NLP) GO TO 110 1654.
1907     TRUFG=BG 1655.
1908     TRDFG=0. 1656.
1909     TRUFGW=BG 1657.
1910     TRUFGW=0. 1658.
1911     TRUFTW=TRUFLB(NLP) 1659.
1912     GO TO 200 1660.
1913     120 N=NLK 1661.
1914     130 ITL=ITLT(N) 1662.
1915     BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1663.
1916     ITL=ITLB(N) 1664.
1917     BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1665.
1918     TAUA=TAUN(N) 1666.
1919     TAUB=TAUA+TAUA 1667.
1920     TAUC=10.*TAUA 1668.
1921     IF(TAUA.GT.1.E-01) GO TO 140 1669.
1922     IF(TAUA.LT.1.E-03) GO TO 135 1670.
1923     TAU2=TAUA*TAUA 1671.
1924     BDIF=BBOT-BTOP 1672.
1925     BBTA=BDIF/TAUA 1673.
1926     BBTB=BDIF/TAUB 1674.
1927     BBTC=BDIF/TAUC 1675.
1928     TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1676.
1929     GO TO 145 1677.
1930     135 BDIF=.5*(BTOP+BBOT) 1678.
1931     TRA(N)=1.-TAUA 1679.
1932     ENA(N)=BDIF*TAUA 1680.
1933     DNA=DNA*TRA(N)+ENA(N) 1681.
1934     TRB(N)=1.-TAUB 1682.
1935     ENB(N)=BDIF*TAUB 1683.
1936     DNB=DNB*TRB(N)+ENB(N) 1684.
1937     TRC(N)=1.-TAUC 1685.
1938     ENC(N)=BDIF*TAUC 1686.
1939     DNC=DNC*TRC(N)+ENC(N) 1687.
1940     GO TO 160 1688.
1941     140 BDIF=BBOT-BTOP 1689.
1942     BBTA=BDIF/TAUA 1690.
1943     BBTB=BDIF/TAUB 1691.
1944     BBTC=BDIF/TAUC 1692.
1945     IF(TAUA.GT.7.) GO TO 150 1693.
1946     TRAN=EXP(-TAUA) 1694.
1947     145 TRA(N)=TRAN 1695.
1948     ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1696.
1949     DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1697.
1950     TRBN=TRAN*TRAN 1698.
1951     TRB(N)=TRBN 1699.
1952     ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1700.
1953     DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1701.
1954     TRCN=(TRBN*TRBN*TRAN)**2 1702.
1955     TRC(N)=TRCN 1703.
1956     ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1704.
1957     DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1705.
1958     GO TO 160 1706.
1959     150 TRA(N)=0. 1707.
1960     TRB(N)=0. 1708.
1961     TRC(N)=0. 1709.
1962     ENA(N)=BTOP+BBTA 1710.
1963     ENB(N)=BTOP+BBTB 1711.
1964     ENC(N)=BTOP+BBTC 1712.
1965     DNA=BBOT-BBTA 1713.
1966     DNB=BBOT-BBTB 1714.
1967     DNC=BBOT-BBTC 1715.
1968     160 TRDFLB(N)=A*DNA+B*DNB+C*DNC 1716.
1969     N=N-1 1717.
1970     IF(N.GT.0) GO TO 130 1718.
1971     IF(LTOPCL.LT.1) GO TO 165 1719.
1972     ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1720.
1973     ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1721.
1974     ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1722.
1975     165 CONTINUE 1723.
1976     C ------------------------------------------------------------------1724.
1977     C SURFACE LAYER FLUX COMPUTATION1725.
1978     C ------------------------------------------------------------------1726.
1979     N=1 1727.
1980     TRDFG=TRDFLB(1) 1728.
1981     TAUA=TAUSL(1)+FTAUSL(1) 1729.
1982     IF(TAUA.GT.1.E-05) GO TO 170 1730.
1983     BG=BG+TRDFG*TRGALB(K) 1731.
1984     UNB=BG 1733.
1985     UNC=BG 1734.
1986     FUNABC=BG 1735.
1987     GO TO 180 1736.
1988     170 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1737.
1989     TA=EXP(-TAUA) 1738.
1990     TB=TA*TA 1739.
1991     TC=(TB*TB*TA)**2 1740.
1992     DNA=(DNA-BS)*TA+BS 1741.
1993     DNB=(DNB-BS)*TB+BS 1742.
1994     DNC=(DNC-BS)*TC+BS 1743.
1995     TRDFG=A*DNA+B*DNB+C*DNC 1744.
1996     BG=BG+TRDFG*TRGALB(K) 1745.
1997     UNA=(BG-BS)*TA+BS 1746.
1998     UNB=(BG-BS)*TB+BS 1747.
1999     UNC=(BG-BS)*TC+BS 1748.
2000     FUNABC=A*UNA+B*UNB+C*UNC 1749.
2001     BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1750.
2002     BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1751.
2003     SLABS=1.-A*TA-B*TB-C*TC 1752.
2004     TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1753.
2005     TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1754.
2006     TRSLBS=TRSLBS+BS*SLABS 1755.
2007     C ------------------------------------------------------------------1756.
2008     C UPWARD FLUX COMPUTATION1757.
2009     C ------------------------------------------------------------------1758.
2010     180 TRUFLB(N)=FUNABC 1759.
2011     IF(N.GT.NLK) GO TO 190 1760.
2012     UNA=UNA*TRA(N)+ENA(N) 1761.
2013     UNB=UNB*TRB(N)+ENB(N) 1762.
2014     UNC=UNC*TRC(N)+ENC(N) 1763.
2015     FUNABC=A*UNA+B*UNB+C*UNC 1764.
2016     190 N=N+1 1765.
2017     IF(N.LT.NLP) GO TO 180 1766.
2018     TRUFLB(N)=FUNABC 1767.
2019     TRUFTW=FUNABC 1768.
2020     TRDFGW=TRDFG 1769.
2021     TRUFGW=BG 1770.
2022     TRUFG=BG 1771.
2023     DO 195 L=1,NLP 1772.
2024     DFLB(L,1)=TRDFLB(L) 1773.
2025     195 UFLB(L,1)=TRUFLB(L) 1774.
2026     DFSL(1)=TRDFLB(1) 1775.
2027     UFSL(1)=TRUFLB(1) 1776.
2028     DFLB(1,1)=TRDFGW 1777.
2029     UFLB(1,1)=TRUFGW 1778.
2030     c print *,' 1778 TRUFLB(1)=',TRUFLB(1)
2031     C ------------------------------------------------------------------1779.
2032     C END WINDOW REGION FLUX COMPUTATION; CONTINUE INTEGRATION1780.
2033     C ------------------------------------------------------------------1781.
2034     C ------------------------------------------------------------------1782.
2035     C DOWNWARD FLUX COMPUTATION 1783.
2036     C ------------------------------------------------------------------1784.
2037     200 ITK0=K*ITNEXT 1785.
2038     K=K+1 1786.
2039     IF(K.GT.NKTR) GO TO 300 1787.
2040     DFLB(NLP,K)=0. 1788.
2041     BG=BGFEMT(K) 1789.
2042     ITS=ITS+ITNEXT 1790.
2043     NLK0=NLK0+NL 1791.
2044     NLK=NLK0+NL 1792.
2045     NLL=NL 1793.
2046     210 TAUA=TAUN(NLK) 1794.
2047     IF(TAUA.GT.1.E-05) GO TO 220 1795.
2048     DFLB(NLL,K)=0. 1796.
2049     NLK=NLK-1 1797.
2050     NLL=NLL-1 1798.
2051     IF(NLL.GT.0) GO TO 210 1799.
2052     TRUFG=TRUFG+BG 1800.
2053     DO 215 N=1,NLP 1801.
2054     UFLB(N,K)=BG 1802.
2055     215 TRUFLB(N)=TRUFLB(N)+BG 1803.
2056     GO TO 200 1804.
2057     220 N=NLL 1805.
2058     DNA=0. 1806.
2059     DNB=0. 1807.
2060     DNC=0. 1808.
2061     230 ITL=ITLT(N)+ITK0 1809.
2062     BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1810.
2063     ITL=ITLB(N)+ITK0 1811.
2064     BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1812.
2065     TAUA=TAUN(NLK) 1813.
2066     TAUB=TAUA+TAUA 1814.
2067     TAUC=10.*TAUA 1815.
2068     IF(TAUA.GT.1.E-01) GO TO 240 1816.
2069     IF(TAUA.LT.1.E-03) GO TO 235 1817.
2070     TAU2=TAUA*TAUA 1818.
2071     BDIF=BBOT-BTOP 1819.
2072     BBTA=BDIF/TAUA 1820.
2073     BBTB=BDIF/TAUB 1821.
2074     BBTC=BDIF/TAUC 1822.
2075     TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1823.
2076     GO TO 245 1824.
2077     235 BDIF=.5*(BTOP+BBOT) 1825.
2078     TRA(N)=1.-TAUA 1826.
2079     ENA(N)=BDIF*TAUA 1827.
2080     DNA=DNA*TRA(N)+ENA(N) 1828.
2081     TRB(N)=1.-TAUB 1829.
2082     ENB(N)=BDIF*TAUB 1830.
2083     DNB=DNB*TRB(N)+ENB(N) 1831.
2084     TRC(N)=1.-TAUC 1832.
2085     ENC(N)=BDIF*TAUC 1833.
2086     DNC=DNC*TRC(N)+ENC(N) 1834.
2087     GO TO 260 1835.
2088     240 BDIF=BBOT-BTOP 1836.
2089     BBTA=BDIF/TAUA 1837.
2090     BBTB=BDIF/TAUB 1838.
2091     BBTC=BDIF/TAUC 1839.
2092     IF(TAUA.GT.7.) GO TO 250 1840.
2093     TRAN=EXP(-TAUA) 1841.
2094     245 TRA(N)=TRAN 1842.
2095     ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1843.
2096     DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1844.
2097     TRBN=TRAN*TRAN 1845.
2098     TRB(N)=TRBN 1846.
2099     ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1847.
2100     DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1848.
2101     TRCN=(TRBN*TRBN*TRAN)**2 1849.
2102     TRC(N)=TRCN 1850.
2103     ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1851.
2104     DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1852.
2105     GO TO 260 1853.
2106     250 TRA(N)=0. 1854.
2107     TRB(N)=0. 1855.
2108     TRC(N)=0. 1856.
2109     ENA(N)=BTOP+BBTA 1857.
2110     ENB(N)=BTOP+BBTB 1858.
2111     ENC(N)=BTOP+BBTC 1859.
2112     DNA=BBOT-BBTA 1860.
2113     DNB=BBOT-BBTB 1861.
2114     DNC=BBOT-BBTC 1862.
2115     260 FDNABC=A*DNA+B*DNB+C*DNC 1863.
2116     TRDFLB(N)=TRDFLB(N)+FDNABC 1864.
2117     DFLB(N,K)=FDNABC 1865.
2118     N=N-1 1866.
2119     NLK=NLK-1 1867.
2120     IF(N.GT.0) GO TO 230 1868.
2121     DFSL(K)=FDNABC 1869.
2122     IF(LTOPCL.LT.1) GO TO 265 1870.
2123     ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1871.
2124     ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1872.
2125     ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1873.
2126     265 CONTINUE 1874.
2127     C ------------------------------------------------------------------1875.
2128     C SURFACE LAYER FLUX COMPUTATION1876.
2129     C ------------------------------------------------------------------1877.
2130     N=1 1878.
2131     TAUA=TAUSL(K)+FTAUSL(K) 1879.
2132     IF(TAUA.GT.1.E-05) GO TO 270 1880.
2133     BG=BG+FDNABC*TRGALB(K) 1881.
2134     UNA=BG 1882.
2135     UNB=BG 1883.
2136     UNC=BG 1884.
2137     FUNABC=BG 1885.
2138     GO TO 280 1886.
2139     270 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1887.
2140     TA=EXP(-TAUA) 1888.
2141     TB=TA*TA 1889.
2142     TC=(TB*TB*TA)**2 1890.
2143     DNA=(DNA-BS)*TA+BS 1891.
2144     DNB=(DNB-BS)*TB+BS 1892.
2145     DNC=(DNC-BS)*TC+BS 1893.
2146     FDNABC=A*DNA+B*DNB+C*DNC 1894.
2147     BG=BGFEMT(K)+FDNABC*TRGALB(K) 1895.
2148     UNA=(BG-BS)*TA+BS 1896.
2149     UNB=(BG-BS)*TB+BS 1897.
2150     UNC=(BG-BS)*TC+BS 1898.
2151     FUNABC=A*UNA+B*UNB+C*UNC 1899.
2152     BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1900.
2153     BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1901.
2154     SLABS=1.-A*TA-B*TB-C*TC 1902.
2155     TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1903.
2156     TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1904.
2157     TRSLBS=TRSLBS+BS*SLABS 1905.
2158     C ------------------------------------------------------------------1906.
2159     C UPWARD FLUX COMPUTATION1907.
2160     C ------------------------------------------------------------------1908.
2161     280 TRUFLB(N)=TRUFLB(N)+FUNABC 1909.
2162     UFLB(N,K)=FUNABC 1910.
2163     IF(N.GT.NLL) GO TO 290 1911.
2164     UNA=UNA*TRA(N)+ENA(N) 1912.
2165     UNB=UNB*TRB(N)+ENB(N) 1913.
2166     UNC=UNC*TRC(N)+ENC(N) 1914.
2167     FUNABC=A*UNA+B*UNB+C*UNC 1915.
2168     290 N=N+1 1916.
2169     IF(N.LT.NLP) GO TO 280 1917.
2170     TRUFLB(NLP)=TRUFLB(NLP)+FUNABC 1918.
2171     UFLB(NLP,K)=FUNABC 1919.
2172     UFSL(K)=UFLB(1,K) 1920.
2173     TRDFG=TRDFG+FDNABC 1921.
2174     DFLB(1,K)=FDNABC 1922.
2175     TRUFG=TRUFG+BG 1923.
2176     UFLB(1,K)=BG 1924.
2177     IF(K.EQ.11) TRSLWV=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1925.
2178     GO TO 200 1926.
2179     300 CONTINUE 1927.
2180     c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2181     c print * ,'1927 JLAT=',JLAT,PEARTH,PLICE
2182     c print *,' TRUFLB(1)=',TRUFLB(1),' TRUFG=',TRUFG
2183     c endif
2184    
2185     #if ( defined CLM)
2186     c if(ncallclm.ge.1)then
2187     c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2188     c TRUFG=-lwuclm(ILON,JLAT)
2189     c print *,' CLM TRUFG=',TRUFG
2190     c endif
2191     c endif
2192     #endif
2193     C ------------------------------------------------------------------1928.
2194     C END FLUX COMPUTATION1929.
2195     C ------------------------------------------------------------------1930.
2196     TRSLCR=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1931.
2197     TRDFSL=TRDFLB(1) 1932.
2198     TRDFLB(1)=TRDFG 1933.
2199     TRUFSL=TRUFLB(1) 1934.
2200     TRUFLB(1)=TRUFG 1935.
2201     DO 310 L=1,NLP 1936.
2202     310 TRNFLB(L)=TRUFLB(L)-TRDFLB(L) 1937.
2203     DO 320 L=1,NL 1938.
2204     320 TRFCRL(L)=TRNFLB(L+1)-TRNFLB(L) 1939.
2205     PFW=10.*TRUFTW 1940.
2206     IPF=PFW 1941.
2207     IF(IPF.LT.10) GO TO 330 1942.
2208     DPF=PFW-IPF 1943.
2209     IPF=IPF+180 1944.
2210     GO TO 350 1945.
2211     330 PFW=10.*PFW 1946.
2212     IPF=PFW 1947.
2213     IF(IPF.LT.10) GO TO 340 1948.
2214     DPF=PFW-IPF 1949.
2215     IPF=IPF+90 1950.
2216     GO TO 350 1951.
2217     340 PFW=10.*PFW 1952.
2218     IPF=PFW 1953.
2219     IF(IPF.LT.1) IPF=1 1954.
2220     350 BTEMPW=TKPFW(IPF)+DPF*(TKPFW(IPF+1)-TKPFW(IPF)) 1955.
2221     RETURN 1956.
2222     END 1957.
2223     SUBROUTINE SOLAR 1958.
2224     C-----------------------------------------------------------------------1959.
2225     C SOLAR RETURNS 1960.
2226     C-----------------------------------------------------------------------1961.
2227     C SRDFLB SOLAR DOWNWARD FLUX AT LAYER BOTTOM 1962.
2228     C SRUFLB SOLAR UPWARD FLUX AT LAYER BOTTOM EDGE 1963.
2229     C SRNFLB SOLAR NET (DOWNWARD) FLUX (WATTS/M**2) 1964.
2230     C SRFHRL SOLAR HEATING RATE : FLUX (WATTS/M**2) 1965.
2231     C SRRVIS VISALB OF ATMOSPHERE (AS IF RSURFX=0.) 1966.
2232     C SRTATM ATMOS. TRANSMISSIVITY (TOTAL SPECTRUM) 1967.
2233     C PLAVIS PLANETARY ALBEDO 0.2-0.7 MICRON REGION 1968.
2234     C ALBVIS ALBEDO AT GROUND 0.2-0.7 MICRON REGION 1969.
2235     C PLANIR PLANETARY ALBEDO WAV>0.7 MICRON REGION 1970.
2236     C ALBNIR ALBEDO AT GROUND WAV>0.7 MICRON REGION 1971.
2237     C-----------------------------------------------------------------------1972.
2238     C COMMENT 1973.
2239     C-----------------------------------------------------------------------1974.
2240     C SOLAR DATA IS RETURNED IN RADCOM LINES: N,O,P,Q1975.
2241     C NORMS0=1 FLUXES ARE NORMALIZED BY SOLAR CONSTANT1976.
2242     C VERTICAL FLUX DISTRIBUTIONS CONTAIN SOLAR ZENITH1977.
2243     C ANGLE (COSZ) DEPENDENCE 1978.
2244     C RETURNED SOLAR FLUX VALUES SHOULD BE MULTIPLIED 1979.
2245     C BY COSZ WHEN COMPUTING ATMOSPHERIC HEATING RATE 1980.
2246     C-----------------------------------------------------------------------1981.
2247    
2248     #include "B83XX.COM"
2249    
2250     DIMENSION PFR(52),PFRI(52), PI0C(14),DKS0(14) 2036.
2251     DATA PFR/ 2037.
2252     1.4144,.4917,.5265,.5530,.5757,.5966,.6159,.6345,.6522,.6689,.6849,2038.
2253     2.7003,.7152,.7293,.7428,.7557,.7680,.7796,.7905,.8008,.8105,.8198,2039.
2254     3.8286,.8368,.8444,.8515,.8581,.8642,.8699,.8750,.8798,.8843,.8886,2040.
2255     4.8928,.8968,.9005,.9040,.9072,.9101,.9129,.9153,.9174,.9193,.9212,2041.
2256     5.9227,.9242,.9254,.9266,.9275,.9284,.864245 ,.864245 / 2042.
2257     DATA PFRI/ 2043.
2258     1.4950,.5300,.5620,.5882,.6088,.6302,.6537,.6763,.6969,.7157,.7332,2044.
2259     2.7499,.7658,.7806,.7945,.8074,.8194,.8306,.8409,.8504,.8592,.8674,2045.
2260     3.8751,.8822,.8886,.8946,.9000,.9050,.9097,.9139,.9177,.9210,.9246,2046.
2261     4.9280,.9313,.9343,.9371,.9394,.9415,.9438,.9458,.9475,.9488,.9500,2047.
2262     5.9507,.9515,.9529,.9532,.9538,.9541,.876178 ,.876178 / 2048.
2263     DATA PI0C/.66,.91,.975,.99,.995,.999,.999,.999,.999,.999,.999, 2049.
2264     + .999,.9999,.99999/ 2050.
2265     DATA DKS0/.01,.03,.04,.04,.04,.002,.004,.013,.002,.003,.003, 2051.
2266     + .072,.20,.53/ 2052.
2267     DIMENSION DBLN(20), KSLAM(14), CPFFL(40) 2053.
2268     DATA DBLN/2.,4.,8.,16.,32.,64.,128.,256.,512.,1024.,2048.,4096., 2054.
2269     + 8192.,16384.,32768.,65536.,131072.,262144.,524288.,1048576./ 2055.
2270     DATA NKSLAM/14/, KSLAM/1,1,2,2,5,5,5,5,1,1,1,3,4,6/ 2056.
2271     DATA XCMNO2/5.465/ 2057.
2272     DATA XCMO3/.0399623/ 2058.
2273     DATA TOTRAY/0.000155/ 2059.
2274     C 2060.
2275     DIMENSION SRBALB(6),SRXALB(6) 2061.
2276     EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 2062.
2277     C 2063.
2278     EQUIVALENCE 2064.
2279     + (BXA(1),BOCVIS),(BXA(5),BEAVIS),(BXA( 9),BOIVIS),(BXA(13),BLIVIS)2065.
2280     +,(BXA(2),BOCNIR),(BXA(6),BEANIR),(BXA(10),BOINIR),(BXA(14),BLINIR)2066.
2281     +,(BXA(3),XOCVIS),(BXA(7),XEAVIS),(BXA(11),XOIVIS),(BXA(15),XLIVIS)2067.
2282     +,(BXA(4),XOCNIR),(BXA(8),XEANIR),(BXA(12),XOINIR),(BXA(16),XLINIR)2068.
2283     +, (BXA(17),EXPSNE),(BXA(18),EXPSNO),(BXA(19),EXPSNL)2069.
2284     +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 2070.
2285     +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 2071.
2286     C 2072.
2287     EQUIVALENCE (SRXATM(1),SRXVIS),(SRXATM(2),SRXNIR) 2073.
2288     EQUIVALENCE (SRXATM(3),XXAVIS),(SRXATM(4),XXANIR) 2074.
2289     C 2075.
2290     EQUIVALENCE (ISPARE(1),NEWASZ) 2075.5
2291     C 2076.
2292     C-----------------------------------------------------------------------2077.
2293     C SOLAR: NET FLUX AT GROUND FOR FRACTIONAL GRID SURFACE ALBEDOS 2078.
2294     C 2079.
2295     C PFNFG(DT,XA,RSA,RX,RB)=(DT*(1.-RB)-XA*(RX-RB)*(1.-RSA)) 2080.
2296     C + /(1.-RSA*RB) 2081.
2297     C-----------------------------------------------------------------------2082.
2298     C 2083.
2299     C 2084.
2300     C O3ABS(X)= 1.08173*X/(1.00+ 2085.
2301     C $ 138.57*X)**0.805 + 0.0658*X/(1.00+(103.63*X)**3) 2086.
2302     C 2087.
2303     S0COSZ=S0 2088.
2304     IF(NORMS0.EQ.0) S0COSZ=S0*COSZ 2089.
2305     C 2090.
2306     DO 10 N=1,NLP 2091.
2307     SRNFLB(N)=0. 2092.
2308     SRDFLB(N)=0. 2093.
2309     SRUFLB(N)=0. 2094.
2310     SRFHRL(N)=0. 2095.
2311     10 CONTINUE 2096.
2312     SRIVIS=0. 2097.
2313     SROVIS=0. 2098.
2314     SRINIR=0. 2099.
2315     SRONIR=0. 2100.
2316     SRDVIS=0. 2101.
2317     SRUVIS=0. 2102.
2318     SRDNIR=0. 2103.
2319     SRUNIR=0. 2104.
2320     SRTVIS=0. 2105.
2321     SRAVIS=0. 2106.
2322     SRTNIR=0. 2107.
2323     SRANIR=0. 2108.
2324     SRSLHR=0. 2109.
2325     PLAVIS=1. 2110.
2326     PLANIR=1. 2111.
2327     ALBVIS=1. 2112.
2328     ALBNIR=1. 2113.
2329     SRRVIS=1. 2114.
2330     SRRNIR=0. 2115.
2331     SRTNIR=0. 2116.
2332     SRXVIS=0. 2117.
2333     SRXNIR=0. 2118.
2334     C 2119.
2335     XXVIS=.53/(1.-SRBALB(6)) 2120.
2336     XXNIR=.47/(1.-SRBALB(5)) 2121.
2337     DO 20 N=1,4 2122.
2338     20 FSRNFG(N)=XXVIS*(1.-BXA(4*N-3))+XXNIR*(1.-BXA(4*N-2)) 2123.
2339     C 2124.
2340     IF(COSZ.LT.0.01) RETURN 2125.
2341     COSMAG=35.0/SQRT(1224.*COSZ*COSZ+1.0) 2126.
2342     TAURAY=TOTRAY*FRAYLE 2127.
2343     CPF=49.999/COSMAG 2128.
2344     IPF=CPF 2129.
2345     DPF=CPF-IPF 2130.
2346     IF(ISOSCT.EQ.1) IPF=51 2131.
2347     CPFF=(1.0-DPF)*PFR(IPF)+DPF*PFR(IPF+1) 2132.
2348     CPFFI=(1.0-DPF)*PFRI(IPF)+DPF*PFRI(IPF+1) 2133.
2349     SECZ=1./COSZ 2134.
2350     DO 100 N=1,NL 2135.
2351     CPFFL(N)=CPFF 2136.
2352     IF(TLM(N).LT.TKCICE) CPFFL(N)=CPFFI 2137.
2353     100 CONTINUE 2138.
2354     C 2139.
2355     K = 0 2140.
2356     300 K = K+1 2141.
2357     C 2142.
2358     KLAM=KSLAM(K) 2143.
2359     DKS0K=DKS0(K) 2144.
2360     DKS0X=DKS0K*S0COSZ 2145.
2361     RBNB=SRBALB(KLAM) 2146.
2362     RBNX=SRXALB(KLAM) 2147.
2363     RCNB=0.0 2148.
2364     RCNX=0.0 2149.
2365     C 2150.
2366     N = 0 2151.
2367     200 N = N+1 2152.
2368     C 2153.
2369     CPFF=CPFFL(N) 2154.
2370     SRB(N)=RBNB 2155.
2371     SRX(N)=RBNX 2156.
2372     TLN=TLM(N) 2157.
2373     PLN=PL(N) 2158.
2374     ULN=ULGAS(N,1) 2159.
2375     RTAU=1.E-06 2160.
2376     GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114),K 2161.
2377     101 CONTINUE 2162.
2378     C--------K=6-------H2O DS0=.01 2163.
2379     TERMA=(35.66+TLN*(.0416-.0004622*TLN+.001057*PLN))*(1.+.04286*PLN)2164.
2380     TERMB=(1.+.00171*ULN)*(1.+PLN*(189.088+.1316*PLN)) 2165.
2381     TAU1 =TERMA/TERMB 2166.
2382     IF(TAU1.GT.0.02343) TAU1=0.02343 2167.
2383     TAU=TAU1*ULN 2168.
2384     GO TO 120 2169.
2385     102 CONTINUE 2170.
2386     C--------K=5-------H2O DS0=.03 2171.
2387     TERMA=(2.792+TLN*(.0914-.0002848*TLN+.0003395*PLN)) 2172.
2388     + *(1.+.02964*PLN) 2173.
2389     TERMB=(1.0+.000657*ULN)*(1.+PLN*(240.70+.13847*PLN)) 2174.
2390     TAU1 =TERMA/TERMB 2175.
2391     IF(TAU1.GT.0.00520) TAU1=0.00520 2176.
2392     TAU=TAU1*ULN 2177.
2393     GO TO 120 2178.
2394     103 CONTINUE 2179.
2395     C--------K=4-------H2O DS0=.04 2180.
2396     TERMA=(.4768+.467E-04*PLN*TLN)*(1.+TLN*(.00191-.719E-05*TLN)) 2181.
2397     TERMB=(1.+.717E-04*ULN)*(1.+PLN*(130.56+.0876*PLN))/(1.+.0266*PLN)2182.
2398     TAU1 =TERMA/TERMB 2183.
2399     IF(TAU1.GT.0.00150) TAU1=0.0015 2184.
2400     TAU=TAU1*ULN 2185.
2401     GO TO 120 2186.
2402     104 CONTINUE 2187.
2403     C--------K=3-------H2O DS0=.04 2188.
2404     TERMA=(.000247*TLN-.091+PLN*(.00035+.78E-06*TLN))*(1.+.2847*PLN) 2189.
2405     TERMB=(1.+.2066E-04*ULN)*(1.+PLN*(137.17+.16132*PLN)) 2190.
2406     TAU =(TERMA/TERMB)*ULN 2191.
2407     GO TO 120 2192.
2408     105 CONTINUE 2193.
2409     C--------K=2-------H2O DS0=.04 2194.
2410     TERMA=(PLN*(1.974/TLN+.0001117*TLN)-10.713)*(1.+.005788*TLN) 2195.
2411     + *(1.+.001517*PLN) 2196.
2412     TERMB=(1.+.3218E-04*ULN)*(1.+PLN*(863.44+.2048*PLN)) 2197.
2413     TAU =(TERMA/TERMB)*ULN 2198.
2414     GO TO 120 2199.
2415     106 CONTINUE 2200.
2416     C--------K=4-------O2 DS0=.002 2201.
2417     ULN=ULGAS(N,4) 2202.
2418     TERMA=(.2236E-05-.1181E-09*TLN)*(1.+PLN*(.6364E-05*PLN+.001168)) 2203.
2419     TERMB=1.+.1521E-05*ULN 2204.
2420     TAU =(TERMA/TERMB)*ULN 2205.
2421     GO TO 120 2206.
2422     107 CONTINUE 2207.
2423     C--------K=3-------O2 DS0=.004 2208.
2424     ULN=ULGAS(N,4) 2209.
2425     TERMA=(.3179E-06-.9263E-11*TLN)*(1.+PLN*(.8832E-05*PLN+.0005292)) 2210.
2426     TERMB=1.+.1968E-06*ULN 2211.
2427     TAU =(TERMA/TERMB)*ULN 2212.
2428     GO TO 120 2213.
2429     108 CONTINUE 2214.
2430     C--------K=2-------O2 DS0=.013 2215.
2431     ULN=ULGAS(N,4) 2216.
2432     TERMA=(.2801E-07-.1638E-12*TLN)*(1.+PLN*(.1683E-04*PLN-.001721)) 2217.
2433     TERMB=1.+.8097E-07*ULN 2218.
2434     TAU =(TERMA/TERMB)*ULN 2219.
2435     GO TO 120 2220.
2436     109 CONTINUE 2221.
2437     C--------K=4-------CO2 DS0=.002 2222.
2438     ULN=ULGAS(N,2) 2223.
2439     TERMA=(50.73-.03155*TLN-PLN*(.5543+.00091*TLN))*(1.-.1004*PLN) 2224.
2440     TERMB=(1.+.006468*ULN)*(1.+PLN*(49.51+.8285*PLN)) 2225.
2441     TAU =(TERMA/TERMB)*ULN 2226.
2442     IF(PLN.LT.175.0) TAU=(.00018*PLN+0.00001)*ULN 2227.
2443     GO TO 120 2228.
2444     110 CONTINUE 2229.
2445     C--------K=3-------CO2 DS0=.003 2230.
2446     ULN=ULGAS(N,2) 2231.
2447     TERMA=(1.+.01319*TLN)*(PLN*(.008001*ULN+.4589E-03)-.8396*ULN) 2232.
2448     TERMB=ULN*(PLN+295.7+1.967*ULN)+.15126*PLN 2233.
2449     TAU =(TERMA/TERMB)*ULN 2234.
2450     GO TO 120 2235.
2451     111 CONTINUE 2236.
2452     C--------K=2-------CO2 DS0=.003 2237.
2453     ULN=ULGAS(N,2) 2238.
2454     TERMA=(1.+.02257*TLN)*(PLN*(.002295*ULN-.5489E-04)-.7571*ULN) 2239.
2455     TERMB=ULN*(PLN+803.9+2.477*ULN)-.09899*PLN 2240.
2456     TAU =(TERMA/TERMB)*ULN 2241.
2457     GO TO 120 2242.
2458     112 CONTINUE 2243.
2459     TAU=0.0 2244.
2460     GO TO 120 2245.
2461     113 CONTINUE 2246.
2462     TAU=0.0 2247.
2463     GO TO 120 2248.
2464     114 CONTINUE 2249.
2465     TAU=XCMNO2*ULGAS(N,5)+XCMO3*ULGAS(N,3) 2250.
2466     RTAU=TAURAY*(PLB(N)-PLB(N+1)) 2251.
2467     120 CONTINUE 2252.
2468     IF(TAU.LT.0.0) TAU=0.0 2253.
2469     CTAU=CLDTAU(N)*FCLDSR 2254.
2470     CPI0=PI0C(K) 2255.
2471     ATAU=EXTAER(N,KLAM) 2256.
2472     TAU=TAU+CTAU+ATAU+RTAU 2257.
2473     IF(TAU.LT.TAUMIN) GO TO 180 2258.
2474     CTAUSC=CPI0*CTAU 2259.
2475     ATAUSC=SCTAER(N,KLAM) 2260.
2476     TAUSCT=CTAUSC+ATAUSC+RTAU 2261.
2477     PIZERO=TAUSCT/TAU 2262.
2478     IF(PIZERO.GT.0.001) GO TO 130 2263.
2479     GO TO 180 2264.
2480     130 CONTINUE 2265.
2481     APFF=COSAER(N,KLAM) 2266.
2482     APFF0=APFF 2266.1
2483     IF(NEWASZ.GT.0) CALL HGAER1(COSZ,ATAUSC,APFF0,APFF) 2266.2
2484     PFF=(CPFF*CTAUSC+APFF*ATAUSC)/TAUSCT 2267.
2485     IF(ISOSCT.GT.1) GO TO 131 2268.
2486     GO TO 132 2269.
2487     131 TAU=TAU-TAUSCT*PFF 2270.
2488     PIZERO=PIZERO*(1.-PFF)/(1.-PIZERO*PFF) 2271.
2489     PFF=0. 2272.
2490     132 CONTINUE 2273.
2491     PR=1.0-PFF 2274.
2492     PT=1.0+PFF 2275.
2493     IF(TAU.LT.0.015625) GO TO 140 2276.
2494     C ALOG
2495     DBLS=7.001+1.44269*LOG(TAU) 2277.
2496     C ALOG
2497     NDBLS=DBLS 2278.
2498     TAU=TAU/DBLN(NDBLS) 2279.
2499     GO TO 150 2280.
2500     140 XANB=EXP(-TAU-TAU) 2281.
2501     XANX=EXP(-TAU*SECZ) 2282.
2502     TANB=PT*XANB 2283.
2503     XXT=(SECZ-2.0)*TAU 2284.
2504     TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2285.
2505     RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2286.
2506     XXT=(SECZ+2.0)*TAU 2287.
2507     RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2288.
2508     BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2289.
2509     XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2290.
2510     RASB=RASB*BNORM 2291.
2511     RASX=RASX*XNORM 2292.
2512     TANB=TANB*BNORM 2293.
2513     TANX=TANX*XNORM 2294.
2514     GO TO 170 2295.
2515     150 XANB=EXP(-TAU-TAU) 2296.
2516     XANX=EXP(-TAU*SECZ) 2297.
2517     TANB=PT*XANB 2298.
2518     XXT=(SECZ-2.0)*TAU 2299.
2519     TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2300.
2520     RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2301.
2521     XXT=(SECZ+2.0)*TAU 2302.
2522     RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2303.
2523     BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2304.
2524     XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2305.
2525     RASB=RASB*BNORM 2306.
2526     RASX=RASX*XNORM 2307.
2527     TANB=TANB*BNORM 2308.
2528     TANX=TANX*XNORM 2309.
2529     DO 160 NN=1,NDBLS 2310.
2530     RARB=RASB*RASB 2311.
2531     RARX=XANX*RASX 2312.
2532     XATB=XANB+TANB 2313.
2533     DENOM=1.0-RARB 2314.
2534     DB=(TANB+XANB*RARB)/DENOM 2315.
2535     DX=(TANX+RARX*RASB)/DENOM 2316.
2536     UB=RASB*(XANB+DB) 2317.
2537     UX=RARX+RASB*DX 2318.
2538     RASB=RASB+XATB*UB 2319.
2539     RASX=RASX+XATB*UX 2320.
2540     TANB=XANB*TANB+XATB*DB 2321.
2541     TANX=XANX*TANX+XATB*DX 2322.
2542     XANB=XANB*XANB 2323.
2543     XANX=XANX*XANX 2324.
2544     160 CONTINUE 2325.
2545     170 RARB=RASB*RBNB 2326.
2546     RARX=RASB*RBNX 2327.
2547     XATB=XANB+TANB 2328.
2548     DENOM=1.0-RARB 2329.
2549     DB=(TANB+XANB*RARB)/DENOM 2330.
2550     DX=(TANX+XANX*RARX)/DENOM 2331.
2551     UB=RBNB*(XANB+DB) 2332.
2552     UX=RBNX*XANX+RBNB*DX 2333.
2553     RBNB=RASB+XATB*UB 2334.
2554     RBNX=RASX+XATB*UX 2335.
2555     XATC=XATB/(1.0-RASB*RCNB) 2336.
2556     RCNX=RASX+(XANX*RCNX+TANX*RCNB)*XATC 2337.
2557     RCNB=RASB+RCNB*XATB*XATC 2338.
2558     GO TO 190 2339.
2559     180 RASB=0.0 2340.
2560     RASX=0.0 2341.
2561     TANB=0.0 2342.
2562     TANX=0.0 2343.
2563     XANB=EXP(-TAU-TAU) 2344.
2564     XANX=EXP(-TAU*SECZ) 2345.
2565     DX=0.0 2346.
2566     UX=RBNX*XANX 2347.
2567     RBNB=RBNB*XANB*XANB 2348.
2568     RBNX=UX*XANB 2349.
2569     RCNB=RCNB*XANB*XANB 2350.
2570     RCNX=RCNX*XANX*XANB 2351.
2571     190 RNB(N)=RASB 2352.
2572     RNX(N)=RASX 2353.
2573     TNB(N)=TANB 2354.
2574     TNX(N)=TANX 2355.
2575     XNB(N)=XANB 2356.
2576     XNX(N)=XANX 2357.
2577     IF(N.LT.NL) GO TO 200 2358.
2578     C 2359.
2579     IF(K.EQ.NKSLAM) GO TO 301 2360.
2580     SRDFLB(NLP)=SRDFLB(NLP)+DKS0X 2361.
2581     SRUFLB(NLP)=SRUFLB(NLP)+DKS0X*RBNX 2362.
2582     SRDFLB(NL)=SRDFLB(NL)+DKS0X*(XANX+DX) 2363.
2583     SRUFLB(NL)=SRUFLB(NL)+DKS0X*UX 2364.
2584     RMEAN=RBNX 2365.
2585     DO 230 M=2,NL 2366.
2586     N=NLP-M 2367.
2587     XBNB=XNB(N) 2368.
2588     XBNX=XNX(N) 2369.
2589     RBNX=RNX(N) 2370.
2590     IF(RBNX.GT.1.E-05) GO TO 210 2371.
2591     RASB=RASB*XBNB*XBNB 2372.
2592     TANX=TANX*XBNB 2373.
2593     GO TO 220 2374.
2594     210 RBNB=RNB(N) 2375.
2595     TBNB=TNB(N) 2376.
2596     TBNX=TNX(N) 2377.
2597     RARB=RASB*RBNB 2378.
2598     XBTB=XBNB+TBNB 2379.
2599     DENOM=1.0-RARB 2380.
2600     TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2381.
2601     RASB=RBNB+XBTB*XBTB*RASB/DENOM 2382.
2602     220 XANX=XANX*XBNX 2383.
2603     RBNB=SRB(N) 2384.
2604     RBNX=SRX(N) 2385.
2605     DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2386.
2606     UX=RBNX*XANX+RBNB*DX 2387.
2607     SRUFLB(N)=SRUFLB(N)+DKS0X*UX 2388.
2608     230 SRDFLB(N)=SRDFLB(N)+DKS0X*(XANX+DX) 2389.
2609     SRRNIR=SRRNIR+DKS0K*RCNX 2390.
2610     SRTNIR=SRTNIR+DKS0K*(TANX+XANX) 2391.
2611     SRXNIR=SRXNIR+DKS0K*XANX 2392.
2612     GO TO 300 2393.
2613     C 2394.
2614     301 CONTINUE 2395.
2615     SRTNIR=SRTNIR/0.459 2396.
2616     SRRNIR=SRRNIR/0.459 2397.
2617     SRXNIR=SRXNIR/0.459 2398.
2618     SRANIR=1.0-SRTNIR-SRRNIR 2399.
2619     C 2400.
2620     VRD(NLP)=DKS0X 2401.
2621     VRU(NLP)=DKS0X*RBNX 2402.
2622     O3PATH=(1.9+XANX*(COSMAG-1.9))*ULGAS(NL,3) 2403.
2623     ATOP=0. 2404.
2624     ABOT=O3ABS(O3PATH) 2405.
2625     ASUM=(ABOT-ATOP)*XANX 2406.
2626     O3A(NL)=ASUM*S0COSZ 2407.
2627     ATOP=ABOT 2408.
2628     VRD(NL)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2409.
2629     VRU(NL)=DKS0X*UX 2410.
2630     FAC(NL)=UX 2411.
2631     RMEAN=RBNX 2412.
2632     N=NL 2413.
2633     305 N=N-1 2414.
2634     XBNB=XNB(N) 2415.
2635     XBNX=XNX(N) 2416.
2636     RBNX=RNX(N) 2417.
2637     IF(RBNX.GT.1.E-05) GO TO 310 2418.
2638     RASB=RASB*XBNB*XBNB 2419.
2639     TANX=TANX*XBNB 2420.
2640     GO TO 320 2421.
2641     310 RBNB=RNB(N) 2422.
2642     TBNB=TNB(N) 2423.
2643     TBNX=TNX(N) 2424.
2644     RARB=RASB*RBNB 2425.
2645     XBTB=XBNB+TBNB 2426.
2646     DENOM=1.0-RARB 2427.
2647     TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2428.
2648     RASB=RBNB+XBTB*XBTB*RASB/DENOM 2429.
2649     320 XANX=XANX*XBNX 2430.
2650     RBNB=SRB(N) 2431.
2651     RBNX=SRX(N) 2432.
2652     DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2433.
2653     UX=RBNX*XANX+RBNB*DX 2434.
2654     FAC(N)=UX 2435.
2655     VRU(N)=DKS0X*UX 2436.
2656     O3PATH=O3PATH+(1.9+XANX*(COSMAG-1.9))*ULGAS(N,3) 2437.
2657     ABOT=O3ABS(O3PATH) 2438.
2658     ASUM=ASUM+(ABOT-ATOP)*XANX 2439.
2659     ATOP=ABOT 2440.
2660     VRD(N)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2441.
2661     O3A(N)=ASUM*S0COSZ 2442.
2662     IF(N.GT.1) GO TO 305 2443.
2663     C 2444.
2664     O3SUM=0. 2445.
2665     DO 324 I=1,NL 2446.
2666     324 O3SUM=O3SUM+ULGAS(I,3) 2447.
2667     SRXVIS=XANX*(1.-O3ABS(COSMAG*O3SUM)/0.53) 2448.
2668     SRTVIS=TANX+XANX-ASUM/DKS0K 2449.
2669     RGRND=UX/(XANX+DX+1.E-05) 2450.
2670     IF(RGRND.GT.1.0) RGRND=1.0 2451.
2671     ASUM=ASUM*RGRND 2452.
2672     VRU(N)=VRU(N)-ASUM*S0COSZ 2453.
2673     325 CONTINUE 2454.
2674     O3PATH=O3PATH+1.9*ULGAS(N,3) 2455.
2675     ATOP=O3ABS(O3PATH) 2456.
2676     ASUM=ASUM+(ATOP-ABOT)*FAC(N) 2457.
2677     ABOT=ATOP 2458.
2678     N=N+1 2459.
2679     VRU(N)=VRU(N)-ASUM*S0COSZ 2460.
2680     IF(N.LT.NLP) GO TO 325 2461.
2681     SRRVIS=RCNX-ASUM/DKS0K 2462.
2682     SRAVIS=1.0-SRRVIS-SRTVIS 2463.
2683     TFU=VRU(NLP) 2464.
2684     BFU=VRU(1) 2465.
2685     IF(BFU.GE.0.) GO TO 327 2466.
2686     DO 326 N=1,NLP 2467.
2687     326 VRU(N)=(VRU(N)-BFU)*(TFU/(TFU-BFU)) 2468.
2688     BFU=VRU(1) 2469.
2689     327 BFD=VRD(1) 2470.
2690     IF(BFD.GT.BFU) GO TO 329 2471.
2691     TFD=VRD(NLP) 2472.
2692     BFUD=BFU/TFD 2473.
2693     TFDD=TFD/(TFD-BFD) 2474.
2694     DO 328 N=1,NLP 2475.
2695     328 VRD(N)=(VRD(N)*(1.-BFUD)-BFD+BFUD*TFD)*TFDD 2476.
2696     329 SRDVIS=VRD(1) 2477.
2697     SRUVIS=VRU(1) 2478.
2698     ALBVIS=SRUVIS/(SRDVIS+1.E-10) 2479.
2699     TAU1=0. 2480.
2700     SRIVIS=VRD(NLP) 2481.
2701     SROVIS=VRU(NLP) 2482.
2702     PLAVIS=SROVIS/SRIVIS 2483.
2703     C 2484.
2704     TAU2=0. 2485.
2705     TAU3=0. 2486.
2706     TRN1=0. 2487.
2707     TRN2=0. 2488.
2708     TRN3=0. 2489.
2709     N=NLP 2490.
2710     C 2491.
2711     C THE FOLLOWING IS CONSIDERED PART OF THE NEAR-IR SPECTRUM 2492.
2712     C -------------------------------------------------------- 2493.
2713     DO 330 M=1,NL 2494.
2714     N=N-1 2495.
2715     PLN=PL(N) 2496.
2716     ULN=ULGAS(N,2)*SECZ 2497.
2717     ULX=ULN 2498.
2718     IF(ULN.GT.7.0) ULN=7.0 2499.
2719     C--------K=5-------CO2 DS0=.002 2500.
2720     TERMA=.003488*PLN*(1.+39.59*EXP(-8.769*ULN/(1.+4.419*ULN))) 2501.
2721     + *(1.+ULN*(.001938*PLN-.00503*ULN)) 2502.
2722     TERMB=(1.+.04712*PLN*(1.+.4877*ULN)) 2503.
2723     TAU=TERMA/TERMB 2504.
2724     IF(TAU.LT.1.E-06) TAU=1.E-06 2505.
2725     TAU1=TAU1+TAU*ULX 2506.
2726     ULN=ULGAS(N,1)*SECZ 2507.
2727     C--------K=7-------H2O DS0=.01(DS0=.008 + DS0=.002 CO2 OVERLAP) 2508.
2728     TERMA=.001582*PLN*(1.+6.769*EXP(-9.59*ULN/(1.+5.026*ULN))) 2509.
2729     + *(1.+ULN*(.2757E-03*PLN+.001429*ULN)) 2510.
2730     TERMB=(1.+.003683*PLN*(1.+1.187*ULN)) 2511.
2731     TAU2=TAU2+(TERMA/TERMB)*ULN 2512.
2732     ULN=ULGAS(N,4)*SECZ 2513.
2733     C--------K=5-------O2 DS0=.001 2514.
2734     TERMA=(.1366E-03-.2203E-07*TLN)*(1.+PLN*(.1497E-06*ULN+.001261)) 2515.
2735     TERMB=(1.+.3867E-03*ULN)/(1.+.2075E-04*ULN) 2516.
2736     TAU3=TAU3+(TERMA/TERMB)*ULN 2517.
2737     IF(TAU1.LT.10.0) TRN1=EXP(-TAU1) 2518.
2738     IF(TAU2.LT.10.0) TRN2=EXP(-TAU2) 2519.
2739     IF(TAU3.LT.10.0) TRN3=EXP(-TAU3) 2520.
2740     FAC(N)=.004358*TRN1+.01743*TRN2+.00218*TRN3 2521.
2741     330 SRDFLB(N)=SRDFLB(N)+SRDFLB(N)*FAC(N) 2522.
2742     FAC(NLP)=.023968 2523.
2743     SRDFLB(NLP)=SRDFLB(NLP)+SRDFLB(NLP)*FAC(NLP) 2524.
2744     DO 340 N=1,NLP 2525.
2745     340 SRUFLB(N)=SRUFLB(N)+SRUFLB(N)*FAC(1) 2526.
2746     SRINIR=SRDFLB(NLP) 2527.
2747     SRONIR=SRUFLB(NLP) 2528.
2748     PLANIR=SRONIR/SRINIR 2529.
2749     SRDNIR=SRDFLB(1) 2530.
2750     SRUNIR=SRUFLB(1) 2531.
2751     ALBNIR=SRUNIR/(SRDNIR+1.E-10) 2532.
2752     DO 350 N=1,NLP 2533.
2753     SRDFLB(N)=SRDFLB(N)+VRD(N) 2534.
2754     SRUFLB(N)=SRUFLB(N)+VRU(N) 2535.
2755     350 SRNFLB(N)=SRDFLB(N)-SRUFLB(N) 2536.
2756     DO 360 N=1,NL 2537.
2757     360 SRFHRL(N)=SRNFLB(N+1)-SRNFLB(N) 2538.
2758     SRSLHR=FRACSL*SRFHRL(1) 2539.
2759     C 2540.
2760     C--------------------------------- 2541.
2761     CALL O2HEAT(FAC,COSZ,S0COSZ) 2542.
2762     C--------------------------------- 2543.
2763     C 2544.
2764     DO 500 L=1,NL 2545.
2765     500 SRFHRL(L)=SRFHRL(L)+FAC(L) 2546.
2766     L=NLP 2547.
2767     DO 510 N=1,NL 2548.
2768     L=L-1 2549.
2769     IF(PLB(L).GT.0.09) GO TO 520 2550.
2770     510 SRFHRL(L)=FAC(L)+O3A(L) 2551.
2771     520 CONTINUE 2552.
2772     C I=NLP+1-II 2553.
2773     C 2554.
2774     C-----------------------------------------------------------------------2555.
2775     C SOLAR NET FLUX (SRNFLB(1)) DISTRIBUTION ACCORDING TO SURFACE TYPE 2556.
2776     CR NOT USED AND NOT SAFE (CAUSES DIVIDE CHECKS) 2556.1
2777     C-----------------------------------------------------------------------2557.
2778     CR FSRVIS=0.53 2558.
2779     CR FSRNIR=0.47 2559.
2780     C 2560.
2781     CR RASVIS=0. 2561.
2782     CR IF(SRUVIS.GT.1.E-03) RASVIS=(SRDVIS-SRTVIS*SRIVIS)/SRUVIS 2562.
2783     CR XXAVIS=0. 2563.
2784     CR DENOM=SRIVIS*(SRXALB(6)-SRBALB(6)) 2564.
2785     CR IF(ABS(DENOM).GT.1.E-03) XXAVIS=(SRUVIS-SRDVIS*SRBALB(6))/DENOM 2565.
2786     C$ PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.
2787     CR IF(SRIVIS.GT.1.E-03) PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.11
2788     CR RASNIR=0. 2567.
2789     CR IF(PNFVIS.LT.1.E-03) RETURN 2568.
2790     CR IF(SRUNIR.GT.1.E-03) RASNIR=(SRDNIR-SRTNIR*SRINIR)/SRUNIR 2569.
2791     CR XXANIR=0. 2570.
2792     CR DENOM=SRINIR*(SRXALB(5)-SRBALB(5)) 2571.
2793     CR IF(ABS(DENOM).GT.1.E-03) XXANIR=(SRUNIR-SRDNIR*SRBALB(5))/DENOM 2572.
2794     C$ PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.
2795     CR IF(SRINIR.GT.1.E-03) PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.11
2796     CR IF(PNFNIR.LT.1.E-03) RETURN 2574.
2797     C 2575.
2798     CR FNSROC=0. 2576.
2799     CR IF(POCEAN.LT.1.E-04) GO TO 601 2577.
2800     CR POCVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOCVIS,BOCVIS) 2578.
2801     CR POCNIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOCVIS,BOCVIS) 2579.
2802     CR FNSROC=(FSRVIS*POCVIS/PNFVIS+FSRNIR*POCNIR/PNFNIR) 2580.
2803     C 2581.
2804     CR601 FNSREA=0. 2582.
2805     CR IF(PEARTH.LT.1.E-04) GO TO 602 2583.
2806     CR PEAVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XEAVIS,BEAVIS) 2584.
2807     CR PEANIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XEANIR,BEANIR) 2585.
2808     CR FNSREA=(FSRVIS*PEAVIS/PNFVIS+FSRNIR*PEANIR/PNFNIR) 2586.
2809     C 2587.
2810     CR602 FNSROI=0. 2588.
2811     CR IF(POICE .LT.1.E-04) GO TO 603 2589.
2812     CR POIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOIVIS,BOIVIS) 2590.
2813     CR POINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOINIR,BOINIR) 2591.
2814     CR FNSROI=(FSRVIS*POIVIS/PNFVIS+FSRNIR*POINIR/PNFNIR) 2592.
2815     C 2593.
2816     CR603 FNSRLI=0. 2594.
2817     CR IF(PLICE .LT.1.E-04) GO TO 604 2595.
2818     CR PLIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XLIVIS,BLIVIS) 2596.
2819     CR PLINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XLINIR,BLINIR) 2597.
2820     CR FNSRLI=(FSRVIS*PLIVIS/PNFVIS+FSRNIR*PLINIR/PNFNIR) 2598.
2821     C 2599.
2822     CR604 FNORM=FNSROC*POCEAN+FNSREA*PEARTH+FNSROI*POICE+FNSRLI*PLICE 2600.
2823     C 2601.
2824     CR FSRNFG(1)=FNSROC/FNORM 2602.
2825     CR FSRNFG(2)=FNSREA/FNORM 2603.
2826     CR FSRNFG(3)=FNSROI/FNORM 2604.
2827     CR FSRNFG(4)=FNSRLI/FNORM 2605.
2828     C 2606.
2829     RETURN 2607.
2830     END 2608.
2831     SUBROUTINE SETAO2(O2CMA,NL) 2609.
2832     DIMENSION O2CMA(40),O2FHRL(40) 2610.
2833     DIMENSION SFWM2(18),SIGMA(18,6) 2611.
2834     DATA SFWM2/ 2612.
2835     A 2.196E-03, 0.817E-03, 1.163E-03, 1.331E-03, 1.735E-03, 1.310E-03,2613.
2836     B 1.311E-03, 2.584E-03, 2.864E-03, 4.162E-03, 5.044E-03, 6.922E-03,2614.
2837     C 6.906E-03,10.454E-03, 5.710E-03, 6.910E-03,14.130E-03,18.080E-03/2615.
2838     DATA SIGMA/ 2616.
2839     A 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2617.
2840     B 4.33E-21, 4.89E-21, 6.63E-21, 1.60E-20, 7.20E-20, 1.59E-18, 2618.
2841     C 2.10E-21, 2.32E-21, 3.02E-21, 6.30E-21, 3.46E-20, 7.52E-19, 2619.
2842     D 5.95E-22, 9.72E-22, 2.53E-21, 7.57E-21, 7.38E-20, 7.44E-19, 2620.
2843     E 3.33E-22, 1.02E-22, 4.09E-21, 1.63E-20, 8.79E-20, 3.81E-19, 2621.
2844     F 1.09E-21, 1.16E-21, 1.45E-21, 3.32E-21, 2.00E-20, 4.04E-19, 2622.
2845     G 1.15E-21, 1.30E-21, 1.90E-21, 4.89E-21, 2.62E-20, 4.08E-19, 2623.
2846     H 3.90E-22, 4.90E-22, 9.49E-22, 3.33E-21, 2.14E-20, 2.39E-19, 2624.
2847     I 1.29E-22, 2.18E-22, 8.28E-22, 3.46E-21, 1.94E-20, 1.06E-19, 2625.
2848     J 6.26E-23, 7.80E-23, 2.62E-22, 1.83E-21, 1.25E-20, 3.95E-20, 2626.
2849     K 2.74E-23, 3.58E-23, 8.64E-23, 4.03E-22, 2.13E-21, 1.95E-20, 2627.
2850     L 1.95E-23, 2.44E-23, 4.89E-23, 2.87E-22, 1.95E-21, 1.36E-20, 2628.
2851     M 1.84E-23, 1.96E-23, 2.71E-23, 8.52E-23, 6.48E-22, 3.89E-21, 2629.
2852     N 1.80E-23, 1.81E-23, 1.87E-23, 2.69E-23, 1.34E-22, 1.52E-21, 2630.
2853     O 1.80E-23, 1.80E-23, 1.82E-23, 2.40E-23, 5.71E-23, 5.70E-22, 2631.
2854     P 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 3.50E-23, 2632.
2855     Q 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 2.68E-23, 2633.
2856     R 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23/ 2634.
2857     REAL WTKO2(6)/0.05,0.20,0.25,0.25,0.20,0.05/ 2635.
2858     C 2636.
2859     DATA STPMOL/2.68714E+19/,S00/1367.0/ 2637.
2860     DATA NW/18/,NZ/11/,NKO2/6/ 2638.
2861     DIMENSION ZTABLE(40,11) 2639.
2862     DIMENSION ZCOSJ(11) 2640.
2863     NLP=NL+1 2641.
2864     FSUM=0.0 2642.
2865     DO 100 I=1,NW 2643.
2866     100 FSUM=FSUM+SFWM2(I) 2644.
2867     DO 110 J=1,NZ 2645.
2868     110 ZTABLE(NLP,J)=FSUM 2646.
2869     SUMMOL=0.0 2647.
2870     DO 150 N=1,NL 2648.
2871     L=NLP-N 2649.
2872     SUMMOL=SUMMOL+O2CMA(L)*STPMOL 2650.
2873     DO 140 J=1,NZ 2651.
2874     ZCOS=0.01*(1/J)+0.1*(J-1) 2652.
2875     ZCOSJ(J)=ZCOS 2653.
2876     FSUM=0.0 2654.
2877     DO 130 I=1,NW 2655.
2878     WSUM=0.0 2656.
2879     DO 120 K=1,NKO2 2657.
2880     TAU=SIGMA(I,K)*SUMMOL/ZCOS 2658.
2881     IF(TAU.GT.30.0) TAU=30.0 2659.
2882     120 WSUM=WSUM+WTKO2(K)*EXP(-TAU) 2660.
2883     130 FSUM=FSUM+WSUM*SFWM2(I) 2661.
2884     140 ZTABLE(L,J)=FSUM 2662.
2885     150 CONTINUE 2663.
2886     DO 170 J=1,NZ 2664.
2887     DO 160 L=1,NL 2665.
2888     160 ZTABLE(L,J)=ZTABLE(L+1,J)-ZTABLE(L,J) 2666.
2889     170 CONTINUE 2667.
2890     RETURN 2668.
2891     C 2669.
2892     C--------------------------------- 2670.
2893     ENTRY O2HEAT(O2FHRL,COSZ,S0) 2671.
2894     C--------------------------------- 2672.
2895     C 2673.
2896     ZCOS=1.0+10.0*COSZ 2674.
2897     JI=ZCOS 2675.
2898     IF(JI.GT.10) JI=10 2676.
2899     JJ=JI+1 2677.
2900     WTJ=ZCOS-JI 2678.
2901     WTI=1.0-WTJ 2679.
2902     DO 200 L=1,NLP-1 2680.
2903     200 O2FHRL(L)=(WTI*ZTABLE(L,JI)+WTJ*ZTABLE(L,JJ))*S0/S00 2681.
2904     RETURN 2682.
2905     END 2683.
2906     FUNCTION O3ABS(OCM) 2684.
2907     c DOUBLE PRECISION O3UVAB 2684.1
2908     DIMENSION AO3(460) 2685.
2909     C 2686.
2910     IP=0 2687.
2911     XX=OCM*1.E+04 2688.
2912     IX=XX 2689.
2913     IF(IX.GT.99) GO TO 110 2690.
2914     IF(IX.LT.1 ) GO TO 130 2691.
2915     GO TO 120 2692.
2916     110 IP=IP+90 2693.
2917     XX=XX*0.1 2694.
2918     IX=XX 2695.
2919     IF(IX.GT.99) GO TO 110 2696.
2920     120 DX=XX-IX 2697.
2921     IX=IX+IP 2698.
2922     O3ABS=AO3(IX)+DX*(AO3(IX+1)-AO3(IX)) 2699.
2923     RETURN 2700.
2924     130 O3ABS=XX*AO3(1) 2701.
2925     RETURN 2702.
2926     C 2703.
2927     C---------------------- 2704.
2928     ENTRY SETAO3(OCM) 2705.
2929     C---------------------- 2706.
2930     C 2707.
2931     ! print *,'After 2707'
2932     DO 140 I=1,460 2708.
2933     II=(I-10)/90-4 2709.
2934     XX=I-((I-10)/90)*90 2710.
2935     ! print *,i,ii,xx
2936     ! OCM=XX*10.**II 2711.
2937     ! 05/14/2006
2938     OCM=XX*10.**float(II)
2939     ! print *,ocm
2940     ! 05/14/2006
2941     140 AO3(I)=O3UVAB(OCM) 2712.
2942     ! print *,'After 2712'
2943     O3ABS=1. 2713.
2944     RETURN 2714.
2945     END 2715.
2946     FUNCTION O3UVAB(OCM) 2716.
2947     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 2717.
2948     c REAL OCM 2718.
2949     C-----------------------------------------------------------------------2719.
2950     C**** OZONE ABSORPTION COEFFICIENT DATA FROM HANDBOOK OF GEOPHYSICS 19612720.
2951     C**** T = -44 DEG CENTR. 2721.
2952     C-----------------------------------------------------------------------2722.
2953     DIMENSION X(226),F(226) 2723.
2954     DIMENSION OWMUV2(115),OWMUV3(111),OKEUV2(115),OKEUV3(111) 2724.
2955     EQUIVALENCE (X(1),OWMUV2(1)),(X(116),OWMUV3(1)), 2725.
2956     *(F(1),OKEUV2(1)),(F(116),OKEUV3(1)) 2726.
2957     DATA OWMUV2/.2002,.2012,.2022,.2032,.2042,.2052,.2062,.2072,.2082,2727.
2958     $.2092,.2102,.2112,.2122,.2132,.2142,.2152,.2162,.2172,.2182,.2192,2728.
2959     $.2202,.2212,.2222,.2232,.2242,.2252,.2262,.2272,.2282,.2292,.2302,2729.
2960     $.2312,.2322,.2332,.2342,.2352,.2362,.2372,.2382,.2392,.2400,.2402,2730.
2961     $.2412,.2422,.2432,.2438,.2444,.2452,.2458,.2463,.2472,.2478,.2482,2731.
2962     $.2490,.2492,.2500,.2508,.2519,.2527,.2539,.2543,.2553,.2562,.2566,2732.
2963     $.2571,.2575,.2579,.2587,.2597,.2604,.2617,.2624,.2635,.2643,.2650,2733.
2964     $.2654,.2662,.2669,.2675,.2682,.2692,.2695,.2702,.2712,.2718,.2722,2734.
2965     $.2732,.2742,.2746,.2752,.2762,.2772,.2782,.2792,.2802,.2812,.2822,2735.
2966     $.2830,.2842,.2852,.2862,.2872,.2882,.2892,.2902,.2912,.2922,.2932,2736.
2967     $.2942,.2952,.2962,.2972,.2982,.2992,.2998/ 2737.
2968     DATA OWMUV3/.3004,.3016,.3021,.3029,.3036,.3037,.3051,.3053,.3059,2738.
2969     $.3061,.3066,.3075,.3077,.3083,.3085,.3092,.3098,.3100,.3104,.3106,2739.
2970     $.3109,.3112,.3130,.3135,.3146,.3148,.3151,.3154,.3167,.3170,.3173,2740.
2971     $.3176,.3190,.3194,.3199,.3200,.3209,.3210,.3216,.3220,.3223,.3226,2741.
2972     $.3239,.3242,.3245,.3248,.3253,.3255,.3269,.3272,.3275,.3279,.3292,2742.
2973     $.3295,.3299,.3303,.3309,.3312,.3328,.3332,.3334,.3338,.3357,.3365,2743.
2974     $.3369,.3372,.3391,.3395,.3398,.3401,.3417,.3421,.3426,.3430,.3437,2744.
2975     $.3439,.3451,.3455,.3460,.3463,.3466,.3472,.3481,.3485,.3489,.3493,2745.
2976     $.3499,.3501,.3506,.3514,.3521,.3523,.3546,.3550,.3554,.3556,.3561,2746.
2977     $.3567,.3572,.3573,.3588,.3594,.3599,.3600,.3604,.3606,.3639,.3647,2747.
2978     $.3650,.3654,.3660/ 2748.
2979     DATA OKEUV2/ 8.3, 8.3, 8.1, 8.3, 8.6, 9.0, 9.7, 10.8, 11.7,2749.
2980     $ 13.0, 14.3, 16.0, 18.0, 20.6, 23.0, 26.1, 29.3, 32.6, 36.9, 40.8,2750.
2981     $ 46.9, 51.4, 56.7, 63.4, 69.1, 76.6, 84.0, 91.4, 99.9,110.0,118.0,2751.
2982     $126.0,136.0,145.0,154.0,164.0,175.0,186.0,192.0,201.0,210.0,212.0,2752.
2983     $221.0,230.0,239.0,248.0,250.0,259.0,264.0,264.0,273.0,277.0,275.0,2753.
2984     $283.0,283.0,290.0,283.0,297.0,290.0,300.0,290.0,302.0,295.0,283.0,2754.
2985     $293.0,290.0,286.0,297.0,281.0,280.0,271.0,275.0,254.0,264.0,250.0,2755.
2986     $248.0,242.0,228.0,230.0,216.0,213.0,211.0,199.0,188.0,188.0,178.0,2756.
2987     $169.0,153.0,155.0,148.0,136.0,127.0,117.0,108.0, 97.0, 88.7, 81.3,2757.
2988     $ 78.7, 67.9, 61.4, 54.3, 49.6, 43.1, 38.9, 34.6, 30.2, 27.5, 23.9,2758.
2989     $ 21.0, 18.6, 16.2, 14.2, 12.3, 10.7, 9.5/ 2759.
2990     DATA OKEUV3/8.880,7.520,6.960,6.160,5.810,5.910,4.310,4.430,4.130,2760.
2991     $4.310,4.020,3.330,3.390,3.060,3.100,2.830,2.400,2.490,2.330,2.320,2761.
2992     $2.120,2.200,1.436,1.595,1.074,1.138,1.068,1.262,0.818,0.948,0.860,2762.
2993     $1.001,0.543,0.763,0.665,0.781,0.382,0.406,0.373,0.608,0.484,0.601,2763.
2994     $0.209,0.276,0.259,0.470,0.319,0.354,0.131,0.223,0.185,0.339,0.080,2764.
2995     $0.093,0.079,0.184,0.139,0.214,0.053,0.074,0.068,0.152,0.038,0.070,2765.
2996     $.0540000,.1030000,.0240000,.0382500,.0292500,.0550000,.0135000, 2766.
2997     $.0155250,.0127500,.0188250,.0167250,.0262500,.0115500,.0140250, 2767.
2998     $.0099750,.0115500,.0081000,.0104250,.0050100,.0057000,.0046650, 2768.
2999     $.0073425,.0051825,.0055275,.0040575,.0077700,.0048900,.0054600, 2769.
3000     $.0015375,.0017775,.0013275,.0014100,.0011550,.0023325,.0018825, 2770.
3001     $.0019650,.0009600,.0013650,.0011925,.0013200,.0008925,.0009825, 2771.
3002     $.0001350,.0006300,.0004500,.0006225,0.0/ 2772.
3003     C 2773.
3004     C THEKAERAKA SOLAR FLUX 2774.
3005     C 2775.
3006     DIMENSION Y(190),H(190) 2776.
3007     DATA H/.007,.900,.007,.007,.030,.070,.230,.630,1.25,2.71,10.7,2777.
3008     1 22.9,57.5,64.9,66.7,59.3,63.0,72.3,70.4,104.,130.,185.,232.,204.,2778.
3009     2 222.,315.,482.,584.,514.,603.,689.,764.,830.,975.,1059.,1081.,2779.
3010     31074.,1069.,1093.,1083.,1068.,1132.,1181.,1157.,1120.,1098.,1098.,2780.
3011     41189.,1429.,1644.,1751.,1774.,1747.,1693.,1639.,1663.,1810.,1922.,2781.
3012     52006.,2057.,2066.,2048.,2033.,2044.,2074.,1976.,1950.,1960.,1942.,2782.
3013     61920.,1882.,1833.,1833.,1852.,1842.,1818.,1783.,1754.,1725.,1720.,2783.
3014     71695.,1705.,1712.,1719.,1715.,1712.,1700.,1682.,1666.,1647.,1635.,2784.
3015     81602.,1570.,1544.,1511.,1486.,1456.,1427.,1402.,1389.,1344.,1314.,2785.
3016     91290.,1260.,1235.,1211.,1185.,1159.,1134.,1109.,1085.,1060.,1036.,2786.
3017     A1013.,990.,968.,947.,926.,908.,891.,880.,869.,858.,847.,837.,820.,2787.
3018     B 803.,785.,767.,748.,668.,593.,535.,485.,438.,397.,358.,337.,312.,2788.
3019     C 288.,267.,245.,223.,202.,180.,159.,142.,126.,114.,103., 90., 79.,2789.
3020     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.
3021     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.
3022     F 4.11,3.79,1.82,0.99,.585,.367,.241,.165,.117,.0851,.0634,.0481/2792.
3023     DATA Y/.115,.120,.125,.130,.140,.150,.160,.170,.180,.190,.200,2793.
3024     1 .210,.220,.225,.230,.235,.240,.245,.250,.255,.260,.265,.270,.275,2794.
3025     2 .280,.285,.290,.295,.300,.305,.310,.315,.320,.325,.330,.335,2795.
3026     3 .340,.345,.350,.355,.360,.365,.370,.375,.380,.385,.390,2796.
3027     4 .395,.400,.405,.410,.415,.420,.425,.430,.435,.440,.445,2797.
3028     5 .450,.455,.460,.465,.470,.475,.480,.485,.490,.495,.500,2798.
3029     6 .505,.510,.515,.520,.525,.530,.535,.540,.545,.550,.555,2799.
3030     7 .560,.565,.570,.575,.580,.585,.590,.595,.600,.605,.610,2800.
3031     8 .620,.630,.640,.650,.660,.670,.680,.690,.700,.710,.720,2801.
3032     9 .730,.740,.750,.760,.770,.780,.790,.800,.810,.820,.830,2802.
3033     A .840,.850,.860,.870,.880,.890,.900,.910,.920,.930,.940,.950,.960,2803.
3034     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.
3035     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.
3036     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.
3037     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.
3038     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.
3039     NH=190 2809.
3040     NG=226 2810.
3041     XA=X(1) 2811.
3042     XB=X(NG) 2812.
3043     SOLCON=0.1353D0 2813.
3044     ABINT=0.D0 2814.
3045     X2=DMIN1(X(NG),Y(NH)) 2815.
3046     IF(XA.GE.X2) GO TO 160 2816.
3047     X1=DMAX1(X(1),Y(1)) 2817.
3048     IF(XB.LE.X1) GO TO 160 2818.
3049     YA=XA 2819.
3050     IF(XA.LT.X1) YA=X1 2820.
3051     YB=XB 2821.
3052     IF(YB.GT.X2) YB=X2 2822.
3053     DO 100 JG=2,NG 2823.
3054     XJ=X(JG) 2824.
3055     IF(XJ.GT.YA) GO TO 110 2825.
3056     100 CONTINUE 2825.1
3057     JG=NG+1 2825.2
3058     110 IG=JG-1 2826.
3059     XI=X(IG) 2827.
3060     TAU=F(IG)*OCM 2828.
3061     IF(TAU.GT.35.D0) TAU=35.D0 2829.
3062     GI=1.D0-DEXP(-TAU) 2830.
3063     TAU=F(JG)*OCM 2831.
3064     IF(TAU.GT.35.D0) TAU=35.D0 2832.
3065     GJ=1.D0-DEXP(-TAU) 2833.
3066     B=(GJ-GI)/(XJ-XI) 2834.
3067     A=GJ-B*XJ 2835.
3068     DO 120 JH=2,NH 2836.
3069     YJ=Y(JH) 2837.
3070     IF(YJ.GT.YA) GO TO 130 2838.
3071     120 CONTINUE 2838.1
3072     JH=NH+1 2838.2
3073     130 IH=JH-1 2839.
3074     YI=Y(IH) 2840.
3075     HI=H(IH)/10000.D0 2841.
3076     HJ=H(JH)/10000.D0 2842.
3077     D=(HJ-HI)/(YJ-YI) 2843.
3078     C=HJ-D*YJ 2844.
3079     X2=YA 2845.
3080     140 X1=X2 2846.
3081     X2=DMIN1(XJ,YJ) 2847.
3082     DELTA=(XJ-YJ)/(XJ+YJ) 2848.
3083     IF(X2.GT.YB) X2=YB 2849.
3084     DINT=(X2-X1)*(A*C+0.5D0*(B*C+A*D)*(X2+X1)+B*D*(X2*(X2+X1)+X1*X1)/ 2850.
3085     $3.D0) 2851.
3086     ABINT=ABINT+DINT 2852.
3087     IF(X2.GE.YB) GO TO 160 2853.
3088     IF(DELTA.GT.1.D-14) GO TO 150 2854.
3089     XI=XJ 2855.
3090     GI=GJ 2856.
3091     JG=JG+1 2857.
3092     XJ=X(JG) 2858.
3093     TAU=F(JG)*OCM 2859.
3094     IF(TAU.GT.35.D0) TAU=35.D0 2860.
3095     GJ=1.D0-DEXP(-TAU) 2861.
3096     B=(GJ-GI)/(XJ-XI) 2862.
3097     A=GJ-B*XJ 2863.
3098     IF(DABS(DELTA).LE.1.D-14) GO TO 150 2864.
3099     GO TO 140 2865.
3100     150 YI=YJ 2866.
3101     HI=HJ 2867.
3102     JH=JH+1 2868.
3103     YJ=Y(JH) 2869.
3104     HJ=H(JH)/10000.D0 2870.
3105     D=(HJ-HI)/(YJ-YI) 2871.
3106     C=HJ-D*YJ 2872.
3107     GO TO 140 2873.
3108     160 O3UVAB=ABINT/SOLCON 2874.
3109     RETURN 2875.
3110     END 2876.
3111     SUBROUTINE SETO3D 2877.
3112    
3113     #include "B83XX.COM"
3114    
3115     C-----------------------------------------------------------------------2915.
3116     C 2916.
3117     C LONDON ET AL (1976) JUL,1957-DEC,1970 NCAR ATLAS OF TOTAL OZONE2917.
3118     C 2918.
3119     C AVERAGE GLOBAL COLUMN AMOUNT -- O3AVE(MONTH,LATITUDE,LONGITUDE)2919.
3120     C 2920.
3121     C MONTH=1-12 JAN,FEB,...,DEC 2921.
3122     C LAT =1-18 -85,-75,..., 85 2922.
3123     C 2923.
3124     C-----------------------------------------------------------------------2924.
3125     REAL O3AVEA(216),O3AVEB(216),O3AVEC(216),O3AVED(216),O3AVEE(216) 2925.
3126     REAL O3AVEF(216),O3AVEG(216),O3AVEH(216),O3AVEI(216),O3AVEJ(216) 2926.
3127     REAL O3AVEK(216),O3AVEL(216),O3AVEM(216),O3AVEN(216),O3AVEO(216) 2927.
3128     REAL O3AVEP(216),O3AVEQ(216),O3AVER(216),O3AVE(12,18,18) 2928.
3129     EQUIVALENCE (O3AVE(1,1,10),O3AVEA(1)),(O3AVE(1,1,11),O3AVEB(1)) 2929.
3130     1 ,(O3AVE(1,1,12),O3AVEC(1)),(O3AVE(1,1,13),O3AVED(1)) 2930.
3131     2 ,(O3AVE(1,1,14),O3AVEE(1)),(O3AVE(1,1,15),O3AVEF(1)) 2931.
3132     3 ,(O3AVE(1,1,16),O3AVEG(1)),(O3AVE(1,1,17),O3AVEH(1)) 2932.
3133     4 ,(O3AVE(1,1,18),O3AVEI(1)),(O3AVE(1,1,01),O3AVEJ(1)) 2933.
3134     5 ,(O3AVE(1,1,02),O3AVEK(1)),(O3AVE(1,1,03),O3AVEL(1)) 2934.
3135     6 ,(O3AVE(1,1,04),O3AVEM(1)),(O3AVE(1,1,05),O3AVEN(1)) 2935.
3136     7 ,(O3AVE(1,1,06),O3AVEO(1)),(O3AVE(1,1,07),O3AVEP(1)) 2936.
3137     8 ,(O3AVE(1,1,08),O3AVEQ(1)),(O3AVE(1,1,09),O3AVER(1)) 2937.
3138     DATA O3AVEA/ 2938.
3139     A .317,.295,.291,.292,.293,.298,.300,.305,.313,.324,.369,.355, 2939.
3140     B .319,.300,.296,.292,.291,.300,.301,.304,.314,.322,.358,.350, 2940.
3141     C .312,.301,.295,.287,.286,.298,.302,.305,.316,.322,.343,.335, 2941.
3142     D .299,.291,.285,.280,.279,.290,.295,.300,.307,.319,.327,.316, 2942.
3143     E .281,.275,.279,.268,.266,.278,.282,.290,.295,.306,.306,.296, 2943.
3144     F .266,.261,.259,.256,.252,.261,.267,.277,.280,.289,.285,.277, 2944.
3145     G .252,.249,.248,.246,.240,.249,.252,.262,.264,.273,.265,.258, 2945.
3146     H .240,.238,.240,.242,.237,.242,.240,.249,.252,.258,.251,.245, 2946.
3147     I .232,.230,.238,.241,.240,.238,.234,.241,.241,.245,.239,.236, 2947.
3148     J .235,.235,.244,.252,.253,.244,.236,.237,.232,.230,.230,.232, 2948.
3149     K .249,.256,.264,.269,.267,.261,.245,.245,.238,.234,.233,.237, 2949.
3150     L .278,.289,.294,.300,.294,.284,.265,.265,.256,.249,.248,.261, 2950.
3151     M .318,.338,.343,.351,.342,.324,.300,.296,.287,.275,.279,.299, 2951.
3152     N .347,.368,.383,.383,.370,.351,.335,.319,.304,.288,.296,.321, 2952.
3153     O .364,.394,.418,.410,.402,.371,.358,.340,.312,.298,.302,.325, 2953.
3154     P .356,.388,.421,.414,.394,.360,.337,.319,.299,.285,.292,.313, 2954.
3155     Q .364,.403,.431,.426,.398,.358,.328,.303,.292,.287,.297,.324, 2955.
3156     R .373,.421,.447,.440,.408,.355,.323,.295,.289,.291,.305,.329/ 2956.
3157     DATA O3AVEB/ 2957.
3158     A .318,.295,.291,.293,.293,.299,.301,.305,.314,.326,.372,.358, 2958.
3159     B .321,.300,.295,.293,.291,.301,.301,.306,.314,.326,.361,.353, 2959.
3160     C .315,.302,.296,.291,.288,.300,.303,.306,.318,.328,.348,.340, 2960.
3161     D .307,.296,.291,.284,.278,.298,.299,.305,.314,.326,.335,.324, 2961.
3162     E .294,.285,.286,.272,.270,.286,.288,.296,.302,.315,.315,.304, 2962.
3163     F .278,.271,.265,.260,.258,.270,.273,.283,.287,.298,.293,.284, 2963.
3164     G .262,.259,.254,.250,.247,.255,.259,.268,.270,.282,.274,.266, 2964.
3165     H .247,.246,.244,.245,.239,.245,.247,.255,.255,.266,.257,.250, 2965.
3166     I .235,.235,.239,.244,.240,.238,.236,.244,.244,.249,.244,.239, 2966.
3167     J .233,.234,.243,.251,.249,.240,.234,.235,.232,.231,.231,.231, 2967.
3168     K .247,.254,.263,.267,.262,.253,.242,.240,.237,.232,.232,.237, 2968.
3169     L .279,.287,.296,.282,.286,.275,.260,.257,.253,.246,.246,.258, 2969.
3170     M .320,.336,.345,.348,.325,.309,.293,.282,.279,.267,.272,.294, 2970.
3171     N .346,.369,.379,.377,.348,.330,.317,.299,.286,.280,.288,.312, 2971.
3172     O .368,.406,.412,.401,.373,.345,.332,.312,.293,.284,.293,.316, 2972.
3173     P .366,.409,.423,.418,.386,.349,.326,.307,.290,.278,.295,.312, 2973.
3174     Q .366,.407,.428,.429,.396,.352,.323,.296,.287,.282,.298,.318, 2974.
3175     R .372,.420,.446,.441,.407,.352,.320,.292,.286,.290,.305,.327/ 2975.
3176     DATA O3AVEC/ 2976.
3177     A .319,.296,.292,.294,.294,.299,.302,.306,.316,.328,.372,.359, 2977.
3178     B .321,.300,.295,.297,.293,.303,.305,.309,.319,.332,.367,.359, 2978.
3179     C .322,.309,.302,.297,.293,.309,.309,.314,.326,.338,.362,.353, 2979.
3180     D .324,.313,.303,.294,.295,.314,.311,.318,.330,.342,.353,.343, 2980.
3181     E .315,.308,.296,.286,.287,.305,.306,.314,.326,.335,.338,.326, 2981.
3182     F .294,.290,.281,.271,.273,.287,.290,.299,.307,.319,.312,.303, 2982.
3183     G .274,.272,.264,.258,.258,.268,.272,.281,.286,.297,.290,.281, 2983.
3184     H .254,.254,.251,.248,.248,.254,.257,.263,.267,.276,.271,.262, 2984.
3185     I .240,.239,.241,.245,.241,.243,.244,.250,.251,.256,.250,.246, 2985.
3186     J .230,.231,.238,.249,.246,.237,.234,.233,.234,.233,.230,.228, 2986.
3187     K .238,.244,.251,.258,.253,.244,.236,.235,.233,.228,.228,.230, 2987.
3188     L .259,.269,.276,.279,.268,.254,.246,.241,.238,.235,.237,.246, 2988.
3189     M .289,.305,.312,.306,.289,.270,.261,.255,.249,.246,.252,.268, 2989.
3190     N .321,.347,.354,.343,.315,.291,.281,.273,.262,.259,.268,.285, 2990.
3191     O .351,.394,.396,.384,.353,.315,.300,.288,.275,.271,.282,.296, 2991.
3192     P .363,.414,.422,.415,.382,.333,.313,.292,.281,.276,.292,.306, 2992.
3193     Q .366,.415,.430,.433,.398,.346,.313,.288,.282,.280,.299,.317, 2993.
3194     R .372,.421,.445,.441,.406,.348,.316,.289,.285,.289,.306,.327/ 2994.
3195     DATA O3AVED/ 2995.
3196     A .320,.296,.293,.294,.295,.300,.303,.308,.317,.330,.374,.361, 2996.
3197     B .322,.300,.297,.299,.296,.307,.310,.314,.323,.339,.373,.366, 2997.
3198     C .329,.313,.310,.304,.302,.320,.318,.326,.338,.352,.373,.367, 2998.
3199     D .343,.330,.318,.306,.315,.333,.329,.337,.354,.366,.370,.366, 2999.
3200     E .334,.324,.311,.299,.312,.326,.329,.333,.352,.357,.354,.342, 3000.
3201     F .304,.300,.291,.279,.285,.302,.308,.315,.324,.328,.325,.312, 3001.
3202     G .277,.276,.268,.262,.266,.279,.283,.289,.296,.303,.299,.283, 3002.
3203     H .256,.257,.253,.249,.252,.259,.266,.269,.274,.278,.273,.263, 3003.
3204     I .242,.243,.243,.248,.247,.251,.255,.256,.258,.260,.253,.249, 3004.
3205     J .231,.234,.238,.250,.255,.251,.250,.246,.248,.244,.237,.229, 3005.
3206     K .235,.241,.248,.257,.259,.257,.248,.246,.245,.244,.233,.230, 3006.
3207     L .256,.261,.267,.270,.269,.262,.251,.247,.247,.248,.239,.248, 3007.
3208     M .293,.304,.306,.302,.288,.272,.259,.256,.256,.256,.254,.269, 3008.
3209     N .327,.344,.356,.346,.319,.291,.272,.270,.264,.267,.270,.285, 3009.
3210     O .356,.392,.402,.388,.359,.312,.289,.281,.276,.281,.285,.297, 3010.
3211     P .368,.416,.424,.415,.388,.328,.304,.285,.279,.284,.295,.309, 3011.
3212     Q .370,.418,.436,.436,.402,.338,.306,.283,.278,.284,.301,.320, 3012.
3213     R .373,.422,.446,.441,.407,.345,.312,.286,.275,.291,.307,.328/ 3013.
3214     DATA O3AVEE/ 3014.
3215     A .319,.295,.293,.295,.296,.300,.304,.309,.318,.332,.375,.362, 3015.
3216     B .325,.301,.300,.302,.300,.309,.313,.319,.328,.345,.378,.370, 3016.
3217     C .332,.314,.312,.310,.310,.327,.329,.335,.347,.362,.381,.375, 3017.
3218     D .348,.334,.324,.312,.328,.346,.366,.352,.372,.381,.377,.373, 3018.
3219     E .337,.327,.318,.303,.322,.335,.342,.347,.363,.366,.358,.344, 3019.
3220     F .301,.297,.292,.282,.291,.307,.314,.321,.331,.332,.324,.309, 3020.
3221     G .275,.271,.269,.264,.270,.279,.286,.292,.299,.301,.293,.281, 3021.
3222     H .255,.253,.252,.251,.253,.258,.265,.269,.275,.277,.268,.262, 3022.
3223     I .245,.244,.246,.250,.249,.253,.254,.257,.259,.260,.252,.249, 3023.
3224     J .240,.239,.245,.255,.256,.260,.256,.253,.253,.251,.243,.237, 3024.
3225     K .247,.248,.252,.263,.270,.268,.258,.256,.256,.252,.244,.238, 3025.
3226     L .263,.263,.268,.277,.282,.276,.261,.259,.259,.258,.251,.251, 3026.
3227     M .299,.304,.309,.309,.302,.291,.269,.266,.268,.269,.269,.275, 3027.
3228     N .346,.358,.365,.353,.335,.307,.276,.272,.276,.283,.289,.300, 3028.
3229     O .379,.400,.414,.401,.373,.319,.286,.280,.283,.293,.303,.314, 3029.
3230     P .382,.421,.437,.427,.398,.323,.293,.280,.280,.293,.308,.321, 3030.
3231     Q .375,.424,.444,.440,.405,.334,.298,.278,.276,.290,.306,.326, 3031.
3232     R .374,.424,.448,.443,.406,.345,.310,.284,.281,.292,.309,.328/ 3032.
3233     DATA O3AVEF/ 3033.
3234     A .318,.294,.294,.295,.298,.301,.304,.311,.320,.333,.377,.361, 3034.
3235     B .324,.298,.300,.304,.305,.310,.315,.323,.331,.348,.383,.371, 3035.
3236     C .337,.311,.314,.313,.317,.330,.333,.344,.354,.369,.386,.377, 3036.
3237     D .350,.330,.324,.317,.332,.349,.351,.362,.378,.390,.380,.372, 3037.
3238     E .333,.322,.314,.307,.323,.339,.345,.358,.369,.372,.357,.340, 3038.
3239     F .300,.292,.286,.284,.294,.307,.316,.327,.335,.334,.323,.307, 3039.
3240     G .275,.269,.264,.263,.269,.277,.285,.292,.300,.303,.290,.279, 3040.
3241     H .254,.251,.250,.251,.254,.256,.261,.267,.271,.276,.266,.261, 3041.
3242     I .243,.242,.242,.247,.248,.250,.247,.251,.252,.258,.253,.247, 3042.
3243     J .237,.239,.243,.253,.255,.255,.246,.243,.244,.245,.239,.236, 3043.
3244     K .246,.247,.253,.263,.265,.265,.253,.245,.247,.247,.239,.238, 3044.
3245     L .265,.265,.276,.283,.284,.280,.261,.254,.253,.258,.250,.250, 3045.
3246     M .306,.309,.321,.316,.318,.292,.273,.259,.265,.271,.273,.277, 3046.
3247     N .365,.369,.381,.363,.347,.313,.278,.264,.275,.290,.302,.307, 3047.
3248     O .396,.416,.431,.415,.405,.322,.282,.271,.288,.303,.321,.328, 3048.
3249     P .397,.433,.455,.436,.404,.322,.287,.273,.276,.302,.320,.333, 3049.
3250     Q .382,.429,.451,.442,.408,.331,.297,.274,.273,.295,.311,.333, 3050.
3251     R .375,.427,.450,.445,.407,.343,.309,.283,.280,.295,.311,.330/ 3051.
3252     DATA O3AVEG/ 3052.
3253     A .317,.293,.293,.295,.299,.299,.305,.311,.320,.335,.378,.360, 3053.
3254     B .323,.296,.300,.304,.306,.310,.317,.325,.334,.353,.385,.367, 3054.
3255     C .335,.307,.310,.312,.318,.328,.335,.347,.357,.376,.390,.372, 3055.
3256     D .346,.324,.320,.317,.332,.349,.354,.367,.384,.393,.384,.368, 3056.
3257     E .331,.318,.311,.305,.324,.339,.349,.365,.378,.377,.360,.339, 3057.
3258     F .301,.293,.286,.285,.296,.309,.321,.334,.344,.339,.325,.309, 3058.
3259     G .276,.270,.266,.267,.271,.280,.287,.295,.303,.308,.294,.282, 3059.
3260     H .257,.253,.250,.252,.254,.257,.261,.266,.271,.279,.268,.261, 3060.
3261     I .240,.241,.241,.246,.246,.250,.246,.249,.253,.259,.254,.248, 3061.
3262     J .234,.238,.245,.256,.258,.259,.244,.243,.241,.243,.237,.235, 3062.
3263     K .244,.249,.259,.271,.274,.274,.257,.251,.248,.248,.238,.237, 3063.
3264     L .270,.272,.289,.297,.298,.294,.277,.267,.260,.262,.251,.254, 3064.
3265     M .329,.338,.353,.338,.333,.313,.296,.275,.273,.282,.281,.296, 3065.
3266     N .401,.414,.424,.392,.369,.329,.298,.272,.282,.303,.321,.341, 3066.
3267     O .420,.451,.461,.432,.389,.331,.291,.272,.279,.313,.343,.358, 3067.
3268     P .411,.451,.468,.447,.403,.320,.289,.271,.277,.308,.334,.349, 3068.
3269     Q .386,.434,.456,.443,.404,.332,.297,.273,.273,.300,.317,.339, 3069.
3270     R .378,.430,.453,.446,.407,.342,.310,.282,.279,.296,.314,.332/ 3070.
3271     DATA O3AVEH/ 3071.
3272     A .315,.292,.293,.295,.299,.297,.303,.311,.320,.334,.378,.358, 3072.
3273     B .320,.294,.298,.303,.306,.308,.316,.325,.337,.355,.387,.362, 3073.
3274     C .330,.304,.307,.311,.315,.323,.334,.345,.360,.381,.389,.366, 3074.
3275     D .339,.318,.312,.314,.328,.344,.355,.368,.388,.401,.384,.360, 3075.
3276     E .325,.313,.302,.300,.318,.339,.354,.369,.381,.380,.360,.337, 3076.
3277     F .299,.291,.285,.284,.296,.313,.326,.340,.350,.343,.328,.312, 3077.
3278     G .277,.271,.269,.269,.272,.281,.288,.296,.308,.311,.298,.289, 3078.
3279     H .257,.253,.252,.254,.253,.257,.262,.267,.272,.281,.272,.265, 3079.
3280     I .241,.241,.241,.246,.245,.248,.246,.248,.253,.260,.255,.250, 3080.
3281     J .234,.236,.242,.256,.260,.260,.246,.244,.240,.241,.237,.237, 3081.
3282     K .243,.246,.257,.273,.279,.276,.261,.258,.251,.246,.238,.238, 3082.
3283     L .270,.269,.288,.299,.308,.299,.283,.276,.269,.263,.252,.257, 3083.
3284     M .327,.339,.358,.349,.351,.337,.313,.292,.288,.280,.284,.302, 3084.
3285     N .407,.419,.432,.407,.390,.356,.324,.298,.300,.304,.327,.368, 3085.
3286     O .421,.455,.459,.439,.393,.333,.306,.287,.289,.311,.345,.377, 3086.
3287     P .408,.452,.465,.443,.399,.323,.296,.276,.279,.309,.338,.362, 3087.
3288     Q .387,.437,.459,.444,.404,.334,.301,.276,.277,.302,.320,.345, 3088.
3289     R .379,.433,.455,.447,.408,.343,.313,.282,.279,.298,.315,.336/ 3089.
3290     DATA O3AVEI/ 3090.
3291     A .313,.291,.291,.293,.299,.296,.302,.310,.319,.333,.379,.354, 3091.
3292     B .316,.292,.295,.300,.307,.306,.315,.322,.333,.354,.384,.354, 3092.
3293     C .322,.302,.301,.307,.309,.319,.331,.340,.357,.379,.385,.356, 3093.
3294     D .328,.310,.301,.306,.316,.332,.347,.359,.380,.397,.379,.348, 3094.
3295     E .315,.304,.293,.296,.308,.328,.345,.360,.374,.376,.356,.329, 3095.
3296     F .292,.285,.277,.278,.288,.304,.318,.330,.340,.340,.324,.306, 3096.
3297     G .271,.266,.262,.263,.266,.277,.283,.291,.301,.307,.293,.284, 3097.
3298     H .253,.249,.249,.252,.250,.256,.261,.267,.271,.278,.267,.263, 3098.
3299     I .240,.238,.240,.247,.244,.248,.247,.250,.254,.258,.251,.249, 3099.
3300     J .233,.236,.243,.254,.259,.258,.248,.246,.241,.243,.238,.238, 3100.
3301     K .242,.246,.256,.268,.273,.271,.260,.255,.250,.244,.240,.239, 3101.
3302     L .258,.266,.278,.290,.295,.288,.277,.269,.265,.257,.253,.256, 3102.
3303     M .294,.308,.325,.326,.322,.308,.297,.284,.278,.271,.277,.287, 3103.
3304     N .338,.368,.383,.371,.357,.329,.316,.294,.287,.288,.303,.324, 3104.
3305     O .375,.420,.429,.411,.382,.328,.312,.293,.287,.299,.322,.354, 3105.
3306     P .388,.440,.454,.437,.396,.328,.307,.285,.282,.305,.330,.359, 3106.
3307     Q .386,.439,.457,.444,.404,.338,.309,.283,.280,.304,.321,.349, 3107.
3308     R .379,.435,.456,.448,.408,.345,.316,.286,.281,.300,.317,.337/ 3108.
3309     DATA O3AVEJ/ 3109.
3310     A .313,.290,.290,.291,.298,.294,.301,.309,.318,.331,.378,.353, 3110.
3311     B .313,.291,.291,.296,.304,.302,.311,.318,.330,.348,.382,.350, 3111.
3312     C .315,.297,.294,.300,.306,.310,.325,.334,.348,.364,.378,.346, 3112.
3313     D .316,.301,.292,.297,.305,.317,.334,.346,.360,.371,.366,.335, 3113.
3314     E .304,.293,.283,.286,.295,.313,.330,.344,.356,.359,.346,.316, 3114.
3315     F .284,.276,.268,.271,.279,.297,.309,.320,.325,.330,.317,.296, 3115.
3316     G .265,.258,.254,.257,.261,.273,.280,.288,.289,.296,.287,.274, 3116.
3317     H .250,.245,.244,.249,.247,.255,.260,.265,.268,.273,.263,.257, 3117.
3318     I .237,.235,.238,.246,.246,.249,.247,.249,.251,.257,.249,.247, 3118.
3319     J .234,.236,.245,.256,.259,.255,.248,.249,.244,.245,.242,.238, 3119.
3320     K .244,.249,.259,.271,.273,.270,.258,.256,.253,.247,.243,.242, 3120.
3321     L .261,.273,.283,.291,.292,.284,.271,.269,.263,.257,.254,.257, 3121.
3322     M .289,.305,.319,.321,.315,.301,.287,.281,.273,.268,.272,.282, 3122.
3323     N .321,.347,.364,.358,.344,.319,.305,.293,.282,.281,.291,.313, 3123.
3324     O .357,.400,.409,.397,.373,.332,.314,.295,.286,.293,.309,.333, 3124.
3325     P .377,.429,.442,.429,.396,.338,.317,.294,.287,.302,.321,.351, 3125.
3326     Q .385,.439,.458,.443,.407,.345,.318,.292,.284,.304,.322,.349, 3126.
3327     R .380,.437,.458,.449,.408,.348,.319,.289,.283,.301,.319,.340/ 3127.
3328     DATA O3AVEK/ 3128.
3329     A .311,.289,.289,.290,.298,.293,.300,.308,.317,.329,.377,.352, 3129.
3330     B .308,.290,.288,.291,.301,.296,.307,.315,.326,.340,.377,.344, 3130.
3331     C .305,.291,.287,.293,.297,.302,.315,.325,.335,.346,.369,.333, 3131.
3332     D .299,.289,.281,.287,.293,.302,.317,.327,.335,.344,.353,.318, 3132.
3333     E .287,.279,.272,.277,.281,.295,.309,.320,.325,.332,.331,.301, 3133.
3334     F .272,.264,.259,.262,.268,.281,.292,.300,.300,.309,.305,.282, 3134.
3335     G .257,.249,.246,.250,.254,.264,.271,.278,.279,.285,.278,.263, 3135.
3336     H .246,.239,.239,.245,.245,.252,.255,.261,.262,.267,.259,.250, 3136.
3337     I .234,.231,.239,.245,.245,.248,.245,.249,.248,.254,.246,.243, 3137.
3338     J .235,.237,.247,.258,.260,.257,.250,.250,.245,.246,.241,.240, 3138.
3339     K .248,.254,.264,.276,.276,.272,.262,.258,.255,.250,.248,.246, 3139.
3340     L .267,.278,.289,.300,.296,.286,.272,.270,.263,.258,.258,.262, 3140.
3341     M .292,.310,.325,.329,.319,.302,.288,.280,.273,.268,.274,.281, 3141.
3342     N .323,.346,.365,.365,.347,.320,.305,.291,.282,.281,.292,.305, 3142.
3343     O .352,.390,.405,.398,.378,.338,.316,.300,.290,.294,.309,.330, 3143.
3344     P .376,.424,.440,.431,.404,.350,.323,.303,.293,.303,.321,.349, 3144.
3345     Q .386,.442,.462,.448,.411,.354,.324,.298,.289,.306,.325,.349, 3145.
3346     R .381,.441,.459,.452,.410,.352,.322,.293,.286,.301,.320,.342/ 3146.
3347     DATA O3AVEL/ 3147.
3348     A .309,.290,.288,.288,.295,.292,.299,.307,.315,.327,.375,.350, 3148.
3349     B .306,.289,.287,.288,.298,.293,.304,.311,.320,.333,.372,.340, 3149.
3350     C .298,.286,.282,.288,.290,.294,.308,.316,.322,.332,.362,.325, 3150.
3351     D .289,.280,.274,.281,.282,.290,.304,.312,.317,.325,.342,.309, 3151.
3352     E .276,.269,.264,.268,.271,.281,.293,.300,.304,.313,.318,.290, 3152.
3353     F .262,.256,.253,.255,.258,.267,.278,.283,.283,.293,.294,.272, 3153.
3354     G .250,.245,.241,.245,.246,.255,.261,.267,.265,.282,.272,.256, 3154.
3355     H .240,.235,.236,.243,.240,.245,.249,.254,.253,.260,.254,.247, 3155.
3356     I .232,.229,.239,.245,.244,.247,.241,.245,.241,.246,.243,.241, 3156.
3357     J .235,.236,.247,.258,.258,.254,.246,.246,.239,.240,.238,.240, 3157.
3358     K .248,.253,.263,.273,.271,.267,.256,.253,.245,.243,.243,.244, 3158.
3359     L .265,.274,.287,.293,.290,.281,.267,.262,.256,.251,.253,.258, 3159.
3360     M .293,.307,.324,.323,.315,.298,.284,.275,.268,.263,.271,.278, 3160.
3361     N .326,.348,.370,.363,.347,.320,.304,.290,.281,.278,.291,.306, 3161.
3362     O .357,.391,.412,.404,.380,.347,.322,.303,.296,.296,.313,.334, 3162.
3363     P .381,.431,.447,.439,.412,.363,.331,.311,.301,.308,.331,.353, 3163.
3364     Q .389,.449,.470,.456,.417,.363,.329,.306,.296,.308,.331,.354, 3164.
3365     R .382,.441,.462,.454,.413,.354,.325,.296,.289,.301,.319,.343/ 3165.
3366     DATA O3AVEM/ 3166.
3367     A .309,.290,.288,.289,.293,.292,.299,.306,.313,.325,.374,.350, 3167.
3368     B .306,.289,.286,.285,.296,.291,.300,.308,.316,.326,.369,.339, 3168.
3369     C .297,.284,.281,.285,.288,.290,.302,.308,.315,.324,.355,.323, 3169.
3370     D .287,.278,.272,.275,.277,.284,.295,.300,.306,.316,.333,.304, 3170.
3371     E .273,.266,.261,.263,.267,.274,.284,.288,.292,.302,.311,.286, 3171.
3372     F .260,.253,.250,.252,.253,.261,.268,.273,.275,.284,.288,.269, 3172.
3373     G .247,.244,.241,.245,.243,.250,.254,.260,.260,.270,.268,.254, 3173.
3374     H .238,.234,.235,.242,.239,.243,.244,.250,.249,.255,.253,.245, 3174.
3375     I .231,.231,.238,.244,.242,.246,.238,.242,.239,.243,.242,.239, 3175.
3376     J .236,.238,.247,.257,.254,.253,.245,.244,.237,.235,.235,.236, 3176.
3377     K .250,.254,.263,.270,.266,.264,.254,.250,.244,.239,.237,.243, 3177.
3378     L .270,.279,.289,.290,.285,.279,.267,.261,.256,.250,.251,.258, 3178.
3379     M .301,.317,.329,.322,.314,.298,.285,.277,.270,.263,.270,.282, 3179.
3380     N .342,.367,.380,.369,.351,.326,.309,.294,.286,.284,.295,.314, 3180.
3381     O .380,.412,.424,.411,.388,.357,.331,.311,.303,.302,.325,.347, 3181.
3382     P .398,.448,.457,.449,.419,.373,.343,.318,.309,.314,.341,.366, 3182.
3383     Q .396,.456,.480,.466,.424,.370,.338,.311,.303,.311,.336,.363, 3183.
3384     R .384,.442,.464,.456,.414,.358,.327,.297,.290,.302,.322,.344/ 3184.
3385     DATA O3AVEN/ 3185.
3386     A .311,.291,.287,.288,.293,.292,.297,.305,.312,.325,.373,.350, 3186.
3387     B .307,.290,.286,.285,.293,.292,.300,.305,.315,.326,.366,.341, 3187.
3388     C .300,.287,.283,.282,.288,.292,.300,.306,.313,.324,.351,.323, 3188.
3389     D .290,.281,.274,.276,.279,.285,.293,.298,.303,.315,.330,.308, 3189.
3390     E .276,.272,.265,.264,.267,.274,.281,.287,.288,.302,.309,.289, 3190.
3391     F .263,.259,.254,.253,.257,.262,.267,.272,.274,.285,.287,.273, 3191.
3392     G .252,.247,.244,.248,.247,.252,.254,.260,.262,.270,.268,.259, 3192.
3393     H .243,.238,.239,.244,.241,.245,.245,.251,.251,.257,.253,.249, 3193.
3394     I .236,.233,.238,.244,.244,.246,.238,.243,.242,.245,.243,.242, 3194.
3395     J .237,.241,.247,.256,.255,.254,.245,.245,.242,.234,.234,.236, 3195.
3396     K .252,.259,.266,.271,.269,.269,.257,.256,.251,.242,.240,.245, 3196.
3397     L .277,.286,.296,.298,.292,.290,.276,.275,.267,.259,.259,.267, 3197.
3398     M .323,.342,.352,.339,.333,.319,.303,.298,.288,.280,.285,.296, 3198.
3399     N .374,.403,.413,.392,.376,.351,.332,.319,.306,.303,.317,.340, 3199.
3400     O .408,.448,.448,.433,.410,.375,.351,.330,.317,.318,.343,.368, 3200.
3401     P .418,.467,.473,.464,.426,.383,.347,.328,.316,.319,.347,.376, 3201.
3402     Q .402,.459,.482,.474,.426,.374,.343,.313,.306,.313,.338,.368, 3202.
3403     R .384,.440,.463,.458,.415,.360,.328,.299,.291,.301,.319,.344/ 3203.
3404     DATA O3AVEO/ 3204.
3405     A .313,.291,.288,.288,.292,.292,.298,.305,.312,.324,.364,.351, 3205.
3406     B .311,.294,.289,.286,.294,.293,.302,.306,.316,.326,.358,.345, 3206.
3407     C .308,.296,.291,.286,.294,.297,.303,.310,.316,.330,.354,.331, 3207.
3408     D .301,.292,.284,.282,.286,.295,.301,.307,.310,.326,.334,.318, 3208.
3409     E .290,.283,.274,.273,.276,.286,.291,.297,.299,.314,.314,.302, 3209.
3410     F .280,.272,.266,.263,.264,.272,.277,.283,.286,.297,.295,.286, 3210.
3411     G .267,.261,.256,.254,.255,.260,.263,.268,.272,.280,.276,.271, 3211.
3412     H .254,.250,.249,.249,.247,.251,.251,.256,.259,.264,.261,.258, 3212.
3413     I .242,.242,.243,.245,.244,.248,.242,.247,.248,.252,.248,.248, 3213.
3414     J .237,.242,.249,.256,.255,.255,.245,.244,.243,.237,.236,.236, 3214.
3415     K .253,.256,.267,.271,.270,.270,.259,.258,.252,.245,.242,.248, 3215.
3416     L .279,.283,.296,.296,.294,.292,.280,.279,.269,.260,.260,.268, 3216.
3417     M .327,.339,.357,.345,.338,.328,.319,.309,.293,.284,.285,.302, 3217.
3418     N .386,.409,.421,.405,.388,.363,.346,.332,.314,.311,.319,.348, 3218.
3419     O .419,.450,.459,.445,.418,.384,.361,.338,.322,.320,.340,.373, 3219.
3420     P .419,.461,.473,.468,.423,.358,.358,.331,.316,.319,.343,.376, 3220.
3421     Q .401,.453,.477,.469,.423,.375,.345,.314,.307,.312,.333,.361, 3221.
3422     R .382,.437,.461,.455,.415,.361,.329,.299,.291,.301,.316,.341/ 3222.
3423     DATA O3AVEP/ 3223.
3424     A .314,.293,.289,.290,.292,.294,.299,.305,.312,.323,.363,.352, 3224.
3425     B .315,.298,.293,.290,.294,.299,.303,.307,.316,.324,.365,.350, 3225.
3426     C .315,.303,.296,.291,.300,.306,.311,.316,.323,.336,.360,.341, 3226.
3427     D .308,.301,.293,.291,.297,.308,.312,.318,.324,.337,.345,.329, 3227.
3428     E .299,.292,.284,.283,.285,.299,.306,.311,.317,.326,.327,.314, 3228.
3429     F .285,.280,.272,.272,.274,.284,.293,.296,.301,.308,.306,.297, 3229.
3430     G .272,.266,.262,.261,.262,.269,.275,.280,.283,.289,.284,.280, 3230.
3431     H .256,.253,.251,.251,.251,.255,.256,.264,.266,.271,.267,.263, 3231.
3432     I .241,.242,.244,.245,.245,.248,.245,.251,.251,.255,.252,.251, 3232.
3433     J .236,.239,.247,.253,.253,.251,.242,.244,.239,.237,.235,.236, 3233.
3434     K .248,.250,.262,.267,.264,.262,.254,.250,.244,.240,.235,.239, 3234.
3435     L .268,.270,.286,.287,.284,.278,.267,.264,.256,.250,.245,.256, 3235.
3436     M .301,.308,.329,.322,.317,.300,.297,.281,.272,.264,.263,.279, 3236.
3437     N .351,.362,.380,.372,.360,.337,.320,.305,.295,.285,.287,.316, 3237.
3438     O .383,.406,.427,.415,.391,.365,.345,.324,.310,.304,.310,.342, 3238.
3439     P .393,.428,.450,.441,.404,.373,.353,.324,.310,.310,.321,.356, 3239.
3440     Q .387,.435,.461,.456,.412,.370,.341,.313,.303,.306,.321,.353, 3240.
3441     R .381,.432,.457,.452,.413,.361,.328,.299,.291,.298,.314,.338/ 3241.
3442     DATA O3AVEQ/ 3242.
3443     A .315,.293,.289,.291,.293,.295,.298,.305,.312,.323,.362,.354, 3243.
3444     B .316,.301,.295,.291,.294,.300,.303,.307,.316,.322,.361,.350, 3244.
3445     C .318,.305,.297,.292,.298,.306,.311,.314,.324,.334,.354,.340, 3245.
3446     D .309,.301,.292,.289,.295,.305,.312,.317,.326,.335,.343,.326, 3246.
3447     E .295,.288,.279,.279,.284,.297,.305,.305,.316,.321,.324,.310, 3247.
3448     F .279,.272,.266,.269,.272,.281,.289,.291,.299,.303,.305,.293, 3248.
3449     G .263,.259,.254,.257,.259,.266,.273,.276,.281,.285,.284,.277, 3249.
3450     H .247,.246,.244,.248,.247,.252,.253,.261,.265,.269,.267,.259, 3250.
3451     I .235,.236,.239,.244,.243,.246,.243,.247,.251,.253,.249,.246, 3251.
3452     J .231,.234,.243,.250,.251,.247,.240,.238,.233,.234,.232,.233, 3252.
3453     K .242,.244,.257,.262,.260,.255,.247,.243,.235,.235,.228,.233, 3253.
3454     L .257,.263,.278,.280,.275,.269,.258,.252,.242,.239,.235,.243, 3254.
3455     M .280,.288,.308,.307,.299,.287,.274,.267,.255,.250,.246,.259, 3255.
3456     N .309,.319,.348,.340,.332,.309,.293,.286,.273,.264,.261,.282, 3256.
3457     O .339,.357,.388,.376,.360,.334,.320,.305,.289,.282,.279,.306, 3257.
3458     P .365,.393,.424,.411,.386,.355,.340,.316,.300,.303,.297,.329, 3258.
3459     Q .375,.415,.445,.439,.404,.365,.336,.310,.298,.299,.306,.338, 3259.
3460     R .379,.428,.453,.447,.412,.360,.326,.298,.291,.296,.310,.335/ 3260.
3461     DATA O3AVER/ 3261.
3462     A .316,.295,.291,.292,.292,.296,.299,.305,.313,.323,.361,.355, 3262.
3463     B .317,.301,.296,.292,.292,.300,.302,.305,.314,.319,.358,.348, 3263.
3464     C .316,.303,.295,.289,.291,.301,.306,.307,.317,.324,.348,.336, 3264.
3465     D .303,.294,.286,.283,.285,.296,.304,.304,.313,.322,.333,.318, 3265.
3466     E .283,.277,.272,.272,.273,.284,.290,.296,.302,.309,.314,.299, 3266.
3467     F .265,.262,.259,.259,.259,.268,.274,.282,.286,.293,.293,.279, 3267.
3468     G .252,.249,.248,.249,.247,.253,.258,.265,.272,.277,.273,.265, 3268.
3469     H .241,.238,.240,.242,.241,.244,.246,.252,.257,.260,.256,.249, 3269.
3470     I .231,.229,.238,.241,.241,.242,.237,.242,.244,.247,.242,.239, 3270.
3471     J .231,.233,.242,.249,.251,.246,.237,.235,.230,.230,.229,.230, 3271.
3472     K .241,.250,.257,.265,.262,.257,.245,.243,.234,.230,.229,.231, 3272.
3473     L .260,.273,.281,.285,.280,.272,.257,.256,.245,.238,.237,.245, 3273.
3474     M .285,.302,.312,.314,.305,.294,.278,.277,.262,.252,.251,.262, 3274.
3475     N .310,.331,.347,.346,.336,.320,.303,.298,.281,.267,.267,.283, 3275.
3476     O .331,.354,.383,.378,.364,.342,.324,.315,.293,.278,.279,.297, 3276.
3477     P .350,.379,.414,.398,.381,.343,.335,.317,.299,.287,.285,.311, 3277.
3478     Q .367,.404,.436,.428,.399,.361,.332,.307,.295,.293,.298,.327, 3278.
3479     R .376,.424,.450,.442,.409,.358,.326,.296,.290,.294,.306,.332/ 3279.
3480     C 3280.
3481     DIMENSION AO3AVE(18,12),SO3JF(11,19),SO3SO(11,19) 3281.
3482     DATA AO3AVE/ .3148,.3160,.3171,.3159,.3027,.2824,.2645,3282.
3483     A.2493,.2376,.2344,.2455,.2667,.3038,.3467,.3753,.3842,.3817,.3780,3283.
3484     B.2926,.2959,.3008,.3035,.2943,.2763,.2600,.2463,.2366,.2366,.2500,3284.
3485     C.2735,.3166,.3661,.4076,.4270,.4310,.4309,.2904,.2937,.2974,.2959,3285.
3486     D.2869,.2704,.2561,.2454,.2403,.2443,.2590,.2844,.3293,.3803,.4210,3286.
3487     E.4439,.4534,.4539,.2918,.2943,.2965,.2940,.2834,.2687,.2561,.2476,3287.
3488     F.2450,.2538,.2676,.2888,.3259,.3692,.4077,.4325,.4454,.4476,.2951,3288.
3489     G.2979,.2994,.3001,.2904,.2731,.2575,.2467,.2441,.2548,.2675,.2873,3289.
3490     H.3181,.3517,.3828,.4002,.4080,.4096,.2960,.3012,.3084,.3132,.3044,3290.
3491     I.2852,.2660,.2515,.2465,.2521,.2641,.2802,.3023,.3257,.3417,.3457,3291.
3492     J.3521,.3517,.3008,.3070,.3153,.3211,.3127,.2934,.2714,.2545,.2437,3292.
3493     K.2440,.2528,.2665,.2875,.3064,.3191,.3222,.3210,.3201,.3074,.3126,3293.
3494     L.3221,.3276,.3211,.3015,.2783,.2603,.2478,.2431,.2499,.2624,.2784,3294.
3495     M.2928,.3024,.3017,.2954,.2914,.3156,.3224,.3326,.3391,.3300,.3071,3295.
3496     N.2827,.2632,.2489,.2399,.2455,.2566,.2720,.2854,.2939,.2931,.2889,3296.
3497     O.2854,.3282,.3354,.3456,.3504,.3368,.3124,.2899,.2692,.2532,.2389,3297.
3498     P.2415,.2521,.2672,.2844,.2967,.3003,.2986,.2966,.3723,.3713,.3661,3298.
3499     Q.3538,.3332,.3072,.2826,.2626,.2481,.2359,.2373,.2489,.2700,.2936,3299.
3500     R.3113,.3172,.3154,.3130,.3554,.3533,.3467,.3353,.3146,.2925,.2723,3300.
3501     S.2562,.2450,.2350,.2387,.2554,.2828,.3140,.3331,.3406,.3408,.3351/3301.
3502     C 3302.
3503     DATA SO3JF/ 3303.
3504     A 13.0,12.3,11.7,10.5,8.90,6.20,4.50,3.30,2.20,1.80,1.00, 3304.
3505     B 13.6,12.9,11.9,10.3,8.30,6.10,4.45,3.40,2.50,1.85,1.00, 3305.
3506     C 14.8,13.9,12.8,10.3,8.00,6.00,4.55,3.60,2.70,1.90,1.00, 3306.
3507     D 16.6,15.1,14.0,11.0,7.95,6.00,4.65,3.70,2.95,1.95,1.00, 3307.
3508     E 18.1,16.0,14.6,12.0,8.00,6.00,4.80,3.75,3.00,1.98,1.00, 3308.
3509     F 18.3,16.3,14.8,12.6,8.20,6.15,4.80,3.80,3.05,2.00,1.00, 3309.
3510     G 17.3,16.1,14.7,12.7,9.10,6.10,4.70,3.75,3.00,2.00,1.00, 3310.
3511     H 16.3,15.5,14.5,12.6,9.00,6.00,4.55,3.65,2.95,1.98,1.00, 3311.
3512     I 15.7,14.9,14.1,12.4,8.70,5.90,4.40,3.45,2.80,1.96,1.00, 3312.
3513     J 15.3,14.1,13.5,12.2,8.30,5.85,4.25,3.40,2.75,1.95,1.00, 3313.
3514     K 15.6,14.9,14.0,12.4,9.00,6.10,4.55,3.50,2.85,1.96,1.00, 3314.
3515     L 17.4,16.6,16.0,14.0,10.0,7.30,5.10,3.90,3.00,1.97,1.00, 3315.
3516     M 17.6,18.3,17.8,15.8,12.3,9.00,6.05,4.40,3.20,1.97,1.00, 3316.
3517     N 16.0,16.9,17.8,16.8,15.2,12.0,7.90,5.10,3.65,1.97,1.00, 3317.
3518     O 12.3,13.8,15.7,16.2,16.2,14.8,10.0,6.00,4.00,1.96,1.00, 3318.
3519     P 12.0,11.9,12.0,13.8,14.3,14.3,12.0,6.80,4.30,1.95,1.00, 3319.
3520     Q 11.9,11.8,11.7,11.6,11.8,12.0,10.3,7.20,4.50,1.90,1.00, 3320.
3521     R 11.6,11.5,11.4,11.2,11.0,10.4,9.00,7.20,4.15,1.85,1.00, 3321.
3522     S 11.2,10.9,10.7,10.5,10.0,9.75,8.60,7.00,3.80,1.80,1.00/ 3322.
3523     DATA SO3SO/ 3323.
3524     A 10.5,10.5,10.5,10.6,10.5,10.3,8.20,4.80,3.10,1.90,1.00, 3324.
3525     B 11.5,11.5,11.6,12.1,12.1,10.8,8.05,4.95,3.40,1.92,1.00, 3325.
3526     C 12.7,13.8,14.0,14.1,12.9,10.9,7.95,5.10,3.70,1.96,1.00, 3326.
3527     D 15.4,15.9,16.0,15.4,13.2,10.7,7.40,5.15,3.85,1.98,1.00, 3327.
3528     E 17.9,18.0,17.4,16.1,13.0,10.0,6.70,4.90,3.80,1.99,1.00, 3328.
3529     F 18.3,18.6,17.8,16.1,12.1,9.10,5.95,4.80,3.70,2.00,1.00, 3329.
3530     G 18.6,18.5,17.8,15.9,11.1,8.00,5.55,4.40,3.45,2.00,1.00, 3330.
3531     H 18.2,18.1,17.2,15.1,10.3,7.40,5.10,4.00,3.10,1.99,1.00, 3331.
3532     I 17.5,16.8,16.2,14.0,9.90,7.00,4.90,3.85,2.95,1.98,1.00, 3332.
3533     J 16.5,15.8,15.0,12.9,9.40,6.65,4.80,3.70,2.90,1.96,1.00, 3333.
3534     K 16.3,15.8,15.0,12.9,9.20,6.80,5.00,3.85,2.95,1.96,1.00, 3334.
3535     L 16.4,16.2,15.8,14.0,9.80,7.10,5.10,3.95,3.00,1.96,1.00, 3335.
3536     M 16.6,16.5,16.2,14.8,10.8,7.75,5.50,4.05,3.05,1.97,1.00, 3336.
3537     N 16.5,16.6,16.5,16.0,12.1,9.00,6.00,4.40,3.10,1.97,1.00, 3337.
3538     O 15.8,16.2,16.4,16.1,14.2,10.9,6.60,4.50,3.20,1.97,1.00, 3338.
3539     P 12.2,14.2,15.5,15.3,14.7,12.4,7.40,4.70,3.10,1.96,1.00, 3339.
3540     Q 11.6,11.9,12.1,14.0,13.9,12.3,8.00,4.40,2.95,1.90,1.00, 3340.
3541     R 11.2,11.2,11.4,11.6,11.8,10.9,8.00,3.95,2.60,1.87,1.00, 3341.
3542     S 11.0,10.8,10.5,10.3,10.1,9.70,7.00,3.65,2.20,1.80,1.00/ 3342.
3543     C 3343.
3544     DIMENSION XJDMO(14),HKMSPR(14),HKMAUT(14) 3344.
3545     DIMENSION CNCAUT(14),CNCSPR(14),DEGLAT(14) 3345.
3546     DATA DEGLAT/-85.0,-71.0,-59.0,-47.0,-35.0,-22.0,-9.0, 3346.
3547     + 9.0,22.0,35.0,47.0,59.0,71.0,85.0/ 3347.
3548     DATA XJDMO/-15.0,16.0,45.0,75.0,105.0,136.0,166.0,197.0,228.0 3348.
3549     + ,258.0,289.0,319.0,350.0,381.0/ 3349.
3550     DATA HKMSPR/18.5,18.5,19.0,23.5,24.0,24.5,26.5, 3350.
3551     + 26.5,25.0,22.5,21.0,20.0,18.5,16.5/ 3351.
3552     DATA HKMAUT/16.5,18.5,20.0,21.0,22.5,25.0,26.5, 3352.
3553     + 26.5,24.5,24.0,23.5,19.0,18.5,18.5/ 3353.
3554     DATA CNCSPR/0.0181,0.0212,0.0187,0.0167,0.0162,0.0183,0.0175, 3354.
3555     + 0.0187,0.0200,0.0196,0.0225,0.0291,0.0287,0.0300/ 3355.
3556     DATA CNCAUT/0.0300,0.0287,0.0291,0.0225,0.0196,0.0200,0.0187, 3356.
3557     + 0.0175,0.0183,0.0162,0.0167,0.0187,0.0212,0.0181/ 3357.
3558     C 3358.
3559     DIMENSION PLBSO3(11),SOJDAY(6),PMLAT(6) 3359.
3560     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.
3561     DATA SOJDAY/-91.,31.,92.,213.,274.,396./ 3361.
3562     DATA PMLAT/1.,1.,-1.,-1.,1.,1./ 3362.
3563     DIMENSION AO3JIM(144),O3LB(40),PLB0(40) 3363.
3564     DIMENSION CONCS(144),CONCA(144),BHKMS(144),BHKMA(144) 3364.
3565     DIMENSION WTJLAT(144),WTJLON(144),ILATIJ(144),ILONIJ(144) 3365.
3566     DIMENSION WTLSEP(144),WTLJAN(144),LSEPJ(144),LJANJ(144) 3366.
3567     DATA ACMMGG/2.37251E-4/,ACMPKM/7.1509E-4/,H10MB/31.05467/ 3367.
3568     DATA A,B,C,D/0.331,23.0,4.553,5.23/ 3368.
3569     LOGICAL SKIPI 3369.
3570     C 3370.
3571     C-----------------------------------------------------------------------3371.
3572     C----SET O3 VERTICAL PROFILE PARAMETERS FOR LATITUDE GCM GRID POINTS 3372.
3573     C-----------------------------------------------------------------------3373.
3574     SKIPI =.FALSE. 3374.
3575     IF(ABS(FLONO3).LT.1.E-04) SKIPI =.TRUE. 3375.
3576     DO 100 L=1,NL 3376.
3577     100 PLB0(L)=PLB(L) 3377.
3578     DO 103 J=1,JMLAT 3378.
3579     DLATJ=DLAT(J) 3379.
3580     ILATI=(DLATJ+95.001)/10. 3380.
3581     IF(ILATI.LT. 1) ILATI= 1 3381.
3582     IF(ILATI.GT.17) ILATI=17 3382.
3583     ILATIJ(J)=ILATI 3383.
3584     LATD=ILATI*10-95 3384.
3585     WTJL=(DLATJ-LATD)*0.1 3385.
3586     WTJLAT(J)=WTJL 3386.
3587     DO 101 JJ=2,14 3387.
3588     II=JJ-1 3388.
3589     IF(DLATJ.LE.DEGLAT(JJ)) GO TO 102 3389.
3590     101 CONTINUE 3389.1
3591     JJ=14 3390.
3592     102 WTJJ=(DLATJ-DEGLAT(II))/(DEGLAT(JJ)-DEGLAT(II)) 3391.
3593     WTII=1.-WTJJ 3392.
3594     CONCS(J)=WTII*CNCSPR(II)+WTJJ*CNCSPR(JJ) 3393.
3595     CONCA(J)=WTII*CNCAUT(II)+WTJJ*CNCAUT(JJ) 3394.
3596     BHKMS(J)=WTII*HKMSPR(II)+WTJJ*HKMSPR(JJ) 3395.
3597     103 BHKMA(J)=WTII*HKMAUT(II)+WTJJ*HKMAUT(JJ) 3396.
3598     C 3397.
3599     DO 104 I=1,IMLON 3398.
3600     DLONI=DLON(I) 3399.
3601     ILONG=DLONI/20.0 3400.
3602     WTJLG=(DLONI-ILONG*20)/20.0 3401.
3603     WTJLON(I)=WTJLG 3402.
3604     WTILG=1.-WTJLG 3403.
3605     ILONG=ILONG+1 3404.
3606     JLONG=ILONG+1 3405.
3607     IF(ILONG.GT.18) ILONG=18 3406.
3608     IF(ILONG.GT.17) JLONG=1 3407.
3609     104 ILONIJ(I)=ILONG 3408.
3610     NLAY=LASTVC/100000 3409.
3611     NATM=(LASTVC-NLAY*100000)/10000 3410.
3612     IF(NATM.GT.0) GO TO 106 3411.
3613     C 3412.
3614     O3B=0.343 3413.
3615     DO 105 L=1,NL 3414.
3616     HLT=HLB(L+1) 3415.
3617     O3T=A*(1.0+EXP(-B/C))/(1.0+EXP((HLT-B)/C))+(0.343-A)*EXP(-HLT/D) 3416.
3618     U0GAS(L,3)=(O3B-O3T) 3417.
3619     105 O3B=O3T 3418.
3620     C 3419.
3621     106 AO3J=0.0 3420.
3622     RETURN 3421.
3623     C-----------------------------------------------------------------------3422.
3624     ENTRY O3DDAY 3423.
3625     C-----------------------------------------------------------------------3424.
3626     XJDAY=JDAY 3425.
3627     WTAUT=(XJDAY-91.)/213. 3426.
3628     IF(XJDAY.LT. 91.) WTAUT=( 91.-XJDAY)/152. 3427.
3629     IF(XJDAY.GT.304.) WTAUT=(456.-XJDAY)/152. 3428.
3630     WTSPR=1.-WTAUT 3429.
3631     DO 200 JMO=1,14 3430.
3632     XJDMJ=XJDMO(JMO) 3431.
3633     IF(XJDAY.LT.XJDMJ) GO TO 201 3432.
3634     200 XJDMI=XJDMJ 3433.
3635     XJDMI=XJDMO(13) 3434.
3636     201 DAYMO=XJDMJ-XJDMI 3435.
3637     WTJM=(XJDAY-XJDMI)/DAYMO 3436.
3638     WTIM=1.-WTJM 3437.
3639     JMO=JMO-1 3438.
3640     IMO=JMO-1 3439.
3641     IF(IMO.LT.1) IMO=12 3440.
3642     IF(JMO.GT.12) JMO=1 3441.
3643     JJDAY=1 3442.
3644     SJDAY=SOJDAY(JJDAY) 3443.
3645     202 JJDAY=JJDAY+1 3444.
3646     SIDAY=SJDAY 3445.
3647     SJDAY=SOJDAY(JJDAY) 3446.
3648     IF(XJDAY.GT.SJDAY) GO TO 202 3447.
3649     WTJAN=(XJDAY-SIDAY)/(SJDAY-SIDAY) 3448.
3650     IF(JJDAY.EQ.3.OR.JJDAY.EQ.5) WTJAN=1.-WTJAN 3449.
3651     WTSEP=1.0-WTJAN 3450.
3652     DO 203 J=1,JMLAT 3451.
3653     DLATJ=DLAT(J) 3452.
3654     DLSEP=10.0+0.099999*DLATJ*PMLAT(JJDAY) 3453.
3655     DLJAN=10.0+0.099999*DLATJ*PMLAT(JJDAY-1) 3454.
3656     LSEP=DLSEP 3455.
3657     LJAN=DLJAN 3456.
3658     LJANJ(J)=LJAN 3457.
3659     LSEPJ(J)=LSEP 3458.
3660     WTLSEP(J)=DLSEP-LSEP 3459.
3661     203 WTLJAN(J)=DLJAN-LJAN 3460.
3662     IF(AO3J.GT.1.E-10) GO TO 400 3461.
3663     C 3462.
3664     C-----------------------------------------------------------------------3463.
3665     ENTRY O3DLAT 3464.
3666     C-----------------------------------------------------------------------3465.
3667     ILATI=ILATIJ(JLAT) 3466.
3668     WTJL=WTJLAT(JLAT) 3467.
3669     WTIL=1.-WTJL 3468.
3670     JLATI=ILATI+1 3469.
3671     LSEP=LSEPJ(JLAT) 3470.
3672     LJAN=LJANJ(JLAT) 3471.
3673     WTLS=WTLSEP(JLAT) 3472.
3674     WTLJ=WTLJAN(JLAT) 3473.
3675     AO3J=WTIM*(WTIL*AO3AVE(ILATI,IMO)+WTJL*AO3AVE(JLATI,IMO)) 3474.
3676     + +WTJM*(WTIL*AO3AVE(ILATI,JMO)+WTJL*AO3AVE(JLATI,JMO)) 3475.
3677     BHKMJ=WTSPR*BHKMS(JLAT)+WTAUT*BHKMA(JLAT) 3476.
3678     CONCJ=WTSPR*CONCS(JLAT)+WTAUT*CONCA(JLAT) 3477.
3679     AO3JJ=AO3J 3478.
3680     IF(SKIPI) GO TO 400 3479.
3681     DO 300 I=1,IMLON 3480.
3682     ILONG=ILONIJ(I) 3481.
3683     JLONG=ILONG+1 3482.
3684     IF(JLONG.GT.18) JLONG=1 3483.
3685     WTJLG=WTJLON(I) 3484.
3686     WTILG=1.0-WTJLG 3485.
3687     AO3J=WTIM*(WTIL*(WTILG*O3AVE(IMO,ILATI,ILONG) 3486.
3688     + +WTJLG*O3AVE(IMO,ILATI,JLONG)) 3487.
3689     + +WTJL*(WTILG*O3AVE(IMO,JLATI,ILONG) 3488.
3690     + +WTJLG*O3AVE(IMO,JLATI,JLONG))) 3489.
3691     + +WTJM*(WTIL*(WTILG*O3AVE(JMO,ILATI,ILONG) 3490.
3692     + +WTJLG*O3AVE(JMO,ILATI,JLONG)) 3491.
3693     + +WTJL*(WTILG*O3AVE(JMO,JLATI,ILONG) 3492.
3694     + +WTJLG*O3AVE(JMO,JLATI,JLONG))) 3493.
3695     300 AO3JIM(I)=AO3J 3494.
3696     AO3J=AO3JJ 3495.
3697     C 3496.
3698     C-----------------------------------------------------------------------3497.
3699     ENTRY O3DLON 3498.
3700     C-----------------------------------------------------------------------3499.
3701     C 3500.
3702     IF(SKIPI) RETURN 3501.
3703     AO3J=AO3JJ+ABS((AO3JIM(ILON)-AO3JJ))*FLONO3 3502.
3704     C 3503.
3705     400 CKMJ=0.25*AO3J/CONCJ 3504.
3706     GTOP=0.0 3505.
3707     POI=0.0 3506.
3708     FI=0.0 3507.
3709     L=NL 3508.
3710     PLL=PLB0(L) 3509.
3711     J=12 3510.
3712     401 J=J-1 3511.
3713     IF(J.LT.1) GO TO 404 3512.
3714     POJ=PLBSO3(J) 3513.
3715     FJ=WTSEP*(WTLS*SO3SO(J,LSEP+1)+(1.-WTLS)*SO3SO(J,LSEP)) 3514.
3716     + +WTJAN*(WTLJ*SO3JF(J,LJAN+1)+(1.-WTLJ)*SO3JF(J,LJAN)) 3515.
3717     402 DP=POJ-POI 3516.
3718     IF(POJ.GT.PLL) GO TO 403 3517.
3719     GTOP=GTOP+(FI+FJ)*DP*ACMMGG 3518.
3720     POI=POJ 3519.
3721     FI=FJ 3520.
3722     GO TO 401 3521.
3723     403 FF=(FJ-FI)/DP 3522.
3724     DP=PLL-POI 3523.
3725     FF=FI+FF*DP 3524.
3726     GTOP=GTOP+(FI+FF)*DP*ACMMGG 3525.
3727     POI=PLL 3526.
3728     FI=FF 3527.
3729     O3LB(L)=GTOP 3528.
3730     L=L-1 3529.
3731     PLL=PLB0(L) 3530.
3732     GO TO 402 3531.
3733     404 FI=FJ*ACMPKM 3532.
3734     HI=H10MB 3533.
3735     HJ=BHKMJ+CKMJ 3534.
3736     XPBC=EXP(-BHKMJ/CKMJ) 3535.
3737     XPHC=EXP(HJ/CKMJ) 3536.
3738     DTERM=1.0+XPHC*XPBC 3537.
3739     ATERM=(1.0+XPBC)/DTERM 3538.
3740     FTERM=ATERM/DTERM*XPHC*XPBC/CKMJ 3539.
3741     TTERM=AO3J-GTOP-FI*(HI-HJ)*0.5 3540.
3742     AA=TTERM/(FTERM*(HI-HJ)*0.5+1.0-ATERM) 3541.
3743     FJ=AA*FTERM 3542.
3744     GTOPBC=GTOP+(FI+FJ)*(HI-HJ)*0.5-AA*ATERM 3543.
3745     TOP=AA*(1.0+XPBC) 3544.
3746     GO TO 406 3545.
3747     405 DH=HI-HJ 3546.
3748     FF=(FJ-FI)/DH 3547.
3749     DH=HI-H 3548.
3750     FF=FI+FF*DH 3549.
3751     GTOP=GTOP+(FI+FF)*DH*0.5 3550.
3752     HI=H 3551.
3753     FI=FF 3552.
3754     O3LB(L)=GTOP 3553.
3755     L=L-1 3554.
3756     406 CONTINUE 3555.
3757     H=HLB(L) 3556.
3758     IF(H.GT.HJ) GO TO 405 3557.
3759     O3LB(L)=TOP/(1.+XPBC*EXP(H/CKMJ))+GTOPBC 3558.
3760     L=L-1 3559.
3761     IF(L.GT.0) GO TO 406 3560.
3762     O3LB(NLP)=0. 3561.
3763     DO 407 L=1,NL 3562.
3764     407 U0GAS(L,3)=(O3LB(L)-O3LB(L+1)) 3563.
3765     RETURN 3564.
3766     END 3565.
3767     BLOCK DATA 3566.
3768    
3769     #include "B83XX.COM"
3770    
3771     C-----------------------------------------------------------------------3597.
3772     C SEASONAL ALBEDOS FOR 11 VEGETATION TYPES 3598.
3773     C-----------------------------------------------------------------------3599.
3774     C 3600.
3775     EQUIVALENCE 3601.
3776     + (VADATA(1,1,1),ALVISK(1,1)),(VADATA(1,1,2),ALNIRK(1,1)) 3602.
3777     +, (VADATA(1,1,3),FIELDC(1,1)),(VADATA(1,4,3),VTMASK(1)) 3603.
3778     C$$ + (VADATA(1,1,1),ALMEAN(1,1)),(VADATA(1,1,2),RATIRV(1,1)) 3604.
3779     C$$ +, (VADATA(1,1,3),VTMASK(1)),(VADATA(1,2,3),FIELDC(1,1)) 3605.
3780     C 3606.
3781     EQUIVALENCE 3607.
3782     + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 3608.
3783     +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 3609.
3784     +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 3610.
3785     +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 3611.
3786     +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 3612.
3787     +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 3613.
3788     C 3614.
3789     EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 3615.
3790     EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 3616.
3791     C 3617.
3792     EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 3618.
3793     EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 3619.
3794     C 3620.
3795     EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 3621.
3796     + ,(FRC(4), FCLO),(FRC(5), FCOV) 3622.
3797     C 3623.
3798     DIMENSION ALVISK(11,4),ALNIRK(11,4) 3624.
3799     C$$ DIMENSION ALMEAN(11,4),RATIRV(11,4) 3625.
3800     DIMENSION FIELDC(11,3),VTMASK(11) 3626.
3801     C 3627.
3802     C 1 2 3 4 3628.
3803     C WINTER SPRING SUMMER AUTUMN 3629.
3804     C 3630.
3805     DATA ALVISK/ 3631.
3806     C 1 2 3 4 5 6 7 8 9 10 11 3632.
3807     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3633.
3808     1 .350, .067, .089, .089, .078, .100, .067, .061, .100, .070, .001,3634.
3809     2 .350, .063, .100, .100, .073, .055, .067, .061, .100, .070, .001,3635.
3810     3 .350, .085, .091, .139, .085, .058, .083, .061, .100, .070, .001,3636.
3811     4 .350, .080, .090, .111, .064, .055, .061, .061, .100, .070, .001/3637.
3812     C 3638.
3813     DATA ALNIRK/ 3639.
3814     C 1 2 3 4 5 6 7 8 9 10 11 3640.
3815     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3641.
3816     1 .350, .200, .267, .267, .233, .300, .200, .183, .100, .070, .001,3642.
3817     2 .350, .206, .350, .300, .241, .218, .200, .183, .100, .070, .001,3643.
3818     3 .350, .298, .364, .417, .298, .288, .250, .183, .100, .070, .001,3644.
3819     4 .350, .255, .315, .333, .204, .218, .183, .183, .100, .070, .001/3645.
3820     C 3646.
3821     C$$ DATA ALMEAN/ 3647.
3822     C 1 2 3 4 5 6 7 8 9 10 11 3648.
3823     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3649.
3824     C$$ 1 .350, .120, .160, .160, .140, .180, .120, .110, .100, .070, .001,3650.
3825     C$$ 2 .350, .120, .200, .180, .140, .120, .120, .110, .100, .070, .001,3651.
3826     C$$ 3 .350, .170, .200, .250, .170, .150, .150, .110, .100, .070, .001,3652.
3827     C$$ 4 .350, .150, .180, .200, .120, .120, .110, .110, .100, .070, .001/3653.
3828     C 3654.
3829     C$$ DATA RATIRV/ 3655.
3830     C 1 2 3 4 5 6 7 8 9 10 11 3656.
3831     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3657.
3832     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.
3833     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.
3834     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.
3835     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.
3836     C 3662.
3837     DATA FIELDC/ 3663.
3838     C (KG/M**2) 3664.
3839     C 1 2 3 4 5 6 7 8 9 10 11 3665.
3840     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3666.
3841     1 10.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 200., 10.0, 30.0, 999.,3667.
3842     2 10.0, 200., 200., 300., 300., 450., 450., 450., 10.0, 200., 999.,3668.
3843     3 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0/3669.
3844     C 3670.
3845     DATA VTMASK/ 3671.
3846     C (KG/M**2) 3672.
3847     C 1 2 3 4 5 6 7 8 9 10 11 3673.
3848     C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3674.
3849     4 10.0, 20.0, 20.0, 50.0, 200., 500.,1000.,2500., 10.0, 30.0, .001/3676.
3850     C 3677.
3851     C 3678.
3852     DATA DLAT/ 3679.
3853     +-90.000000,-82.173913,-74.347826,-66.521739,-58.695652,-50.869565,3680.
3854     +-43.043478,-35.217391,-27.391304,-19.565217,-11.739130,- 3.913043,3681.
3855     + 3.913043, 11.739130, 19.565217, 27.391304, 35.217391, 43.043478,3682.
3856     + 50.869565, 58.695652, 66.521739, 74.347826, 82.173913, 90.000000,3683.
3857     + 22*0.0000/ 3684.
3858     C 3685.
3859     DATA DLON/ 3686.
3860     + 0.0, 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0, 3687.
3861     + 90.0, 100.0, 110.0, 120.0, 130.0, 140.0, 150.0, 160.0, 170.0, 3688.
3862     + 180.0, 190.0, 200.0, 210.0, 220.0, 230.0, 240.0, 250.0, 260.0, 3689.
3863     + 270.0, 280.0, 290.0, 300.0, 310.0, 320.0, 330.0, 340.0, 350.0, 3690.
3864     +36*0.0/ 3691.
3865     C 3692.
3866     C-----------------------------------------------------------------------3693.
3867     C TRACE GAS REFERENCE AMOUNTS & DISTRIBUTIONS ARE DEFINED IN SETGAS3694.
3868     C-----------------------------------------------------------------------3695.
3869     C 3696.
3870     C 3697.
3871     C H2O CO2 O3 O2 NO2 N2O CH4 F11 F12 3698.
3872     C 1 2 3 4 5 6 7 8 9 3699.
3873     DATA FULGAS/ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 3700.
3874     + , 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0/ 3701.
3875     C 3702.
3876     C GLOBAL OCEAN LAND DESERT HAZE TR1 TR2 TR3 TR4 3703.
3877     C 1 2 3 4 5 6 7 8 9 3704.
3878     C 3705.
3879     DATA FGOLDH/ 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0 3706.
3880     + , 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0/ 3707.
3881     C 3708.
3882     DATA LASTVC/-123456/, KFORCE/-123456789/ 3709.
3883     C 3710.
3884     C 3711.
3885     DATA TAUMIN/1.0E-04/, TLGRAD/ 1.0/, EOCTRA/1.0/, ZOCSRA/1.0/ 3712.
3886     DATA FRACSL/1.0E-02/, TKCICE/258./, ESNTRA/1.0/, ZSNSRA/1.0/ 3713.
3887     DATA RATQSL/1.0 /, FLONO3/ 0.0/, EICTRA/1.0/, ZICSRA/1.0/ 3714.
3888     DATA FOGTSL/0.0 /, ECLTRA/1.00/, EDSTRA/1.0/, ZDSSRA/1.0/ 3715.
3889     DATA PTLISO/2.5E+00/, ZCLSRA/1.00/, EVGTRA/1.0/, ZVGSRA/1.0/ 3716.
3890     C 3717.
3891     DATA FMARCL/0.50/, FCLDTR/1.0/, NTRACE/0/, IDPROG/0/ 3718.
3892     DATA WETTRA/1.00/, FCLDSR/1.0/, ITR(1)/0/, ID2TRD/0/ 3719.
3893     DATA WETSRA/1.00/, FALGAE/1.0/, ITR(2)/0/, ID3SRD/0/ 3720.
3894     DATA DMOICE/10.0/, FRAYLE/1.0/, ITR(3)/0/, ID4VEG/0/ 3721.
3895     DATA DMLICE/10.0/, LICETK/ 0/, ITR(4)/0/, ID5FOR/0/ 3722.
3896     C 3723.
3897     DATA NV/ 8/ 3724.
3898     DATA IMGAS1/1/, KEEPRH/0/, KGASSR/0/, LAYRAD/ 3/ 3725.
3899     DATA IMGAS2/3/, KEEPAL/0/, KAERSR/0/, NL/12/ 3726.
3900     DATA ILGAS1/2/, ISOSCT/0/, KFRACC/0/, NLP/13/ 3727.
3901     DATA ILGAS2/9/, IHGSCT/0/, MARCLD/0/, JMLAT/24/ 3728.
3902     DATA KWVCON/1/, LAPGAS/1/, NORMS0/1/, IMLON/36/ 3729.
3903     C 3730.
3904     DATA JYEAR/1958/, JLAT/18/, S0/1367.0/ 3731.
3905     DATA JDAY/ 0/, ILON/18/, COSZ/0.5000/ 3732.
3906     C 3733.
3907     DATA POCEAN/0.700/, TGO/288.15/, AGESN/1.00/, WMAG/2.00/ 3734.
3908     DATA PEARTH/0.100/, TGE/288.15/, SNOWE/0.30/, WEARTH/0.00/ 3735.
3909     DATA POICE/0.100/, TGOI/288.15/, SNOWOI/0.10/, ZOICE/10.0/ 3736.
3910     DATA PLICE/0.100/, TGLI/288.15/, SNOWLI/0.20/, FRACCC/0.00/ 3737.
3911     DATA TSL/288.15/ 3738.
3912     C 3739.
3913     DATA PLB/ 3740.
3914     + 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 3741.
3915     + 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 3742.
3916     + 1.E-05, 27*0.00/ 3743.
3917     C 3744.
3918     DATA HLB/ 3745.
3919     + 1.E-10,1.0,2.0,3.0,6.0,11.0,20.0,32.0,47.0,51.0,71.0 3746.
3920     + ,84.852,99.99,27*99.999/ 3747.
3921     C 3748.
3922     DATA TLB/40*250./ 3749.
3923     DATA TLT/40*250./ 3750.
3924     DATA TLM/40*250./ 3751.
3925     C 3752.
3926     DATA U0GAS/360*0./ 3753.
3927     DATA ULGAS/360*0./ 3754.
3928     C 3755.
3929     DATA TRACER/160*0./ 3756.
3930     DATA CLDTAU/ 40*0./ 3757.
3931     C 3758.
3932     DATA SHL/40*0./ 3759.
3933     DATA RHL/40*0./ 3760.
3934     C 3761.
3935     DATA PVT/8*0.125,3*0.0/ 3762.
3936     C 3763.
3937     DATA SRBXAL/30*0./ 3764.
3938     DATA BXA/153*0./ 3765.
3939     C 3766.
3940     DATA LUXGAS/1/ 3767.
3941     DATA KALVIS/0/ 3768.
3942     DATA MEANAL/0/ 3769.
3943     C 3770.
3944     C-----------------------------------------------------------------------3771.
3945     C AEROSOL RADIATIVE PROPERTIES,COMPOSITION,TYPE & VERTICAL DISTRIBUTION3772.
3946     C-----------------------------------------------------------------------3773.
3947     C 3774.
3948     C BLOCKD INITIALIZED DEFAULT DATA 3775.
3949     C 3776.
3950     C 3785.
3951     DIMENSION QACID1(25),QACID2(25),QSLFT1(25),QSLFT2(25) 3786.
3952     T ,QBSLT1(25),QBSLT2(25),QSSALT(25),QDUST1(25) 3787.
3953     T ,QDUST2(25),QCARB1(25),QCARB2(25) 3788.
3954     T ,SACID1(25),SACID2(25),SSLFT1(25),SSLFT2(25) 3789.
3955     T ,SBSLT1(25),SBSLT2(25),SSSALT(25),SDUST1(25) 3790.
3956     T ,SDUST2(25),SCARB1(25),SCARB2(25) 3791.
3957     T ,CACID1(25),CACID2(25),CSLFT1(25),CSLFT2(25) 3792.
3958     T ,CBSLT1(25),CBSLT2(25),CSSALT(25),CDUST1(25) 3793.
3959     T ,CDUST2(25),CCARB1(25),CCARB2(25) 3794.
3960     T ,QWATER(25),QICE25(25),SWATER(25),SICE25(25) 3795.
3961     T ,CWATER(25),CICE25(25) 3796.
3962     C 3797.
3963     S ,XACID1(6),XACID2(6),XSLFT1(6),XSLFT2(6),XBSLT1(6),XBSLT2(6)3798.
3964     S ,XSSALT(6),XDUST1(6),XDUST2(6),XCARB1(6),XCARB2(6) 3799.
3965     S ,YACID1(6),YACID2(6),YSLFT1(6),YSLFT2(6),YBSLT1(6),YBSLT2(6)3800.
3966     S ,YSSALT(6),YDUST1(6),YDUST2(6),YCARB1(6),YCARB2(6) 3801.
3967     S ,ZACID1(6),ZACID2(6),ZSLFT1(6),ZSLFT2(6),ZBSLT1(6),ZBSLT2(6)3802.
3968     S ,ZSSALT(6),ZDUST1(6),ZDUST2(6),ZCARB1(6),ZCARB2(6) 3803.
3969     S ,XWATER(6),XICE25(6),YWATER(6),YICE25(6),ZWATER(6),ZICE25(6)3804.
3970     C 3805.
3971     EQUIVALENCE (TRAQEX(1, 1),QACID1(1)),(TRAQEX(1, 2),QACID2(1)) 3806.
3972     1 ,(TRAQEX(1, 3),QSLFT1(1)),(TRAQEX(1, 4),QSLFT2(1)) 3807.
3973     2 ,(TRAQEX(1, 5),QBSLT1(1)),(TRAQEX(1, 6),QBSLT2(1)) 3808.
3974     3 ,(TRAQEX(1, 7),QSSALT(1)),(TRAQEX(1, 8),QDUST1(1)) 3809.
3975     4 ,(TRAQEX(1, 9),QDUST2(1)),(TRAQEX(1,10),QCARB1(1)) 3810.
3976     5 ,(TRAQEX(1,11),QCARB2(1)) 3811.
3977     C 3812.
3978     EQUIVALENCE (TRAQSC(1, 1),SACID1(1)),(TRAQSC(1, 2),SACID2(1)) 3813.
3979     1 ,(TRAQSC(1, 3),SSLFT1(1)),(TRAQSC(1, 4),SSLFT2(1)) 3814.
3980     2 ,(TRAQSC(1, 5),SBSLT1(1)),(TRAQSC(1, 6),SBSLT2(1)) 3815.
3981     3 ,(TRAQSC(1, 7),SSSALT(1)),(TRAQSC(1, 8),SDUST1(1)) 3816.
3982     4 ,(TRAQSC(1, 9),SDUST2(1)),(TRAQSC(1,10),SCARB1(1)) 3817.
3983     5 ,(TRAQSC(1,11),SCARB2(1)) 3818.
3984     C 3819.
3985     EQUIVALENCE (TRACOS(1, 1),CACID1(1)),(TRACOS(1, 2),CACID2(1)) 3820.
3986     1 ,(TRACOS(1, 3),CSLFT1(1)),(TRACOS(1, 4),CSLFT2(1)) 3821.
3987     2 ,(TRACOS(1, 5),CBSLT1(1)),(TRACOS(1, 6),CBSLT2(1)) 3822.
3988     3 ,(TRACOS(1, 7),CSSALT(1)),(TRACOS(1, 8),CDUST1(1)) 3823.
3989     4 ,(TRACOS(1, 9),CDUST2(1)),(TRACOS(1,10),CCARB1(1)) 3824.
3990     5 ,(TRACOS(1,11),CCARB2(1)) 3825.
3991     C 3826.
3992     EQUIVALENCE (TRCQEX(1, 1),QWATER(1)),(TRCQEX(1, 2),QICE25(1)) 3827.
3993     EQUIVALENCE (TRCQSC(1, 1),SWATER(1)),(TRCQSC(1, 2),SICE25(1)) 3828.
3994     EQUIVALENCE (TRCCOS(1, 1),CWATER(1)),(TRCCOS(1, 2),CICE25(1)) 3829.
3995     3830.
3996     C 3831.
3997     EQUIVALENCE (SRAQEX(1, 1),XACID1(1)),(SRAQEX(1, 2),XACID2(1)) 3832.
3998     1 ,(SRAQEX(1, 3),XSLFT1(1)),(SRAQEX(1, 4),XSLFT2(1)) 3833.
3999     2 ,(SRAQEX(1, 5),XBSLT1(1)),(SRAQEX(1, 6),XBSLT2(1)) 3834.
4000     3 ,(SRAQEX(1, 7),XSSALT(1)),(SRAQEX(1, 8),XDUST1(1)) 3835.
4001     4 ,(SRAQEX(1, 9),XDUST2(1)),(SRAQEX(1,10),XCARB1(1)) 3836.
4002     5 ,(SRAQEX(1,11),XCARB2(1)) 3837.
4003     C 3838.
4004     EQUIVALENCE (SRAQSC(1, 1),YACID1(1)),(SRAQSC(1, 2),YACID2(1)) 3839.
4005     1 ,(SRAQSC(1, 3),YSLFT1(1)),(SRAQSC(1, 4),YSLFT2(1)) 3840.
4006     2 ,(SRAQSC(1, 5),YBSLT1(1)),(SRAQSC(1, 6),YBSLT2(1)) 3841.
4007     3 ,(SRAQSC(1, 7),YSSALT(1)),(SRAQSC(1, 8),YDUST1(1)) 3842.
4008     4 ,(SRAQSC(1, 9),YDUST2(1)),(SRAQSC(1,10),YCARB1(1)) 3843.
4009     5 ,(SRAQSC(1,11),YCARB2(1)) 3844.
4010     C 3845.
4011     EQUIVALENCE (SRACOS(1, 1),ZACID1(1)),(SRACOS(1, 2),ZACID2(1)) 3846.
4012     1 ,(SRACOS(1, 3),ZSLFT1(1)),(SRACOS(1, 4),ZSLFT2(1)) 3847.
4013     2 ,(SRACOS(1, 5),ZBSLT1(1)),(SRACOS(1, 6),ZBSLT2(1)) 3848.
4014     3 ,(SRACOS(1, 7),ZSSALT(1)),(SRACOS(1, 8),ZDUST1(1)) 3849.
4015     4 ,(SRACOS(1, 9),ZDUST2(1)),(SRACOS(1,10),ZCARB1(1)) 3850.
4016     5 ,(SRACOS(1,11),ZCARB2(1)) 3851.
4017     C 3852.
4018     EQUIVALENCE (SRCQEX(1, 1),XWATER(1)),(SRCQEX(1, 2),XICE25(1)) 3853.
4019     EQUIVALENCE (SRCQSC(1, 1),YWATER(1)),(SRCQSC(1, 2),YICE25(1)) 3854.
4020     EQUIVALENCE (SRCCOS(1, 1),ZWATER(1)),(SRCCOS(1, 2),ZICE25(1)) 3855.
4021     3856.
4022     C 3857.
4023     DATA NGOLDH/5/,NAERO/11/ 3858.
4024     C 3859.
4025     C-----------------------------------------------------------------------3860.
4026     C COMPOSITION & VERTICAL DISTRIBUTION FOR 5 SPECIFIED AEROSOL TYPES3861.
4027     C-----------------------------------------------------------------------3862.
4028     C TYPE 3863.
4029     C 1 STRATOSPHERIC GLOBAL AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3864.
4030     C 2 TROPOSPHERIC OCEAN AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3865.
4031     C 3 TROPOSPHERIC LAND AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3866.
4032     C 4 TROPOSPHERIC DESERT AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3867.
4033     C 5 TROPOSPHERIC HAZE AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3868.
4034     C 3869.
4035     C 1 2 3 4 5 6 7 8 9 10 11 3870.
4036     C ACID1 OCT82 SLFT1 SLFT2 BSLT1 BSLT2 SSALT DUST1 DUST2 MAY82 CARB23871.
4037     DATA AGOLDH/ 3872.
4038     1 .012, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3873.
4039     2 .0, .0, .018, .033, .012, .023, .011, .0, .0, .0, .0,3874.
4040     3 .0, .0, .031, .057, .021, .042, .0, .0, .0, .0, .018,3875.
4041     4 .0, .0, .0, .0, .0, .0, .0, .300, .300, .0, .0,3876.
4042     5 .0, .250, .0, .0, .0, .0, .0, .300, .0, .0, .0/3877.
4043     DATA BGOLDH/ 3878.
4044     1 20.0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3879.
4045     2 .0, .0, 4.00, 0.00, 4.00, 1.00, 0.00, .0, .0, .0, .0,3880.
4046     3 .0, .0, 4.00, 0.00, 4.00, 0.00, .0, .0, .0, .0, 0.00,3881.
4047     4 .0, .0, .0, .0, .0, .0, .0, 3.50, 0.00, .0, .0,3882.
4048     5 .0, 0.00, .0, .0, .0, .0, .0, 3.50, .0, .0, .0/3883.
4049     DATA CGOLDH/ 3884.
4050     1 3.00, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3885.
4051     2 .0, .0, 3.00, 1.00, 3.00, 0.5, 1.00, .0, .0, .0, .0,3886.
4052     3 .0, .0, 3.00, 1.00, 3.00, 1.00, .0, .0, .0, .0, 1.00,3887.
4053     4 .0, .0, .0, .0, .0, .0, .0, 1.00, 1.00, .0, .0,3888.
4054     5 .0, 1.00, .0, .0, .0, .0, .0, 1.00, .0, .0, .0/3889.
4055     C 3890.
4056     C-----------------------------------------------------------------------3891.
4057     C THERMAL RADIATION 25 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB3892.
4058     C-----------------------------------------------------------------------3893.
4059     DATA QACID1/ 3894.
4060     + 0.04052,0.05895,0.08506,0.06673,0.05160,0.04437,0.03864, 3895.
4061     + 0.02719,0.01668,0.01146,0.00705,0.03286,0.02449,0.03017, 3896.
4062     + 0.03198,0.02891,0.02634,0.02366,0.02300,0.02271,0.02159, 3897.
4063     + 0.08516,0.08825,0.08982,0.09284/ 3898.
4064     DATA SACID1/ 3899.
4065     + 0.00095,0.00361,0.00273,0.00226,0.00150,0.00141,0.00131, 3900.
4066     + 0.00090,0.00049,0.00029,0.00014,0.00072,0.00049,0.00031, 3901.
4067     + 0.00023,0.00023,0.00022,0.00020,0.00019,0.00018,0.00018, 3902.
4068     + 0.00183,0.00201,0.00205,0.00207/ 3903.
4069     DATA CACID1/ 3904.
4070     + 0.11030,0.17256,0.17138,0.19696,0.19510,0.18945,0.18874, 3905.
4071     + 0.18795,0.18313,0.17814,0.17075,0.10583,0.09756,0.08388, 3906.
4072     + 0.07246,0.07266,0.07099,0.06873,0.06754,0.06661,0.06674, 3907.
4073     + 0.11197,0.11068,0.10998,0.10852/ 3908.
4074     C 3909.
4075     DATA QACID2/ 3910.
4076     + 0.05764,0.15189,0.06264,0.04527,0.03973,0.03646,0.03375, 3911.
4077     + 0.02163,0.01337,0.00979,0.00724,0.04076,0.03631,0.04273, 3912.
4078     + 0.04072,0.03752,0.03290,0.03012,0.02968,0.02914,0.02763, 3913.
4079     + 0.10731,0.12510,0.12901,0.13232/ 3914.
4080     DATA SACID2/ 3915.
4081     + 0.00367,0.00752,0.00264,0.00172,0.00188,0.00221,0.00225, 3916.
4082     + 0.00134,0.00066,0.00034,0.00012,0.00237,0.00121,0.00084, 3917.
4083     + 0.00080,0.00081,0.00074,0.00069,0.00067,0.00065,0.00064, 3918.
4084     + 0.00674,0.00807,0.00825,0.00837/ 3919.
4085     DATA CACID2/ 3920.
4086     + 0.05720,0.11171,0.11850,0.11443,0.12325,0.13171,0.13500, 3921.
4087     + 0.13575,0.13419,0.12666,0.10961,0.05186,0.04026,0.03219, 3922.
4088     + 0.03060,0.03105,0.03041,0.02959,0.02911,0.02884,0.02901, 3923.
4089     + 0.07145,0.07168,0.07134,0.07096/ 3924.
4090     C 3925.
4091     DATA QSLFT1/ 3926.
4092     + 0.15555,0.16333,0.16406,0.16396,0.16070,0.14074,0.11920, 3927.
4093     + 0.09140,0.07341,0.06645,0.05871,0.15301,0.13456,0.15809, 3928.
4094     + 0.16264,0.14805,0.12798,0.10588,0.09960,0.09604,0.08844, 3929.
4095     + 0.35895,0.27430,0.26964,0.27183/ 3930.
4096     DATA SSLFT1/ 3931.
4097     + 0.13162,0.13152,0.11642,0.12932,0.10550,0.08323,0.07081, 3932.
4098     + 0.05079,0.03287,0.02458,0.01871,0.12787,0.11183,0.09490, 3933.
4099     + 0.08739,0.08716,0.08022,0.07182,0.06899,0.06700,0.06496, 3934.
4100     + 0.13067,0.12933,0.12878,0.12808/ 3935.
4101     DATA CSLFT1/ 3936.
4102     + 0.52508,0.48102,0.59654,0.66259,0.66566,0.70224,0.71546, 3937.
4103     + 0.69308,0.62819,0.55963,0.45811,0.52840,0.54500,0.51620, 3938.
4104     + 0.50685,0.52475,0.54985,0.58351,0.59484,0.60203,0.61652, 3939.
4105     + 0.45926,0.47060,0.47243,0.47178/ 3940.
4106     C 3941.
4107     DATA QSLFT2/ 3942.
4108     + 0.44109,0.37065,0.38095,0.40554,0.37738,0.32564,0.27970, 3943.
4109     + 0.21687,0.17752,0.16154,0.14952,0.43239,0.38517,0.39512, 3944.
4110     + 0.39098,0.36978,0.32960,0.28406,0.27042,0.26204,0.24771, 3945.
4111     + 0.63665,0.59084,0.58844,0.59078/ 3946.
4112     DATA SSLFT2/ 3947.
4113     + 0.37818,0.31549,0.29505,0.33810,0.28074,0.22692,0.19562, 3948.
4114     + 0.14289,0.09653,0.07449,0.06008,0.36685,0.33089,0.28296, 3949.
4115     + 0.26185,0.26286,0.24369,0.22019,0.21220,0.20647,0.20093, 3950.
4116     + 0.31870,0.30963,0.30762,0.30507/ 3951.
4117     DATA CSLFT2/ 3952.
4118     + 0.54586,0.50074,0.62826,0.69007,0.69596,0.73443,0.74600, 3953.
4119     + 0.71846,0.64430,0.57291,0.47311,0.54977,0.56612,0.53939, 3954.
4120     + 0.53105,0.54799,0.57221,0.60426,0.61497,0.62179,0.63518, 3955.
4121     + 0.51454,0.52095,0.52268,0.52316/ 3956.
4122     C 3957.
4123     DATA QBSLT1/ 3958.
4124     + 0.19787,0.15206,0.14808,0.15505,0.14132,0.12508,0.10931, 3959.
4125     + 0.07946,0.05659,0.04675,0.03801,0.20081,0.15823,0.15732, 3960.
4126     + 0.15377,0.14273,0.13163,0.12005,0.11684,0.11523,0.11121, 3961.
4127     + 0.36601,0.39099,0.39240,0.39274/ 3962.
4128     DATA SBSLT1/ 3963.
4129     + 0.09892,0.12369,0.09780,0.11017,0.08914,0.08577,0.07794, 3964.
4130     + 0.05688,0.03912,0.03069,0.02440,0.09492,0.08277,0.05817, 3965.
4131     + 0.04773,0.04970,0.04568,0.04058,0.03865,0.03717,0.03641, 3966.
4132     + 0.07710,0.08232,0.08235,0.08163/ 3967.
4133     DATA CBSLT1/ 3968.
4134     + 0.54090,0.49369,0.59375,0.67539,0.69444,0.71623,0.71674, 3969.
4135     + 0.69425,0.63125,0.57379,0.48766,0.54072,0.57272,0.57215, 3970.
4136     + 0.57655,0.59243,0.60616,0.62323,0.62911,0.63253,0.63934, 3971.
4137     + 0.51632,0.50380,0.50414,0.50666/ 3972.
4138     C 3973.
4139     DATA QBSLT2/ 3974.
4140     + 0.49004,0.35700,0.34009,0.38146,0.35476,0.32874,0.29258, 3975.
4141     + 0.21726,0.16067,0.13571,0.11451,0.48169,0.40550,0.37263, 3976.
4142     + 0.35312,0.33842,0.31466,0.28850,0.28051,0.27574,0.26813, 3977.
4143     + 0.59495,0.63654,0.63850,0.63742/ 3978.
4144     DATA SBSLT2/ 3979.
4145     + 0.26833,0.30862,0.25309,0.29334,0.24644,0.24238,0.22164, 3980.
4146     + 0.16459,0.11742,0.09480,0.07809,0.26006,0.23936,0.17265, 3981.
4147     + 0.14418,0.15103,0.13960,0.12488,0.11925,0.11488,0.11275, 3982.
4148     + 0.19766,0.20963,0.20969,0.20807/ 3983.
4149     DATA CBSLT2/ 3984.
4150     + 0.57850,0.51330,0.62334,0.70306,0.72063,0.74166,0.74111, 3985.
4151     + 0.71466,0.64442,0.58410,0.49911,0.58174,0.60690,0.60535, 3986.
4152     + 0.60954,0.62353,0.63716,0.65423,0.66019,0.66381,0.67030, 3987.
4153     + 0.58670,0.57707,0.57759,0.58014/ 3988.
4154     C 3989.
4155     DATA QSSALT/ 3990.
4156     + 0.27651,0.36950,0.40122,0.39669,0.34286,0.33458,0.29978, 3991.
4157     + 0.26075,0.26470,0.26660,0.28507,0.27114,0.23752,0.18761, 3992.
4158     + 0.16890,0.17532,0.17705,0.17827,0.17801,0.17743,0.17914, 3993.
4159     + 0.34241,0.33620,0.33607,0.33681/ 3994.
4160     DATA SSSALT/ 3995.
4161     + 0.27651,0.36950,0.40121,0.39659,0.34226,0.33245,0.29555, 3996.
4162     + 0.22360,0.16290,0.13425,0.11177,0.27114,0.23751,0.18755, 3997.
4163     + 0.16883,0.17526,0.17700,0.17823,0.17797,0.17739,0.17911, 3998.
4164     + 0.34241,0.33620,0.33607,0.33681/ 3999.
4165     DATA CSSALT/ 4000.
4166     + 0.66858,0.50298,0.60372,0.65282,0.66694,0.67041,0.66666, 4001.
4167     + 0.62258,0.52248,0.44732,0.32878,0.66866,0.66680,0.66404, 4002.
4168     + 0.66252,0.66281,0.66265,0.66244,0.66232,0.66223,0.66226, 4003.
4169     + 0.67338,0.67406,0.67410,0.67408/ 4004.
4170     C 4005.
4171     DATA QDUST1/ 4006.
4172     + 0.60958,0.65996,0.59890,0.73030,0.64827,0.55835,0.48157, 4007.
4173     + 0.34847,0.23144,0.18097,0.13460,0.59012,0.47533,0.39938, 4008.
4174     + 0.36575,0.35808,0.33834,0.31587,0.30849,0.30369,0.29821, 4009.
4175     + 0.91360,1.14613,1.16193,1.16619/ 4010.
4176     DATA SDUST1/ 4011.
4177     + 0.32015,0.60541,0.49800,0.59591,0.46651,0.39745,0.34242, 4012.
4178     + 0.23468,0.13039,0.08473,0.04350,0.29084,0.23940,0.16410, 4013.
4179     + 0.13070,0.13267,0.12095,0.10691,0.10167,0.09788,0.09578, 4014.
4180     + 0.39128,0.54469,0.55555,0.55942/ 4015.
4181     DATA CDUST1/ 4016.
4182     + 0.50425,0.49645,0.57736,0.63615,0.63373,0.66224,0.67205, 4017.
4183     + 0.67034,0.65137,0.61767,0.53600,0.49640,0.47921,0.43825, 4018.
4184     + 0.40760,0.41364,0.41120,0.40706,0.40418,0.40149,0.40315, 4019.
4185     + 0.47280,0.39308,0.38801,0.38670/ 4020.
4186     C 4021.
4187     DATA QDUST2/ 4022.
4188     + 0.95483,0.71515,0.77676,0.91847,0.93699,0.89565,0.82979, 4023.
4189     + 0.74871,0.70959,0.69272,0.68748,0.94632,0.90846,0.85600, 4024.
4190     + 0.83350,0.83544,0.82317,0.80807,0.80270,0.79879,0.79577, 4025.
4191     + 1.02427,1.12417,1.13054,1.13169/ 4026.
4192     DATA SDUST2/ 4027.
4193     + 0.49885,0.58157,0.55165,0.64038,0.59140,0.55222,0.50136, 4028.
4194     + 0.42019,0.36087,0.33502,0.31667,0.49026,0.47989,0.42207, 4029.
4195     + 0.39751,0.40487,0.39774,0.38819,0.38426,0.38107,0.38027, 4030.
4196     + 0.49780,0.59147,0.59817,0.60013/ 4031.
4197     DATA CDUST2/ 4032.
4198     + 0.74352,0.54594,0.68229,0.72513,0.73598,0.75710,0.75041, 4033.
4199     + 0.70723,0.65024,0.61702,0.58021,0.74556,0.74741,0.75647, 4034.
4200     + 0.76384,0.76647,0.77599,0.78746,0.79136,0.79400,0.79700, 4035.
4201     + 0.71874,0.62817,0.62224,0.62062/ 4036.
4202     C 4037.
4203     DATA QCARB1/ 4038.
4204     + 0.44718,0.51882,0.26055,0.20526,0.19295,0.18655,0.17520, 4039.
4205     + 0.11120,0.06749,0.04893,0.03537,0.32912,0.25261,0.24973, 4040.
4206     + 0.23947,0.22883,0.20424,0.18781,0.18400,0.18032,0.17370, 4041.
4207     + 0.57200,0.64430,0.65267,0.65790/ 4042.
4208     DATA SCARB1/ 4043.
4209     + 0.17857,0.12659,0.06506,0.05088,0.05317,0.05712,0.05562, 4044.
4210     + 0.03310,0.01705,0.01009,0.00493,0.13908,0.08683,0.06332, 4045.
4211     + 0.06114,0.06260,0.05755,0.05319,0.05155,0.05032,0.04981, 4046.
4212     + 0.19594,0.21003,0.20967,0.20853/ 4047.
4213     DATA CCARB1/ 4048.
4214     + 0.40490,0.48729,0.43960,0.40824,0.46236,0.51422,0.53366, 4049.
4215     + 0.53211,0.51283,0.46211,0.32882,0.40923,0.35984,0.30817, 4050.
4216     + 0.30468,0.31306,0.31215,0.30857,0.30555,0.30388,0.30644, 4051.
4217     + 0.43102,0.40748,0.40436,0.40208/ 4052.
4218     C 4053.
4219     DATA QCARB2/ 4054.
4220     + 0.09591,0.22971,0.21603,0.21745,0.17928,0.17061,0.15202, 4055.
4221     + 0.10846,0.06721,0.04817,0.03076,0.09456,0.08428,0.07093, 4056.
4222     + 0.06589,0.06737,0.06766,0.06782,0.06771,0.06754,0.06792, 4057.
4223     + 0.12455,0.12130,0.12121,0.12155/ 4058.
4224     DATA SCARB2/ 4059.
4225     + 0.00748,0.06133,0.05031,0.04978,0.03714,0.03448,0.03065, 4060.
4226     + 0.02099,0.01137,0.00688,0.00291,0.00728,0.00544,0.00350, 4061.
4227     + 0.00276,0.00291,0.00290,0.00288,0.00285,0.00282,0.00286, 4062.
4228     + 0.01420,0.01327,0.01324,0.01332/ 4063.
4229     DATA CCARB2/ 4064.
4230     + 0.14117,0.25269,0.27090,0.30506,0.29845,0.28974,0.28880, 4065.
4231     + 0.28843,0.28603,0.28395,0.29112,0.14128,0.12741,0.11121, 4066.
4232     + 0.09892,0.09935,0.09786,0.09604,0.09517,0.09448,0.09466, 4067.
4233     + 0.18297,0.17686,0.17658,0.17696/ 4068.
4234     C 4069.
4235     DATA QWATER/ 4070.
4236     + 0.82334,0.89509,1.13254,1.20762,1.24075,1.18580,1.07585, 4071.
4237     + 0.95283,0.89542,0.86914,0.85864,0.87834,0.94021,1.03878, 4072.
4238     + 1.07876,1.06927,1.06987,1.07153,1.07327,1.07505,1.07280, 4073.
4239     + 1.20709,1.20194,1.20383,1.20978/ 4074.
4240     DATA SWATER/ 4075.
4241     + 0.34695,0.68566,0.86748,0.89010,0.83121,0.75556,0.65338, 4076.
4242     + 0.51441,0.40925,0.36469,0.31873,0.39396,0.39368,0.43707, 4077.
4243     + 0.45625,0.44997,0.45039,0.45146,0.45251,0.45357,0.45227, 4078.
4244     + 0.85537,0.85478,0.85718,0.86370/ 4079.
4245     DATA CWATER/ 4080.
4246     + 0.91848,0.65450,0.79206,0.82335,0.83709,0.84869,0.84338, 4081.
4247     + 0.77907,0.68419,0.62521,0.54076,0.91355,0.89224,0.85667, 4082.
4248     + 0.84557,0.85029,0.85229,0.85399,0.85411,0.85389,0.85524, 4083.
4249     + 0.91095,0.91472,0.91488,0.91467/ 4084.
4250     C 4085.
4251     DATA QICE25/ 4086.
4252     + 1.15210,0.81551,0.98885,1.10325,1.17652,1.14217,1.07777, 4087.
4253     + 1.08252,1.14496,1.16939,1.22006,1.16194,1.16781,1.19342, 4088.
4254     + 1.20279,1.19736,1.19435,1.19146,1.19097,1.19095,1.18924, 4089.
4255     + 1.19321,1.21794,1.21959,1.21942/ 4090.
4256     DATA SICE25/ 4091.
4257     + 0.57392,0.45452,0.57278,0.68806,0.74580,0.69171,0.64662, 4092.
4258     + 0.62884,0.64120,0.64892,0.66105,0.59403,0.60241,0.67853, 4093.
4259     + 0.70399,0.68299,0.66547,0.64731,0.64301,0.64122,0.63321, 4094.
4260     + 0.71867,0.77122,0.77524,0.77622/ 4095.
4261     DATA CICE25/ 4096.
4262     + 0.93634,0.72920,0.86084,0.88431,0.87489,0.88472,0.86613, 4097.
4263     + 0.82078,0.79850,0.79041,0.78539,0.93377,0.91036,0.85751, 4098.
4264     + 0.84228,0.85220,0.86089,0.87036,0.87263,0.87355,0.87810, 4099.
4265     + 0.94697,0.94840,0.94812,0.94714/ 4100.
4266     C 4101.
4267     C-----------------------------------------------------------------------4102.
4268     C SOLAR RADIATION 6 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB4103.
4269     C-----------------------------------------------------------------------4104.
4270     C 4105.
4271     DATA XACID1/ 0.05776,0.10033,0.19099,0.36614,0.55931,1.04703/ 4106.
4272     DATA YACID1/ 0.01880,0.09956,0.19090,0.36613,0.55931,1.04703/ 4107.
4273     DATA ZACID1/ 0.36054,0.51871,0.57276,0.62068,0.65273,0.68988/ 4108.
4274     C 4109.
4275     DATA XACID2/0.13360,0.33875,0.51498,0.68359,0.79939,0.94494/ 4110.
4276     DATA YACID2/0.07420,0.33691,0.51483,0.68358,0.79939,0.94494/ 4111.
4277     C$ DATA ZACID2/0.40248,0.62259,0.68524,0.71328,0.71195,0.72894/ 4112.
4278     DATA ZACID2/0.39821,0.54835,0.60846,0.63637,0.63503,0.65221/ 4112.1
4279     C 4113.
4280     DATA XSLFT1/ 0.31035,0.44757,0.54238,0.66756,0.78260,1.04454/ 4114.
4281     DATA YSLFT1/ 0.24589,0.44490,0.54224,0.66755,0.78260,1.04454/ 4115.
4282     DATA ZSLFT1/ 0.70591,0.67557,0.66832,0.66438,0.66199,0.66008/ 4116.
4283     C 4117.
4284     DATA XSLFT2/ 0.60959,0.74888,0.81124,0.87560,0.92632,1.00936/ 4118.
4285     DATA YSLFT2/ 0.50477,0.74262,0.81090,0.87556,0.92631,1.00935/ 4119.
4286     DATA ZSLFT2/ 0.74067,0.70281,0.69748,0.69922,0.70070,0.70754/ 4120.
4287     C 4121.
4288     DATA XBSLT1/ 0.30419,0.46195,0.54908,0.66403,0.77732,1.02644/ 4122.
4289     DATA YBSLT1/ 0.28732,0.44765,0.53358,0.64786,0.76063,1.00769/ 4123.
4290     DATA ZBSLT1/ 0.67768,0.66588,0.66785,0.66932,0.66671,0.66818/ 4124.
4291     C 4125.
4292     DATA XBSLT2/ 0.62145,0.76377,0.81783,0.87743,0.92782,1.00765/ 4126.
4293     DATA YBSLT2/ 0.58466,0.73120,0.78367,0.84258,0.89259,0.96944/ 4127.
4294     DATA ZBSLT2/ 0.70368,0.69767,0.70313,0.70847,0.70983,0.71935/ 4128.
4295     C 4129.
4296     DATA XSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00414/ 4130.
4297     DATA YSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00413/ 4131.
4298     DATA ZSSALT/ 0.67233,0.68272,0.68718,0.69084,0.69334,0.69627/ 4132.
4299     C 4133.
4300     DATA XDUST1/ 1.17571,1.20282,1.13894,1.08190,1.04572,0.99864/ 4134.
4301     DATA YDUST1/ 1.04642,1.12320,1.04442,0.97057,0.93288,0.78720/ 4135.
4302     DATA ZDUST1/ 0.72235,0.68164,0.69516,0.72361,0.74315,0.80409/ 4136.
4303     C 4137.
4304     DATA XDUST2/ 1.09335,1.12888,1.09512,1.05217,1.02411,1.00081/ 4138.
4305     DATA YDUST2/ 0.83740,0.93590,0.88162,0.81721,0.78602,0.68767/ 4139.
4306     DATA ZDUST2/ 0.78776,0.76447,0.77511,0.79364,0.80840,0.85594/ 4140.
4307     C 4141.
4308     DATA XCARB1/0.74444,1.11851,1.14599,1.09902,1.05179,1.00292/ 4142.
4309     DATA YCARB1/0.53412,1.11290,1.14544,1.09899,1.05179,1.00292/ 4143.
4310     C$ DATA ZCARB1/0.75767,0.74553,0.72950,0.71977,0.71968,0.74073/ 4144.
4311     DATA ZCARB1/0.71248,0.66984,0.65284,0.64292,0.64282,0.66426/ 4144.1
4312     C 4145.
4313     DATA XCARB2/ 0.54418,0.82500,0.91922,0.97919,1.00345,0.99476/ 4146.
4314     DATA YCARB2/ 0.19636,0.34820,0.40558,0.44719,0.46860,0.48132/ 4147.
4315     DATA ZCARB2/ 0.45878,0.59691,0.65112,0.70444,0.74341,0.79820/ 4148.
4316     C 4149.
4317     DATA XWATER/ 1.10372,1.05381,1.03792,1.02265,1.01285,0.99989/ 4150.
4318     DATA YWATER/ 0.84758,1.03190,1.02896,1.02226,1.01282,0.99988/ 4151.
4319     DATA ZWATER/ 0.87621,0.84587,0.84884,0.85323,0.85888,0.86321/ 4152.
4320     C 4153.
4321     DATA XICE25/ 1.05394,1.02884,1.02030,1.01257,1.00706,0.99981/ 4154.
4322     DATA YICE25/ 0.75677,0.96035,1.00797,1.01184,1.00702,0.99981/ 4155.
4323     DATA ZICE25/ 0.92708,0.88645,0.87975,0.87906,0.87391,0.87623/ 4156.
4324     C 4157.
4325     C-----------------------------------------------------------------------4158.
4326     C THERMAL RADIATION 25 K-INTERVAL MERGED CLOUD & SURFACE ALBEDO DATA 4159.
4327     C-----------------------------------------------------------------------4160.
4328     DATA AGSIDV/ 4161.
4329     S 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4162.
4330     S 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4163.
4331     S 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4164.
4332     S 0.01757,0.02022,0.02059,0.02082, 4165.
4333     I 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4166.
4334     I 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4167.
4335     I 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4168.
4336     I 0.01757,0.02022,0.02059,0.02082, 4169.
4337     D 0.04500,0.10414,0.06739,0.08448,0.08516,0.06283,0.05230, 4170.
4338     D 0.03382,0.01901,0.01542,0.01178,0.05142,0.04835,0.05505, 4171.
4339     D 0.05600,0.05310,0.04603,0.03731,0.03472,0.03328,0.03000, 4172.
4340     D 0.16159,0.17592,0.17812,0.17927, 4173.
4341     V 25*0.0/ 4174.
4342     DATA AOCEAN/ 4175.
4343     + 0.04000,0.05965,0.06124,0.08339,0.09235,0.09510,0.09908, 4176.
4344     + 0.11117,0.12263,0.12577,0.12931,0.04700,0.06894,0.08970, 4177.
4345     + 0.09574,0.09565,0.09619,0.09672,0.09703,0.09723,0.09700, 4178.
4346     + 0.04645,0.04487,0.04482,0.04493/ 4179.
4347     C 4180.
4348     DATA CLDALB/ 4181.
4349     + 0.01332,0.08190,0.07036,0.05082,0.04486,0.04673,0.04770, 4182.
4350     + 0.05130,0.05240,0.05251,0.05259,0.01558,0.01763,0.02410, 4183.
4351     + 0.02571,0.02514,0.02448,0.02366,0.02347,0.02340,0.02294, 4184.
4352     + 0.04566,0.04499,0.04518,0.04544, 4185.
4353     + 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4186.
4354     + 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4187.
4355     + 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4188.
4356     + 0.01757,0.02022,0.02059,0.02082/ 4189.
4357     C 4190.
4358     DATA ASNALB/0.600,0.350,13*0.0/ 4191.
4359     C&& DATA ASNALB/0.550,0.300,13*0.0/
4360     C 4192.
4361     C&& DATA AOIALB/0.550,0.300,13*0.0/ 4193.
4362     DATA AOIALB/0.600,0.350,13*0.0/
4363     C 4194.
4364     DATA ALIALB/0.600,0.350,13*0.0/ 4195.
4365     C 4196.
4366     C-----------------------------------------------------------------------4197.
4367     C TRACE GAS VERTICAL DISTRIBUTION & 1958 MEAN CONCENTRATION 4198.
4368     C-----------------------------------------------------------------------4199.
4369     C 4200.
4370     DATA CMANO2/ 4201.
4371     1 8.66E-06,5.15E-06,2.85E-06,1.50E-06,9.89E-07,6.91E-07,7.17E-07, 4202.
4372     2 8.96E-07,3.67E-06,4.85E-06,5.82E-06,6.72E-06,7.77E-06,8.63E-06, 4203.
4373     3 8.77E-06,8.14E-06,6.91E-06,5.45E-06,4.00E-06,2.67E-06,1.60E-06, 4204.
4374     4 8.36E-07,3.81E-07,1.58E-07,6.35E-08,2.57E-08,1.03E-08,4.18E-09, 4205.
4375     5 1.66E-09,6.57E-10,2.58E-10,1.02E-10,4.11E-11,1.71E-11,7.73E-12, 4206.
4376     6 9.07E-12,4.63E-12,2.66E-12,1.73E-12,1.28E-12,1.02E-12,1.00E-30/ 4207.
4377     C 4208.
4378     C 4209.
4379     C GAS NUMBER 1 2 3 4 5 6 7 8 9 4210.
4380     C H2O CO2 O3 O2 NO2 N2O CH4 CCL3F1 CCL2F2 4211.
4381     C DATA FULGAS/1.0, 1.0,1.0, 1.0,1.0, 1.0, 1.0, 1.0, 1.0/4212.
4382     c DATA PPMV58/0.0,315.0,0.0,210000.,0.0,0.295,1.400,8.00E-6,25.0E-6/4213.
4383     DATA PPMV58/0.0, 0.0,0.0,210000.,0.0,4*0.0/
4384     C$ DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0, 15.0, 10.0, 12.0, 12.0/4214.
4385     DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0,915.0,910.0, 12.0, 12.0/4215.
4386     DATA ZH/ 8.0, 8.0,8.0, 8.0,8.0, 10.0, 30.0, 3.0, 3.0/4216.
4387     C 4217.
4388     C-----------------------------------------------------------------------4218.
4389     C TRACE GAS ABSORPTION COEFFICIENTS FOR F11 & F12 4219.
4390     C-----------------------------------------------------------------------4220.
4391     C 4221.
4392     DIMENSION F11PCM(25),F12PCM(25) 4222.
4393     EQUIVALENCE (TRACEG(1,1),F11PCM(1)),(TRACEG(1,2),F12PCM(1)) 4223.
4394     C 4224.
4395     C 4225.
4396     DATA F11PCM/ 4226.
4397     + 13.6000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 4227.
4398     + 0.0000, 0.0000, 0.0000, 0.0000,11.9504, 2.5138, 0.5054, 4228.
4399     + 0.1086, 0.0308, 0.0178, 0.0054, 0.0000, 0.0000, 0.0000, 4229.
4400     + 2.5220, 1.1731, 0.8627, 0.7445/ 4230.
4401     C 4231.
4402     DATA F12PCM/ 4232.
4403     + 5.4900, 1.3339, 0.7739, 0.1304, 0.0286, 0.0051, 0.0000, 4233.
4404     + 0.0000, 0.0000, 0.0000, 0.0000, 9.0745, 2.3577, 0.4135, 4234.
4405     + 0.0575, 0.0000, 0.2507, 0.6215, 0.7262, 0.7972, 0.9150, 4235.
4406     + 13.1663, 1.1564, 0.0388, 0.0082/ 4236.
4407     C 4236.11
4408     C ------------------------------------------------------------------4236.12
4409     C DECEMBER 4, 1991 UPDATE PROVIDES FOR THE FOLLOWING IMPROVEMENTS:4236.13
4410     C ------------------------------------------------------------------4236.14
4411     C IF(NEWASZ.GT.0) ALL AEROSOL SOLAR ZENITH ANGLE DEPENDENCE IMPROVED4236.15
4412     C IF(NEWAQA.GT.0) ALL AERSOL THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.16
4413     C (TRACER AEROSOLS ALREADY USE Q-ABSORPTION IN XRAD83XX) 4236.17
4414     C IF(NEWCQA.GT.0) ALL CLOUDS THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.18
4415     C ------------------------------------------------------------------4236.21
4416     C 4236.22
4417     EQUIVALENCE (ISPARE(1),NEWASZ) 4236.23
4418     EQUIVALENCE (ISPARE(2),NEWAQA) 4236.24
4419     EQUIVALENCE (ISPARE(3),NEWCQA) 4236.25
4420     C 4236.26
4421     DATA NEWASZ/0/, NEWAQA/0/, NEWCQA/0/ 4236.27
4422     C 4236.28
4423     END 4237.
4424     SUBROUTINE PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 4238.
4425     C 4239.
4426     C ------------------------------------------------------------------4240.
4427     C ------------- MCCLATCHY (1972) ATMOSPHERE DATA -----------4241.
4428     C ------------------------------------------------------------------4242.
4429     C 4243.
4430     C INPUT DATA 4244.
4431     C------------------ 4245.
4432     C NATM=0 GIVES ABREVIATED DATA FOR STANDARD ATMOSPHER4246.
4433     C (INPUT: P OR H) (RETURNS: H OR P & D,T)4247.
4434     C 4248.
4435     C NATM=1 GIVES ATMOSPHERE DATA FOR TROPICAL LATITUDES4249.
4436     C NATM=2 GIVES ATMOSPHERE DATA FOR MIDLATITUDE SUMMER4250.
4437     C NATM=3 GIVES ATMOSPHERE DATA FOR MIDLATITUDE WINTER4251.
4438     C NATM=4 GIVES ATMOSPHERE DATA FOR SUBARCTIC SUMMER 4252.
4439     C NATM=5 GIVES ATMOSPHERE DATA FOR SUBARCTIC WINTER 4253.
4440     C NATM=6 GIVES ATMOSPHERE DATA FOR STANDARD ATMOSPHER4254.
4441     C 4255.
4442     C NPHD=1 RETURNS H,D,T,O,Q,S DATA FOR GIVEN PRESSURE P4256.
4443     C NPHD=2 RETURNS P,D,T,O,Q,S DATA FOR GIVEN HEIGHT H4257.
4444     C NPHD=3 RETURNS P,H,T,O,Q,S DATA FOR GIVEN DENSITY D4258.
4445     C 4259.
4446     C OUTPUT DATA 4260.
4447     C------------------ 4261.
4448     C P = PRESSURE IN MILLIBARS 4262.
4449     C H = HEIGHT IN KILOMETERS 4263.
4450     C D = DENSITY IN GRAMS/METER**3 4264.
4451     C T = TEMPERATURE (ABSOLUTE) 4265.
4452     C O = OZONE MIXING RATIO (GRAMS OZONE)/(GRAMS AIR) 4266.
4453     C Q = SPECIFIC HUMIDITY (GRAMS WATER VAPOR)/(GRAMS AIR)4267.
4454     C S = SATURATION RATIO (GRAMS WATER VAPOR)/(GRAMS AIR) 4268.
4455     C OCM = OZONE (CM-STP) ABOVE GIVEN HEIGHT 4269.
4456     C WCM = WATER VAPOR (CM-STP) ABOVE GIVEN HEIGHT 4270.
4457     C 4271.
4458     C REMARKS 4272.
4459     C------------------ 4273.
4460     C INPUT P,H,D PARAMETERS ARE NOT ALTERED 4274.
4461     C P,D INTERPOLATION IS EXPONENTIAL WITH HEIGHT 4275.
4462     C NO EXTRAPOLATION IS MADE OUTSIDE 0-100 KM INTERVAL 4276.
4463     C S IS NOT COMPUTED ABOVE 40 KM (FORMULA NOT ACCURATE)4277.
4464     C 4278.
4465     C R = Q/S GIVES RELATIVE HUMIDITY 4279.
4466     C W = Q/(1-Q) GIVES WATER VAPOR MIXING RATIO 4280.
4467     C N = D*2.079E 16 GIVES NUMBER DENSITY PER CM**3 4281.
4468     C 4282.
4469     C 4283.
4470     C 4284.
4471     C 4285.
4472     C 4286.
4473     DIMENSION PRS1(33),PRS2(33),PRS3(33),PRS4(33),PRS5(33),PRS6(33)4287.
4474     1 ,DNS1(33),DNS2(33),DNS3(33),DNS4(33),DNS5(33),DNS6(33)4288.
4475     2 ,TMP1(33),TMP2(33),TMP3(33),TMP4(33),TMP5(33),TMP6(33)4289.
4476     3 ,WVP1(33),WVP2(33),WVP3(33),WVP4(33),WVP5(33),WVP6(33)4290.
4477     4 ,OZO1(33),OZO2(33),OZO3(33),OZO4(33),OZO5(33),OZO6(33)4291.
4478     DIMENSION PRES(33,6),DENS(33,6),TEMP(33,6),WVAP(33,6),OZON(33,6)4292.
4479     C 4293.
4480     EQUIVALENCE 4294.
4481     + (PRES(1,1),PRS1(1)),(DENS(1,1),DNS1(1)),(TEMP(1,1),TMP1(1)) 4295.
4482     + ,(PRES(1,2),PRS2(1)),(DENS(1,2),DNS2(1)),(TEMP(1,2),TMP2(1)) 4296.
4483     + ,(PRES(1,3),PRS3(1)),(DENS(1,3),DNS3(1)),(TEMP(1,3),TMP3(1)) 4297.
4484     + ,(PRES(1,4),PRS4(1)),(DENS(1,4),DNS4(1)),(TEMP(1,4),TMP4(1)) 4298.
4485     + ,(PRES(1,5),PRS5(1)),(DENS(1,5),DNS5(1)),(TEMP(1,5),TMP5(1)) 4299.
4486     + ,(PRES(1,6),PRS6(1)),(DENS(1,6),DNS6(1)),(TEMP(1,6),TMP6(1)) 4300.
4487     EQUIVALENCE (WVAP(1,1),WVP1(1)),(OZON(1,1),OZO1(1)) 4301.
4488     EQUIVALENCE (WVAP(1,2),WVP2(1)),(OZON(1,2),OZO2(1)) 4302.
4489     EQUIVALENCE (WVAP(1,3),WVP3(1)),(OZON(1,3),OZO3(1)) 4303.
4490     EQUIVALENCE (WVAP(1,4),WVP4(1)),(OZON(1,4),OZO4(1)) 4304.
4491     EQUIVALENCE (WVAP(1,5),WVP5(1)),(OZON(1,5),OZO5(1)) 4305.
4492     EQUIVALENCE (WVAP(1,6),WVP6(1)),(OZON(1,6),OZO6(1)) 4306.
4493     C 4307.
4494     C 4308.
4495     DIMENSION HTKM(33) 4309.
4496     DATA HTKM/1.0E-09, 1., 2., 3., 4., 5., 6., 7., 8., 9.,10.,11. 4310.
4497     1 ,12.,13.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24. 4311.
4498     2 ,25.,30.,35.,40.,45.,50.,70.,99.9/ 4312.
4499     C 4313.
4500     C 4314.
4501     C---------------------------------------------------------------------- 4315.
4502     C0000 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4316.
4503     C---------------------------------------------------------------------- 4317.
4504     C 4318.
4505     DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 4319.
4506     DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 4320.
4507     + ,3.7338E-03/ 4321.
4508     DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/4322.
4509     DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 4323.
4510     DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 4324.
4511     DATA HPCON/34.16319/ 4325.
4512     C 4326.
4513     C 4327.
4514     C-----------------------------------------------------------------------4328.
4515     C1111 TROPICAL LATITUDES MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4329.
4516     C-----------------------------------------------------------------------4330.
4517     C 4331.
4518     DATA PRS1/ 1.013E 03,9.040E 02,8.050E 02,7.150E 02,6.330E 02,4332.
4519     1 5.590E 02,4.920E 02,4.320E 02,3.780E 02,3.290E 02,2.860E 02,4333.
4520     2 2.470E 02,2.130E 02,1.820E 02,1.560E 02,1.320E 02,1.110E 02,4334.
4521     3 9.370E 01,7.890E 01,6.660E 01,5.650E 01,4.800E 01,4.090E 01,4335.
4522     4 3.500E 01,3.000E 01,2.570E 01,1.220E 01,6.000E 00,3.050E 00,4336.
4523     5 1.590E 00,8.540E-01,5.790E-02,3.000E-04/ 4337.
4524     DATA DNS1/ 1.167E 03,1.064E 03,9.689E 02,8.756E 02,7.951E 02,4338.
4525     1 7.199E 02,6.501E 02,5.855E 02,5.258E 02,4.708E 02,4.202E 02,4339.
4526     2 3.740E 02,3.316E 02,2.929E 02,2.578E 02,2.260E 02,1.972E 02,4340.
4527     3 1.676E 02,1.382E 02,1.145E 02,9.515E 01,7.938E 01,6.645E 01,4341.
4528     4 5.618E 01,4.763E 01,4.045E 01,1.831E 01,8.600E 00,4.181E 00,4342.
4529     5 2.097E 00,1.101E 00,9.210E-02,5.000E-04/ 4343.
4530     DATA TMP1/ 300.0,294.0,288.0,284.0,277.0,270.0,264.0,257.0,250.0,4344.
4531     1244.0,237.0,230.0,224.0,217.0,210.0,204.0,197.0,195.0,199.0,203.0,4345.
4532     2207.0,211.0,215.0,217.0,219.0,221.0,232.0,243.0,254.0,265.0,270.0,4346.
4533     3 219.0,210.0/ 4347.
4534     DATA WVP1/1.9E 01,1.3E 01,9.3E 00,4.7E 00,2.2E 00,1.5E 00,8.5E-01,4348.
4535     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.
4536     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.
4537     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.
4538     4 1.4E-07,1.0E-09/ 4352.
4539     DATA OZO1/5.6E-05,5.6E-05,5.4E-05,5.1E-05,4.7E-05,4.5E-05,4.3E-05,4353.
4540     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.
4541     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.
4542     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.
4543     4 8.6E-08,4.3E-11/ 4357.
4544     C 4358.
4545     C-----------------------------------------------------------------------4359.
4546     C2222 MIDLATITUDE SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4360.
4547     C-----------------------------------------------------------------------4361.
4548     C 4362.
4549     DATA PRS2/ 1.013E 03,9.020E 02,8.020E 02,7.100E 02,6.280E 02,4363.
4550     1 5.540E 02,4.870E 02,4.260E 02,3.720E 02,3.240E 02,2.810E 02,4364.
4551     2 2.430E 02,2.090E 02,1.790E 02,1.530E 02,1.300E 02,1.110E 02,4365.
4552     3 9.500E 01,8.120E 01,6.950E 01,5.950E 01,5.100E 01,4.370E 01,4366.
4553     4 3.760E 01,3.220E 01,2.770E 01,1.320E 01,6.520E 00,3.330E 00,4367.
4554     5 1.760E 00,9.510E-01,6.710E-02,3.000E-04/ 4368.
4555     DATA DNS2/ 1.191E 03,1.080E 03,9.757E 02,8.846E 02,7.998E 02,4369.
4556     1 7.211E 02,6.487E 02,5.830E 02,5.225E 02,4.669E 02,4.159E 02,4370.
4557     2 3.693E 02,3.269E 02,2.882E 02,2.464E 02,2.104E 02,1.797E 02,4371.
4558     3 1.535E 02,1.305E 02,1.110E 02,9.453E 01,8.056E 01,6.872E 01,4372.
4559     4 5.867E 01,5.014E 01,4.288E 01,1.322E 01,6.519E 00,3.330E 00,4373.
4560     5 1.757E 00,9.512E-01,6.706E-02,5.000E-04/ 4374.
4561     DATA TMP2/ 294.0,290.0,285.0,279.0,273.0,267.0,261.0,255.0,248.0,4375.
4562     1242.0,235.0,229.0,222.0,216.0,216.0,216.0,216.0,216.0,216.0,217.0,4376.
4563     2218.0,219.0,220.0,222.0,223.0,224.0,234.0,245.0,258.0,270.0,276.0,4377.
4564     3 218.0,210.0/ 4378.
4565     DATA WVP2/1.4E 01,9.3E 00,5.9E 00,3.3E 00,1.9E 00,1.0E 00,6.1E-01,4379.
4566     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.
4567     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.
4568     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.
4569     4 1.4E-07,1.0E-09/ 4383.
4570     DATA OZO2/6.0E-05,6.0E-05,6.0E-05,6.2E-05,6.4E-05,6.6E-05,6.9E-05,4384.
4571     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.
4572     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.
4573     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.
4574     4 8.6E-08,4.3E-11/ 4388.
4575     C 4389.
4576     C-----------------------------------------------------------------------4390.
4577     C3333 MIDLATITUDE WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4391.
4578     C-----------------------------------------------------------------------4392.
4579     C 4393.
4580     DATA PRS3/ 1.018E 03,8.973E 02,7.897E 02,6.938E 02,6.081E 02,4394.
4581     1 5.313E 02,4.627E 02,4.016E 02,3.473E 02,2.992E 02,2.568E 02,4395.
4582     2 2.199E 02,1.882E 02,1.610E 02,1.378E 02,1.178E 02,1.007E 02,4396.
4583     3 8.610E 01,7.350E 01,6.280E 01,5.370E 01,4.580E 01,3.910E 01,4397.
4584     4 3.340E 01,2.860E 01,2.430E 01,1.110E 01,5.180E 00,2.530E 00,4398.
4585     5 1.290E 00,6.820E-01,4.670E-02,3.000E-04/ 4399.
4586     DATA DNS3/ 1.301E 03,1.162E 03,1.037E 03,9.230E 02,8.282E 02,4400.
4587     1 7.411E 02,6.614E 02,5.886E 02,5.222E 02,4.619E 02,4.072E 02,4401.
4588     2 3.496E 02,2.999E 02,2.572E 02,2.206E 02,1.890E 02,1.620E 02,4402.
4589     3 1.388E 02,1.188E 02,1.017E 02,8.690E 01,7.421E 01,6.338E 01,4403.
4590     4 5.415E 01,4.624E 01,3.950E 01,1.783E 01,7.924E 00,3.625E 00,4404.
4591     5 1.741E 00,8.954E-01,7.051E-02,5.000E-04/ 4405.
4592     DATA TMP3/ 272.2,268.7,265.2,261.7,255.7,249.7,243.7,237.7,231.7,4406.
4593     1225.7,219.7,219.2,218.7,218.2,217.7,217.2,216.7,216.2,215.7,215.2,4407.
4594     2215.2,215.2,215.2,215.2,215.2,215.2,217.4,227.8,243.2,258.5,265.7,4408.
4595     3 230.7,210.2/ 4409.
4596     DATA WVP3/3.5E 00,2.5E 00,1.8E 00,1.2E 00,6.6E-01,3.8E-01,2.1E-01,4410.
4597     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.
4598     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.
4599     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.
4600     4 1.4E-07,1.0E-09/ 4414.
4601     DATA OZO3/6.0E-05,5.4E-05,4.9E-05,4.9E-05,4.9E-05,5.8E-05,6.4E-05,4415.
4602     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.
4603     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.
4604     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.
4605     4 8.6E-08,4.3E-11/ 4419.
4606     C 4420.
4607     C-----------------------------------------------------------------------4421.
4608     C4444 SUBARCTIC SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4422.
4609     C-----------------------------------------------------------------------4423.
4610     C 4424.
4611     DATA PRS4/ 1.010E 03,8.960E 02,7.929E 02,7.000E 02,6.160E 02,4425.
4612     1 5.410E 02,4.730E 02,4.130E 02,3.590E 02,3.107E 02,2.677E 02,4426.
4613     2 2.300E 02,1.977E 02,1.700E 02,1.460E 02,1.250E 02,1.080E 02,4427.
4614     3 9.280E 01,7.980E 01,6.860E 01,5.890E 01,5.070E 01,4.360E 01,4428.
4615     4 3.750E 01,3.227E 01,2.780E 01,1.340E 01,6.610E 00,3.400E 00,4429.
4616     5 1.810E 00,9.870E-01,7.070E-02,3.000E-04/ 4430.
4617     DATA DNS4/ 1.220E 03,1.110E 03,9.971E 02,8.985E 02,8.077E 02,4431.
4618     1 7.244E 02,6.519E 02,5.849E 02,5.231E 02,4.663E 02,4.142E 02,4432.
4619     2 3.559E 02,3.059E 02,2.630E 02,2.260E 02,1.943E 02,1.671E 02,4433.
4620     3 1.436E 02,1.235E 02,1.062E 02,9.128E 01,7.849E 01,6.750E 01,4434.
4621     4 5.805E 01,4.963E 01,4.247E 01,1.338E 01,6.614E 00,3.404E 00,4435.
4622     5 1.817E 00,9.868E-01,7.071E-02,5.000E-04/ 4436.
4623     DATA TMP4/ 287.0,282.0,276.0,271.0,266.0,260.0,253.0,246.0,239.0,4437.
4624     1232.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,4438.
4625     2225.0,225.0,225.0,225.0,226.0,228.0,235.0,247.0,262.0,274.0,277.0,4439.
4626     3 216.0,210.0/ 4440.
4627     DATA WVP4/9.1E 00,6.0E 00,4.2E 00,2.7E 00,1.7E 00,1.0E 00,5.4E-01,4441.
4628     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.
4629     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.
4630     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.
4631     4 1.4E-07,1.0E-09/ 4445.
4632     DATA OZO4/4.9E-05,5.4E-05,5.6E-05,5.8E-05,6.0E-05,6.4E-05,7.1E-05,4446.
4633     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.
4634     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.
4635     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.
4636     4 8.6E-08,4.3E-11/ 4450.
4637     C 4451.
4638     C-----------------------------------------------------------------------4452.
4639     C5555 SUBARCTIC WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4453.
4640     C-----------------------------------------------------------------------4454.
4641     C 4455.
4642     DATA PRS5/ 1.013E 03,8.878E 02,7.775E 02,6.798E 02,5.932E 02,4456.
4643     1 5.158E 02,4.467E 02,3.853E 02,3.308E 02,2.829E 02,2.418E 02,4457.
4644     2 2.067E 02,1.766E 02,1.510E 02,1.291E 02,1.103E 02,9.431E 01,4458.
4645     3 8.058E 01,6.882E 01,5.875E 01,5.014E 01,4.277E 01,3.647E 01,4459.
4646     4 3.109E 01,2.649E 01,2.256E 01,1.020E 01,4.701E 00,2.243E 00,4460.
4647     5 1.113E 00,5.719E-01,4.016E-02,3.000E-04/ 4461.
4648     DATA DNS5/ 1.372E 03,1.193E 03,1.058E 03,9.366E 02,8.339E 02,4462.
4649     1 7.457E 02,6.646E 02,5.904E 02,5.226E 02,4.538E 02,3.879E 02,4463.
4650     2 3.315E 02,2.834E 02,2.422E 02,2.071E 02,1.770E 02,1.517E 02,4464.
4651     3 1.300E 02,1.113E 02,9.529E 01,8.155E 01,6.976E 01,5.966E 01,4465.
4652     4 5.100E 01,4.358E 01,3.722E 01,1.645E 01,7.368E 00,3.330E 00,4466.
4653     5 1.569E 00,7.682E-01,5.695E-02,5.000E-04/ 4467.
4654     DATA TMP5/ 257.1,259.1,255.9,252.7,247.7,240.9,234.1,227.3,220.6,4468.
4655     1217.2,217.2,217.2,217.2,217.2,217.2,217.2,216.6,216.0,215.4,214.8,4469.
4656     2214.1,213.6,213.0,212.4,211.8,211.2,216.0,222.2,234.7,247.0,259.3,4470.
4657     3 245.7,210.0/ 4471.
4658     DATA WVP5/1.2E 00,1.2E 00,9.4E-01,6.8E-01,4.1E-01,2.0E-01,9.8E-02,4472.
4659     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.
4660     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.
4661     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.
4662     4 1.4E-07,1.0E-09/ 4476.
4663     DATA OZO5/4.1E-05,4.1E-05,4.1E-05,4.3E-05,4.5E-05,4.7E-05,4.9E-05,4477.
4664     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.
4665     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.
4666     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.
4667     4 8.6E-08,4.3E-11/ 4481.
4668     C 4482.
4669     C---------------------------------------------------------------------- 4483.
4670     C6666 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4484.
4671     C---------------------------------------------------------------------- 4485.
4672     C 4486.
4673     DATA PRS6/ 1.01325E+03,8.987E+02,7.950E+02,7.011E+02,6.164E+02,4487.
4674     1 5.402E+02,4.718E+02,4.106E+02,3.560E+02,3.074E+02,2.644E+02,4488.
4675     2 2.263E+02,1.933E+02,1.651E+02,1.410E+02,1.204E+02,1.029E+02,4489.
4676     3 8.787E+01,7.505E+01,6.410E+01,5.475E+01,4.678E+01,4.000E+01,4490.
4677     4 3.422E+01,2.931E+01,2.511E+01,1.172E+01,5.589E+00,2.775E+00,4491.
4678     5 1.431E+00,7.594E-01,4.634E-02,2.384E-04/ 4492.
4679     DATA DNS6/ 1.225E+03,1.112E+03,1.006E+03,9.091E+02,8.191E+02,4493.
4680     1 7.361E+02,6.597E+02,5.895E+02,5.252E+02,4.663E+02,4.127E+02,4494.
4681     2 3.639E+02,3.108E+02,2.655E+02,2.268E+02,1.937E+02,1.654E+02,4495.
4682     3 1.413E+02,1.207E+02,1.031E+02,8.803E+01,7.487E+01,6.373E+01,4496.
4683     4 5.428E+01,4.627E+01,3.947E+01,1.801E+01,8.214E+00,3.851E+00,4497.
4684     5 1.881E+00,9.775E-01,7.424E-02,4.445E-04/ 4498.
4685     DATA TMP6/ 4499.
4686     1 288.150,281.650,275.150,268.650,262.150,255.650,249.150, 4500.
4687     2 242.650,236.150,229.650,223.150,216.650,216.650,216.650, 4501.
4688     3 216.650,216.650,216.650,216.650,216.650,216.650,216.650, 4502.
4689     4 217.650,218.650,219.650,220.650,221.650,226.650,237.050, 4503.
4690     5 251.050,265.050,270.650,217.450,186.870/ 4504.
4691     DATA WVP6/ 1.083E+01,6.323E+00,3.612E+00,2.015E+00,1.095E+00,4505.
4692     1 5.786E-01,2.965E-01,1.469E-01,7.021E-02,3.226E-02,1.419E-02,4506.
4693     2 5.956E-03,5.002E-03,4.186E-03,3.490E-03,2.896E-03,2.388E-03,4507.
4694     3 1.954E-03,1.583E-03,1.267E-03,9.967E-04,8.557E-04,7.104E-04,4508.
4695     4 5.600E-04,4.037E-04,2.406E-04,5.404E-05,2.464E-05,1.155E-05,4509.
4696     5 5.644E-06,2.932E-06,2.227E-07,1.334E-09/ 4510.
4697     DATA OZO6/ 7.526E-05,3.781E-05,6.203E-05,3.417E-05,5.694E-05,4511.
4698     1 3.759E-05,5.970E-05,4.841E-05,7.102E-05,6.784E-05,9.237E-05,4512.
4699     2 9.768E-05,1.251E-04,1.399E-04,1.715E-04,1.946E-04,2.300E-04,4513.
4700     3 2.585E-04,2.943E-04,3.224E-04,3.519E-04,3.714E-04,3.868E-04,4514.
4701     4 3.904E-04,3.872E-04,3.728E-04,2.344E-04,9.932E-05,3.677E-05,4515.
4702     5 1.227E-05,4.324E-06,5.294E-08,1.262E-10/ 4516.
4703     C 4517.
4704     C 4518.
4705     IF(NATM.GT.0) GO TO 200 4519.
4706     O=1.E-10 4520.
4707     Q=1.E-10 4521.
4708     S=1.E-10 4522.
4709     OCM=1.E-10 4523.
4710     WCM=1.E-10 4524.
4711     IF(NPHD.LT.2) GO TO 150 4525.
4712     DO 110 N=2,8 4526.
4713     IF(H.LT.SHLB(N)) GO TO 120 4527.
4714     110 CONTINUE 4528.
4715     N=9 4529.
4716     120 N=N-1 4530.
4717     IF(ABS(SDLB(N)).LT.1.E-04) GO TO 130 4531.
4718     P=SPLB(N)*(1.+SDLB(N)/STLB(N)*(H-SHLB(N)))**(-HPCON/SDLB(N)) 4532.
4719     GO TO 140 4533.
4720     130 P=SPLB(N)*EXP(-HPCON/STLB(N)*(H-SHLB(N))) 4534.
4721     140 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4535.
4722     D=P/T*28.9644E 05/8.31432E 03 4536.
4723     RETURN 4537.
4724     C 4538.
4725     150 CONTINUE 4539.
4726     DO 160 N=2,8 4540.
4727     160 IF(P.GT.SPLB(N)) GO TO 170 4541.
4728     N=9 4542.
4729     170 N=N-1 4543.
4730     IF(ABS(SDLB(N)).LT.1.E-04) GO TO 180 4544.
4731     H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 4545.
4732     GO TO 190 4546.
4733     C ALOG
4734     180 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 4547.
4735     C ALOG
4736     190 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4548.
4737     D=P/T*28.9644E 05/8.31432E 03 4549.
4738     RETURN 4550.
4739     C 4551.
4740     200 CONTINUE 4552.
4741     IF(NPHD.EQ.1) GO TO 240 4553.
4742     IF(NPHD.EQ.2) GO TO 220 4554.
4743     XX=D 4555.
4744     XI=DENS(1,NATM) 4556.
4745     IF(D.GT.XI) XX=XI 4557.
4746     IF(D.LT.5.0E-04) GO TO 280 4558.
4747     DO 210 J=2,33 4559.
4748     XJ=DENS(J,NATM) 4560.
4749     IF(XX.GT.XJ) GO TO 260 4561.
4750     210 XI=XJ 4562.
4751     220 XX=H 4563.
4752     XI=HTKM(1) 4564.
4753     IF(H.LT.XI) XX=XI 4565.
4754     IF(H.GT.99.9) GO TO 280 4566.
4755     DO 230 J=2,33 4567.
4756     XJ=HTKM(J) 4568.
4757     IF(XX.LT.XJ) GO TO 260 4569.
4758     230 XI=XJ 4570.
4759     240 XX=P 4571.
4760     XI=PRES(1,NATM) 4572.
4761     IF(P.GT.XI) XX=XI 4573.
4762     IF(P.LT.3.0E-04) GO TO 280 4574.
4763     DO 250 J=2,33 4575.
4764     XJ=PRES(J,NATM) 4576.
4765     IF(XX.GT.XJ) GO TO 260 4577.
4766     250 XI=XJ 4578.
4767     260 DELTA=(XX-XI)/(XJ-XI) 4579.
4768     I=J-1 4580.
4769     C ALOG
4770     IF(NPHD.NE.2) H=HTKM(I)+(HTKM(J)-HTKM(I))*LOG(XX/XI)/LOG(XJ/XI) 4581.
4771     C ALOG
4772     PI=PRES(I,NATM) 4582.
4773     PJ=PRES(J,NATM) 4583.
4774     DI=DENS(I,NATM) 4584.
4775     DJ=DENS(J,NATM) 4585.
4776     IF(NPHD.NE.1) P=PI+DELTA*(PJ-PI) 4586.
4777     IF(NPHD.NE.3) D=DI+DELTA*(DJ-DI) 4587.
4778     T=TEMP(I,NATM)+DELTA*(TEMP(J,NATM)-TEMP(I,NATM)) 4588.
4779     O=OZON(I,NATM)/DI+DELTA*(OZON(J,NATM)/DJ-OZON(I,NATM)/DI) 4589.
4780     Q=WVAP(I,NATM)/DI+DELTA*(WVAP(J,NATM)/DJ-WVAP(I,NATM)/DI) 4590.
4781     ES=10.**(9.4051-2353./T) 4591.
4782     IF(P.LT.PI) PI=P 4592.
4783     S=1.E+06 4593.
4784     RS=(PI-ES+0.622*ES)/(0.622*ES) 4594.
4785     IF(RS.GT.1.E-06) S=1./RS 4595.
4786     OI=O 4596.
4787     QI=Q 4597.
4788     OCM=0. 4598.
4789     WCM=0. 4599.
4790     DO 270 K=J,33 4600.
4791     PJ=PRES(K,NATM) 4601.
4792     DJ=DENS(K,NATM) 4602.
4793     OJ=OZON(K,NATM)/DJ 4603.
4794     QJ=WVAP(K,NATM)/DJ 4604.
4795     DP=PI-PJ 4605.
4796     OCM=OCM+0.5*(OI+OJ)*DP 4606.
4797     WCM=WCM+0.5*(QI+QJ)*DP 4607.
4798     OI=OJ 4608.
4799     QI=QJ 4609.
4800     270 PI=PJ 4610.
4801     WCM=WCM/0.980*22420.7/18.0 4611.
4802     OCM=OCM/0.980*22420.7/48.0 4612.
4803     RETURN 4613.
4804     280 T=210.0 4614.
4805     IF(NATM.EQ.6) T=186.87 4615.
4806     O=1.E-10 4616.
4807     Q=1.E-10 4617.
4808     S=1.E-10 4618.
4809     OCM=1.E-10 4619.
4810     WCM=1.E-10 4620.
4811     IF(NPHD.NE.1) P=1.E-05 4621.
4812     IF(NPHD.NE.2) H=99.99 4622.
4813     IF(NPHD.NE.3) D=2.E-05 4623.
4814     RETURN 4624.
4815     END 4625.
4816     FUNCTION PFOFTK(WAVNA,WAVNB,TK) 4626.
4817     C ------------------------------------------------------------------4627.
4818     C 4628.
4819     C INPUT DATA 4629.
4820     C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4630.
4821     C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4631.
4822     C 4632.
4823     C TK ABSOLUTE TEMPERATURE IN DEGREES KELVIN 4633.
4824     C 4634.
4825     C OUTPUT DATA 4635.
4826     C PFOFTK PLANCK FLUX (W/M**2) 4636.
4827     C 4637.
4828     C 4638.
4829     C REMARKS 4639.
4830     C PLANCK INTENSITY (W/M**2/STER) IS GIVEN BY PFOFTK/PI4640.
4831     C 4641.
4832     C ------------------------------------------------------------------4642.
4833     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4643.
4834     DIMENSION BN(21),BD(21) 4644.
4835     DATA BN/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,5.D0,-691.D0,7.D0 4645.
4836     1,-3617.D0,43867.D0,-174611.D0,854513.D0,-236364091.D0 4646.
4837     2,8553103.D0,-23749461029.D0,8615841276005.D0,-7709321041217.D0 4647.
4838     3,2577687858367.D0,-2631527155305348D 04,2929993913841559D0/ 4648.
4839     DATA BD/1.D0,2.D0,6.D0,30.D0,42.D0,30.D0,66.D0,2730.D0,6.D0 4649.
4840     1,510.D0,798.D0,330.D0,138.D0,2730.D0,6.D0,870.D0,14322.D0 4650.
4841     2,510.D0,6.D0,1919190.D0,6.D0/ 4651.
4842     DATA PI4/97.40909103400244D0/ 4652.
4843     C DATA PI/3.141592653589793D0/ 4653.
4844     DATA HCK/1.43879D0/ 4654.
4845     DATA DGXLIM/1.D-06/ 4655.
4846     PFOFTK=0.D0 4656.
4847     IF(TK.LT.1.D-06) RETURN 4657.
4848     DO 160 II=1,2 4658.
4849     IF(II.EQ.1) X=HCK*WAVNA/TK 4659.
4850     IF(II.EQ.2) X=HCK*WAVNB/TK 4660.
4851     IF(X.GT.2.3D0) GO TO 120 4661.
4852     XX=X*X 4662.
4853     GSUM=1.D0/3.D0-X/8.D0+XX/60.D0 4663.
4854     NB=3 4664.
4855     XNF=XX/2.D0 4665.
4856     DO 100 N=4,38,2 4666.
4857     NB=NB+1 4667.
4858     NNB=NB 4668.
4859     B=BN(NB)/BD(NB) 4669.
4860     XN3=N+3 4670.
4861     XNM=N*(N-1) 4671.
4862     XNF=XNF*(XX/XNM) 4672.
4863     DG=B/XN3*XNF 4673.
4864     GSUM=GSUM+DG 4674.
4865     DGB=DG 4675.
4866     IF(DABS(DG).LT.DGXLIM) GO TO 110 4676.
4867     100 CONTINUE 4677.
4868     110 GX=GSUM*XX*X 4678.
4869     GO TO 150 4679.
4870     120 GSUM=PI4/15.D0 4680.
4871     DO 130 N=1,20 4681.
4872     NNB=N 4682.
4873     XN=N 4683.
4874     XNN=XN*XN 4684.
4875     XNX=XN*X 4685.
4876     IF(XNX.GT.100.D0) GO TO 140 4686.
4877     GTERM=(X*X*(3.D0+XNX)+6.D0*(1.D0+XNX)/XNN)/XNN 4687.
4878     DG=GTERM*DEXP(-XNX) 4688.
4879     GSUM=GSUM-DG 4689.
4880     DGB=DG 4690.
4881     IF(DG.LT.DGXLIM) GO TO 140 4691.
4882     130 CONTINUE 4692.
4883     140 GX=GSUM 4693.
4884     150 CONTINUE 4694.
4885     IF(II.EQ.1) GXA=GX 4695.
4886     IF(II.EQ.2) GXB=GX 4696.
4887     160 CONTINUE 4697.
4888     PNORM=15.D0/PI4 4698.
4889     PFOFTK=DABS(GXB-GXA)*PNORM 4699.
4890     PFOFTK=PFOFTK*5.6692D-08*TK**4 4700.
4891     RETURN 4701.
4892     END 4702.
4893     FUNCTION TKOFPF(WAVNA,WAVNB,FLUXAB) 4703.
4894     C ------------------------------------------------------------------4704.
4895     C 4705.
4896     C INPUT DATA 4706.
4897     C------------------ 4707.
4898     C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4708.
4899     C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4709.
4900     C FLUXAB PLANCK FLUX (W/M**2) IN INTERVAL 4710.
4901     C (WAVNA,WAVNB) 4711.
4902     C 4712.
4903     C OUTPUT DATA 4713.
4904     C------------------ 4714.
4905     C TK BRIGHTNESS TEMPERATURE IN DEGREES KELVIN4715.
4906     C 4716.
4907     C 4717.
4908     C REMARKS 4718.
4909     C------------------ 4719.
4910     C TKOFPF IS INVERSE FUNCTION OF PFOFTK(WAVNA,WAVNB,TK)4720.
4911     C THE OUTPUT OF TKOFPF SATISFIES THE IDENTITY 4721.
4912     C FLUXAB=PFOFTK(WAVNA,WAVNB,TK) 4722.
4913     C (UNITS FOR FLUXAB AND PFOFTK MUST BE IDENTICAL) 4723.
4914     C 4724.
4915     C ------------------------------------------------------------------4725.
4916     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4726.
4917     LOGICAL LOGFIT 4727.
4918     DATA DELFIT/1.D-06/ 4728.
4919     DATA NMAX/20/ 4729.
4920     C IF(FLUXAB.LE.0.D0) RETURN 4730.
4921     LOGFIT=.FALSE. 4731.
4922     NFIT=0 4732.
4923     PF=FLUXAB 4733.
4924     XA=0.D0 4734.
4925     YA=0.D0 4735.
4926     XB=250.D0 4736.
4927     YB=PFOFTK(WAVNA,WAVNB,XB) 4737.
4928     XX=PF*XB/YB 4738.
4929     YY=PFOFTK(WAVNA,WAVNB,XX) 4739.
4930     IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4740.
4931     IF((YY/PF).LT.0.5D0) GO TO 150 4741.
4932     IF((YY/PF).GT.2.0D0) GO TO 170 4742.
4933     IF(XX.GT.XB) GO TO 110 4743.
4934     XC=XB 4744.
4935     YC=YB 4745.
4936     XB=XX 4746.
4937     YB=YY 4747.
4938     GO TO 120 4748.
4939     110 XC=XX 4749.
4940     YC=YY 4750.
4941     120 XBA=XB-XA 4751.
4942     XCA=XC-XA 4752.
4943     XBC=XB-XC 4753.
4944     YBA=YB-YA 4754.
4945     YCA=YC-YA 4755.
4946     YBC=YB-YC 4756.
4947     NFIT=NFIT+1 4757.
4948     IF(NFIT.GT.NMAX) GO TO 200 4758.
4949     YXBA=YBA/XBA 4759.
4950     YXCA=YCA/XCA 4760.
4951     C=(YXBA-YXCA)/XBC 4761.
4952     B=YXBA-(XB+XA)*C 4762.
4953     A=YA-XA*(B+XA*C) 4763.
4954     ROOT=DSQRT(B*B+4.D0*C*(PF-A)) 4764.
4955     XX=0.5D0*(ROOT-B)/C 4765.
4956     IF(XX.LT.XA.OR.XX.GT.XC) XX=-0.5D0*(ROOT+B)/C 4766.
4957     YY=PFOFTK(WAVNA,WAVNB,XX) 4767.
4958     IF(LOGFIT) YY=DLOG(YY) 4768.
4959     IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4769.
4960     IF(XX.GT.XB) GO TO 130 4770.
4961     XC=XB 4771.
4962     YC=YB 4772.
4963     GO TO 140 4773.
4964     130 XA=XB 4774.
4965     YA=YB 4775.
4966     140 XB=XX 4776.
4967     YB=YY 4777.
4968     GO TO 120 4778.
4969     150 XA=XX 4779.
4970     YA=YY 4780.
4971     160 XC=XB 4781.
4972     YC=YB 4782.
4973     XB=XB/2.D0 4783.
4974     YB=PFOFTK(WAVNA,WAVNB,XB) 4784.
4975     IF(YB.LT.YA) GO TO 190 4785.
4976     IF(YB.GT.PF) GO TO 160 4786.
4977     XA=XB 4787.
4978     YA=YB 4788.
4979     GO TO 190 4789.
4980     170 XC=XX 4790.
4981     YC=YY 4791.
4982     180 XA=XB 4792.
4983     YA=YB 4793.
4984     XB=XB*2.D0 4794.
4985     YB=PFOFTK(WAVNA,WAVNB,XB) 4795.
4986     IF(YB.GT.YC) GO TO 190 4796.
4987     IF(YB.LT.PF) GO TO 180 4797.
4988     XC=XB 4798.
4989     YC=YB 4799.
4990     190 XB=XA+(PF-YA)*(XC-XA)/(YC-YA) 4800.
4991     YB=PFOFTK(WAVNA,WAVNB,XB) 4801.
4992     XX=XB 4802.
4993     IF(DABS(YB-PF).LT.DELFIT) GO TO 200 4803.
4994     PF=DLOG(PF) 4804.
4995     YA=DLOG(YA) 4805.
4996     YB=DLOG(YB) 4806.
4997     YC=DLOG(YC) 4807.
4998     LOGFIT=.TRUE. 4808.
4999     GO TO 120 4809.
5000     200 TKOFPF=XX 4810.
5001     RETURN 4811.
5002     END 4812.
5003     SUBROUTINE WRITER(INDEX,KPAGE) 4813.
5004    
5005     #include "B83XX.COM"
5006    
5007     DIMENSION SRAOC(15),SRAEA(15),SRAOI(15),SRALI(15),SRASN(15) 4875.
5008     C 4876.
5009     DIMENSION SRBALB(6),SRXALB(6) 4877.
5010     EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 4878.
5011     C 4879.
5012     +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 4880.
5013     +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 4881.
5014     C 4882.
5015     EQUIVALENCE (ASNALB(1),ASNVIS),(ASNALB(2),ASNNIR) 4883.
5016     EQUIVALENCE (AOIALB(1),AOIVIS),(AOIALB(2),AOINIR) 4884.
5017     EQUIVALENCE (ALIALB(1),ALIVIS),(ALIALB(2),ALINIR) 4885.
5018     C 4886.
5019     EQUIVALENCE 4887.
5020     + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 4888.
5021     +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 4889.
5022     +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 4890.
5023     +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 4891.
5024     +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 4892.
5025     +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 4893.
5026     C 4894.
5027     EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 4895.
5028     EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 4896.
5029     C 4897.
5030     EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 4898.
5031     EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 4899.
5032     C 4900.
5033     EQUIVALENCE (PVT( 1),DESRT),(PVT( 2),TNDRA),(PVT( 3),GRASS) 4901.
5034     + ,(PVT( 4),SHRUB),(PVT( 5),TREES),(PVT( 6),DECID) 4902.
5035     + ,(PVT( 7),EVERG),(PVT( 8),RAINF),(PVT( 9),ROCKS) 4903.
5036     + ,(PVT(10),CROPS),(PVT(11),ALGAE) 4904.
5037     C 4905.
5038     EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 4906.
5039     + ,(FRC(4), FCLO),(FRC(5), FCOV) 4907.
5040     C 4908.
5041     C 4909.
5042     CHARACTER*8 FTYPE 4910.
5043     DIMENSION BGFLUX(25),BGFRAC(25),TAUSUM(25) 4911.
5044     DIMENSION SUM0(15),SUM1(40),SUM2(40),SUM3(40),FTYPE(5),AUXGAS(4) 4912.
5045     DATA FTYPE/'DOWNWARD',' UPWARD','UPWD NET','COOLRATE','FRACTION'/4913.
5046     DATA AUXGAS/1H0,1HL,1HX,1HX/ 4914.
5047     DATA P0/1013.25/ 4915.
5048     C 4916.
5049     INDJ=MOD(INDEX,10) 4917.
5050     IF(INDJ.LT.1) INDJ=10 4918.
5051     INDI=1 4919.
5052     IF(INDEX.LT.11) INDI=INDJ 4920.
5053     DO 9999 INDX=INDI,INDJ 4921.
5054     C 4922.
5055     IF(INDEX.EQ.0) GO TO 10 4923.
5056     GO TO (100,200,300,400,500,600,700,800,900,1000),INDX 4924.
5057     C 4925.
5058     C------------- 4926.
5059     10 CONTINUE 4927.
5060     C------------- 4928.
5061     C 4929.
5062     NPAGE=1 4930.
5063     WRITE(6,6001) NPAGE 4931.
5064     6001 FORMAT(1I1,'(1) RADCOM M/R: (CONTROL/INPUT PARAMETERS)' 4932.
5065     + ,' DEFAULT VALUES & MODIFICATIONS'/) 4933.
5066     WRITE(6,6002) 4934.
5067     6002 FORMAT(20X,'PARAMETER/VALUE',5X,'COMMENTS RE PARAMETER DEFAULT' 4935.
5068     + ,' VALUE AND PARAMETER RANGE AND EFFECT'/10X,'AEROSOLS') 4936.
5069     WRITE(6,6003) 4937.
5070     6003 FORMAT(20X,'FGOLDH(1) = 1.0',5X,'STRATOSPHERIC AEROSOL, GLOBAL' 4938.
5071     + ,' BACKGROUND - TAU(.55) = 0.005' 4939.
5072     + /20X,'FGOLDH(2) = 1.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4940.
5073     + ,' BACKGROUND: TAU(.55) = 0.125' 4941.
5074     + /20X,'FGOLDH(3) = 0.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4942.
5075     + ,' BACKGROUND: TAU(.55) = 0.125 (FOR FGOLDH(3)=1.0' 4943.
5076     + /) 4944.
5077     GO TO 9999 4945.
5078     C 4946.
5079     C------------- 4947.
5080     100 CONTINUE 4948.
5081     C------------- 4949.
5082     C 4950.
5083     C 4951.
5084     NPAGE=1 4952.
5085     IF(INDEX.LT.11) NPAGE=KPAGE 4953.
5086     WRITE(6,6101) NPAGE,LASTVC,KFORCE 4954.
5087     WRITE(6,6102) 4955.
5088     IDPROG=ID5(1) 4956.
5089     ID2TRD=ID5(2) 4957.
5090     ID3SRD=ID5(3) 4958.
5091     ID4VEG=ID5(4) 4959.
5092     ID5FOR=ID5(5) 4960.
5093     FACTOR=P0/(PLB(1)-PLB(2))*1.25 4961.
5094     PPMCO2=ULGAS(1,2)*FACTOR 4962.
5095     PPMO2 =ULGAS(1,4)*FACTOR 4963.
5096     PPMN2O=ULGAS(1,6)*FACTOR 4964.
5097     PPMCH4=ULGAS(1,7)*FACTOR 4965.
5098     PPMF11=ULGAS(1,8)*FACTOR 4966.
5099     PPMF12=ULGAS(1,9)*FACTOR 4967.
5100     WRITE(6,6103) (FULGAS(I),I=1,9),(FGOLDH(I),I=1,5) 4968.
5101     IF(KGASSR.GT.0.OR.KAERSR.GT.0) 4969.
5102     +WRITE(6,6104) (FULGAS(I+9),I=1,9),(FGOLDH(I+9),I=1,5) 4970.
5103     !
5104     ! === Chien Wang 121797
5105     !
5106     #if ( defined CPL_CHEM )
5107     WRITE(6,6105) PPMCO2,PPMO3,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12
5108     #else
5109     WRITE(6,6105) PPMCO2,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12 4971.
5110     #endif
5111     + ,(FGOLDH(I),I=6,9),NV 4972.
5112     WRITE(6,6106) TAUMIN,TLGRAD,EOCTRA,ZOCSRA,FMARCL,FCLDTR,NTRACE 4973.
5113     + ,IDPROG,IMGAS1,KEEPRH,KGASSR,LAYRAD 4974.
5114     WRITE(6,6107) FRACSL,TKCICE,ESNTRA,ZSNSRA,WETTRA,FCLDSR,ITR(1) 4975.
5115     + ,ID2TRD,IMGAS2,KEEPAL,KAERSR,NL 4976.
5116     WRITE(6,6108) RATQSL,FLONO3,EICTRA,ZICSRA,WETSRA,FALGAE,ITR(2) 4977.
5117     + ,ID3SRD,ILGAS1,ISOSCT,KFRACC,NLP 4978.
5118     WRITE(6,6109) FOGTSL,ECLTRA,EDSTRA,ZDSSRA,DMOICE,FRAYLE,ITR(3) 4979.
5119     + ,ID4VEG,ILGAS2,IHGSCT,MARCLD,JMLAT 4980.
5120     WRITE(6,6110) PTLISO,ZCLSRA,EVGTRA,ZVGSRA,DMLICE,LICETK,ITR(4) 4981.
5121     + ,ID5FOR,KWVCON,LAPGAS,NORMS0,IMLON 4982.
5122     C 4983.
5123     6101 FORMAT(1I1,'(1) RADCOM 1/F: (CONTROL/INPUT PARAMETERS)' 4984.
5124     + ,' (GAS/AEROSOL REFERENCE AMOUNT SCALE FACTORS,' 4985.
5125     + ,' DEFAULTS & OPTIONS IN FORCE) LASTVC=',I7 4986.
5126     + /1X,113('-'),' KFORCE=',I10) 4987.
5127     6102 FORMAT(4X,'GAS: ','H2O',5X,'CO2',7X,'O3',6X,'O2',5X,'NO2' 4988.
5128     + ,5X,'N2O',5X,'CH4',6X,'CCL3F1',3X,'CCL2F2' 4989.
5129     + ,3X,'AERSOL: GLOBAL OCEAN LAND DESERT HAZE') 4990.
5130     6103 FORMAT(1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4991.
5131     + ,3X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4992.
5132     6104 FORMAT(1H+,T84,'T' 4993.
5133     + /1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4994.
5134     + ,' S',1X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4995.
5135     !
5136     ! === Chien Wang 121797
5137     !
5138     #if ( defined CPL_CHEM )
5139     6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,f8.4,F8.0,8X,F8.4,F8.4,1X,F8.7
5140     #else
5141     6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,9X,F8.0,8X,F8.4,F8.4,1X,F8.7 4996.
5142     #endif
5143     + ,1X,F8.7,3X,'TRACER=',1P,E7.1,1P,2E9.2,1P,E8.1,' NV=',I2) 4997.
5144     6106 FORMAT(1X,'TAUMIN=',1P,E7.1,1X,'TLGRAD=',0P,F4.1,' EOCTRA=',F3.1 4998.
5145     + ,1X,'ZOCSRA=', F3.1,1X,'FMARCL=', F4.2,1X,'FCLDTR=',F3.1 4999.
5146     + ,1X,'NTRACE=', I2,3X,'IDPROG=', I4,1X,'IMGAS1=', I1 5000.
5147     + ,1X,'KEEPRH=', I1,1X,'KGASSR=', I1,1X,'LAYRAD=', I2) 5001.
5148     6107 FORMAT(1X,'FRACSL=',1P,E7.1,1X,'TKCICE=',0P,F4.0,' ESNTRA=',F3.1 5002.
5149     + ,1X,'ZSNSRA=', F3.1,1X,'WETTRA=', F4.2,1X,'FCLDSR=',F3.1 5003.
5150     + ,1X,'ITR(1)=', I2,3X,'ID2TRD=', I4,1X,'IMGAS2=', I1 5004.
5151     + ,1X,'KEEPAL=', I1,1X,'KAERSR=', I1,1X,' NL=', I2) 5005.
5152     6108 FORMAT(1X,'RATQSL=', F4.2,4X,'FLONO3=', F4.1,1X,'EICTRA=',F3.1 5006.
5153     + ,1X,'ZICSRA=', F3.1,1X,'WETSRA=', F4.2,1X,'FALGAE=',F3.1 5007.
5154     + ,1X,'ITR(2)=', I2,3X,'ID3SRD=', I4,1X,'ILGAS1=', I1 5008.
5155     + ,1X,'ISOSCT=', I1,1X,'KFRACC=', I1,1X,' NLP=', I2) 5009.
5156     6109 FORMAT(1X,'FOGTSL=', F4.2,4X,'ECLTRA=', F4.2,1X,'EDSTRA=',F3.1 5010.
5157     + ,1X,'ZDSSRA=', F3.1,1X,'DMOICE=', F4.1,1X,'FRAYLE=',F3.1 5011.
5158     + ,1X,'ITR(3)=', I2,3X,'ID4VEG=', I4,1X,'ILGAS2=', I1 5012.
5159     + ,1X,'IHGSCT=', I1,1X,'MARCLD=', I1,1X,' JMLAT=', I2) 5013.
5160     6110 FORMAT(1X,'PTLISO=',1PE7.1,1X,'ZCLSRA=',0PF4.2,1X,'EVGTRA=',F3.1 5014.
5161     + ,1X,'ZVGSRA=', F3.1,1X,'DMLICE=', F4.1,1X,'LICETK=', I3 5015.
5162     + ,1X,'ITR(4)=', I2,3X,'ID5FOR=', I4,1X,'KWVCON=', I1 5016.
5163     + ,1X,'LAPGAS=', I1,1X,'NORMS0=', I1,1X,'IMLON=', I3) 5017.
5164     GO TO 9999 5018.
5165     C 5019.
5166     C------------- 5020.
5167     200 CONTINUE 5021.
5168     C------------- 5022.
5169     C 5023.
5170     NPAGE=0 5024.
5171     IF(INDEX.LT.11) NPAGE=KPAGE 5025.
5172     WRITE(6,6201) NPAGE,AUXGAS(LUXGAS+1),S0,COSZ 5026.
5173     DO 202 K=1,9 5027.
5174     DO 201 L=1,NL 5028.
5175     IF(LUXGAS.EQ.0) UXGAS(L,K)=U0GAS(L,K) 5029.
5176     201 IF(LUXGAS.EQ.1) UXGAS(L,K)=ULGAS(L,K) 5030.
5177     202 CONTINUE 5031.
5178     IF(LUXGAS.LT.2) GO TO 205 5032.
5179     LGS=(LUXGAS-2)*9 5033.
5180     DO 203 L=1,NL 5034.
5181     UXGAS(L,1)=U0GAS(L,1)*FULGAS(1+LGS) 5035.
5182     UXGAS(L,3)=U0GAS(L,3)*FULGAS(3+LGS) 5036.
5183     203 UXGAS(L,5)=U0GAS(L,5)*FULGAS(5+LGS) 5037.
5184     C 5038.
5185     DO 204 L=1,NL 5039.
5186     UXGAS(L,2)=U0GAS(L,2)*FULGAS(2+LGS) 5040.
5187     UXGAS(L,4)=U0GAS(L,4)*FULGAS(4+LGS) 5041.
5188     UXGAS(L,6)=U0GAS(L,6)*FULGAS(6+LGS) 5042.
5189     UXGAS(L,7)=U0GAS(L,7)*FULGAS(7+LGS) 5043.
5190     UXGAS(L,8)=U0GAS(L,8)*FULGAS(8+LGS) 5044.
5191     204 UXGAS(L,9)=U0GAS(L,9)*FULGAS(9+LGS) 5045.
5192     205 CONTINUE 5046.
5193     DO 206 N=1,NL 5047.
5194     L=NLP-N 5048.
5195     WRITE(6,6202) L,PLB(L),HLB(L),TLB(L),TLT(L),TLM(L) 5049.
5196     + ,(UXGAS(L,K),K=1,9),CLDTAU(L),SHL(L),RHL(L) 5050.
5197     206 CONTINUE 5051.
5198     DO 207 I=1,15 5052.
5199     207 SUM0(I)=0. 5053.
5200     DO 210 L=1,NL 5054.
5201     DO 208 I=1,9 5055.
5202     208 SUM0(I)=SUM0(I)+ULGAS(L,I) 5056.
5203     DO 209 I=1,4 5057.
5204     209 SUM0(11+I)=SUM0(11+I)+TRACER(L,I) 5058.
5205     210 SUM0(10)=SUM0(10)+CLDTAU(L) 5059.
5206     DO 212 J=1,NGOLDH 5060.
5207     TAU55=0. 5061.
5208     DO 211 I=1,NAERO 5062.
5209     211 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5063.
5210     212 SUM0(11)=SUM0(11)+TAU55 5064.
5211     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5065.
5212     TGMEAN=SQRT(TGMEAN) 5066.
5213     TGMEAN=SQRT(TGMEAN) 5067.
5214     WRITE(6,6203) SUM0(11),(SUM0(I),I=1,10) 5068.
5215     C WRITE(6,6204) POCEAN, TGO, AGESN, ZOICE,LASTVC, DESRT, DECID 5069.
5216     C + ,SRAOC(1),SRAEA(1),SRAOI(1),SRALI(1),SRASN(1) 5070.
5217     C + ,SRDALB(1),SRXALB(1) 5071.
5218     C WRITE(6,6205) PEARTH, TGE, SNOWE,WEARTH, PSIG0, TNDRA, EVERG 5072.
5219     C WRITE(6,6206) POICE, TGOI,SNOWOI,FRACCC, ALGAE, GRASS, RAINF 5073.
5220     C WRITE(6,6207) PLICE, TGLI,SNOWLI, JYEAR,TRACR1, SHRUB, ROCKS 5074.
5221     C WRITE(6,6208) MEANAL,TGMEAN,EXSNEA, JDAY,TRACR2, TREES, CROPS 5075.
5222     C WRITE(6,6209) KALVIS, TSL,EXSNOI, JLAT,TRACR3, FCHI, FCLO 5076.
5223     C WRITE(6,6210) LUXGAS, WMAG,EXSNLI, ILON,TRACR4, FCMI, FCOV 5077.
5224     C 5078.
5225     WRITE(6,6204) POCEAN,TGO,AGESN,WMAG,SUM0(12),JYEAR,BSNVIS,BSNNIR 5079.
5226     + ,LASTVC 5080.
5227     WRITE(6,6205) PEARTH,TGE,SNOWE,WEARTH,SUM0(13),JDAY,XSNVIS,XSNNIR 5081.
5228     WRITE(6,6206) POICE,TGOI,SNOWOI,ZOICE,SUM0(14),JLAT 5082.
5229     + ,(SRBALB(I),I=1,6) 5083.
5230     WRITE(6,6207) PLICE,TGLI,SNOWLI,FRC(5),SUM0(15),ILON 5084.
5231     + ,(SRXALB(I),I=1,6) 5085.
5232     WRITE(6,6208) TGMEAN,LUXGAS,PSUM,TSL,MEANAL,KALVIS,(PVT(I),I=1,11)5086.
5233     WRITE(6,6209) (BXA(I),I=1,19) 5087.
5234     6201 FORMAT(1I1,'(2) RADCOM G/L: (INPUT DATA)' 5088.
5235     + ,T41,' ABSORBER AMOUNT PER LAYER:' 5089.
5236     + ,' U',1A1,'GAS(L,K) IN CM**3(STP)/CM**2' 5090.
5237     + ,T109,'S0=',F8.3,3X,'COSZ=',F6.4/1X,132('-') 5091.
5238     + /' LN PLB HLB TLB TLT TLM ' 5092.
5239     + ,'H2O CO2 O3 O2 NO2 N2O CH4' 5093.
5240     + ,' CCL3F1 CCL2F2 CLDTAU SHL RHL ') 5094.
5241     6202 FORMAT(1X,I2,F9.3,F6.2,3F7.2,F9.3,F8.3,1X,F6.5,F8.0,1P,1E9.2 5095.
5242     + ,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,1F7.2,1X,F7.6,1X,F5.4) 5096.
5243     6203 FORMAT( 1X,'$SUM AERSOL=',F5.3,7X,'$COLUMN AMOUNT',F9.3 5097.
5244     + ,F8.3,1X,F6.5,F8.0,1P,1E9.2,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,F7.2) 5098.
5245     6204 FORMAT(/1X,'POCEAN=',F6.4,' TGO=' ,F6.2,1X,' AGESN=',F6.3 5099.
5246     + , 1X,' WMAG=',F6.3,' TRACER 1=',F5.3,' JYEAR=',I4 5100.
5247     + , 3X,'BSNVIS=',F6.4,' BSNNIR=' ,F6.4,7X,'LASTVC=',I7) 5101.
5248     6205 FORMAT( ' PEARTH=',F6.4,' TGE=',F6.2,' SNOWE=',F6.3 5102.
5249     + , ' WEARTH=',F6.3,' $SUMS: 2=',F5.3 5103.
5250     + , ' JDAY=',I4 ,2X,' XSNVIS=',F6.4,' XSNNIR=',F6.4 5104.
5251     + , 8X,'NIRALB VISALB') 5105.
5252     6206 FORMAT( ' POICE=',F6.4,' TGOI=',F6.2,' SNOWOI=',F6.3 5106.
5253     + , ' ZOICE=',F6.3,' 3=',F5.3 5107.
5254     + , ' JLAT=',I4, 2X,' SRBALB=',F6.4 5108.
5255     + ,4F7.4,F7.4) 5109.
5256     6207 FORMAT( ' PLICE=',F6.4,' TGLI=',F6.2,' SNOWLI=',F6.3 5110.
5257     + , ' FRC(5)=',F6.3,' 4=',F5.3 5111.
5258     + , ' ILON=',I4, 2X,' SRXALB=',F6.4 5112.
5259     + ,4F7.4,F7.4) 5113.
5260     6208 FORMAT( 1X,13('-'),'$TGMEAN=',F6.2,14X,' LUXGAS=',I1,5X 5114.
5261     + ,1X,'DESERT TUNDRA GRASSL SHRUBS TREES DECIDF' 5115.
5262     + ,' EVERGF',' RAINF',' ROCKS',' CROPS',' ALGAE' 5116.
5263     + / ' $PSUM=',F6.4,' TSL=',F6.2,' MEANAL=',I1 5117.
5264     + ,5X,' KALVIS=',I1,T54,'PVT=',F6.4,10F7.4) 5118.
5265     6209 FORMAT(' BOCVIS BOCNIR XOCVIS XOCNIR|BEAVIS BEANIR XEAVIS XEANIR' 5119.
5266     + ,'|BOIVIS BOINIR XOIVIS XOINIR|BLIVIS BLINIR XLIVIS XLINIR' 5120.
5267     + ,'|EXPSNE|EXPSNO|EXPSNL'/1X,F6.4,18F7.4) 5121.
5268     GO TO 9999 5122.
5269     C 5123.
5270     C------------- 5124.
5271     300 CONTINUE 5125.
5272     C------------- 5126.
5273     C 5127.
5274     NPAGE=0 5128.
5275     IF(INDEX.LT.11) NPAGE=KPAGE 5129.
5276     IF(NL.GT.13) NPAGE=1 5130.
5277     L=NLP 5131.
5278     STNFLB=SRNFLB(L)-TRNFLB(L) 5132.
5279     WRITE(6,6301) NPAGE,NORMS0 5133.
5280     WRITE(6,6302) L,PLB(L),HLB(L),TLB(L) 5134.
5281     + ,TRDFLB(L),TRUFLB(L),TRNFLB(L) 5135.
5282     + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),STNFLB 5136.
5283     DO 301 N=1,NL 5137.
5284     L=NLP-N 5138.
5285     CRHRF=8.4167/(PLB(L)-PLB(L+1)) 5139.
5286     STNFLB=SRNFLB(L)-TRNFLB(L) 5140.
5287     STFHR =SRFHRL(L)-TRFCRL(L) 5141.
5288     TRDCR =TRFCRL(L)*CRHRF 5142.
5289     SRDHR =SRFHRL(L)*CRHRF 5143.
5290     STDHR=STFHR*CRHRF 5144.
5291     SRALB =SRUFLB(L)/(SRDFLB(L)+1.E-10) 5145.
5292     SRXVIS=SRXATM(1) 5146.
5293     SRXNIR=SRXATM(2) 5147.
5294     WRITE(6,6303) L,PLB(L),HLB(L),TLB(L),TLT(L) 5148.
5295     + ,TRDFLB(L),TRUFLB(L),TRNFLB(L),TRFCRL(L) 5149.
5296     + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),SRFHRL(L) 5150.
5297     + ,STNFLB,STFHR,STDHR,TRDCR,SRDHR,SRALB 5151.
5298     301 CONTINUE 5152.
5299     C 5153.
5300     WRITE(6,6304) BTEMPW,TRUFTW,SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR 5154.
5301     + ,PLANIR 5155.
5302     WRITE(6,6305) TRDFGW,TRUFGW,SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR 5156.
5303     + ,ALBNIR 5157.
5304     WRITE(6,6306) SRXVIS,SRXNIR,SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR 5158.
5305     + ,SRANIR 5159.
5306     WRITE(6,6307) TRDFSL,TRUFSL,TRSLCR,TRSLTS,TRSLTG,TRSLWV,TRSLBS 5160.
5307     + ,SRSLHR 5161.
5308     C 5162.
5309     WRITE(6,6308) (FSRNFG(I),I=1,4),LTOPCL,JLAT,JYEAR 5163.
5310     WRITE(6,6309) (FTRUFG(I),I=1,4),LBOTCL,ILON,JDAY 5164.
5311     WRITE(6,6310) (DTRUFG(I),I=1,4),TTRUFG,COSZ 5165.
5312     C 5166.
5313     6301 FORMAT(1I1,'(3) RADCOM M/S: (OUTPUT DATA)' 5167.
5314     + ,T37,'THERMAL FLUXES (W/M**2)',4X,'SOLAR FLUXES (W/M**2)' 5168.
5315     + ,1X,'NORMS0=',I1,' ENERGY INPUT HEAT/COOL DEG/DAY ALB' 5169.
5316     + ,'DO'/1X,31('-'),2X,9('---'),2X,10('---'),1X,'$',7('-') 5170.
5317     + ,'$',5('-'),1X,'$',5('-'),'$',5('-'),'$',5('-'),1X,'$----' 5171.
5318     + /' LN PLB HLB TLB TLT ' 5172.
5319     + ,' TRDFLB TRUFLB TRNFLB TRFCRL SRDFLB SRUFLB SRNFLB' 5173.
5320     + ,' SRFHRL STNFLB STFHR STDHR TRDCR SRDHR SRALB') 5174.
5321     6302 FORMAT(1X,I2,F9.3,F6.2,1X,F6.2,8X,3F7.2,8X,3F8.2,7X,F8.2) 5175.
5322     6303 FORMAT(1X,I2,F9.3,F6.2,2F7.2,1X,3F7.2,F7.2,1X,3F8.2,F7.2,1X,F7.2 5176.
5323     + ,1X,F6.2,1X,3F6.2,1X,F5.4) 5177.
5324     6304 FORMAT(/1X,'AT ATM TOP: ',' BTEMPW=',F6.2,1X,' TRUFTW=',F6.3 5178.
5325     + , 2X,' SRIVIS=',F6.2,' SROVIS=',F6.2, ' PLAVIS=',F6.4 5179.
5326     + , 2X,' SRINIR=',F6.2,' SRONIR=',F6.2, ' PLANIR=',F6.4) 5180.
5327     6305 FORMAT( 1X,'AT GROUND : ',' TRDFGW=',F6.3,1X,' TRUFGW=',F6.3 5181.
5328     + , 2X,' SRDVIS=',F6.2,' SRUVIS=',F6.2, ' ALBVIS=',F6.4 5182.
5329     + , 2X,' SRDNIR=',F6.2,' SRUNIR=',F6.2, ' ALBNIR=',F6.4) 5183.
5330     6306 FORMAT( 1X,'ATMOSPHERE: ',' SRXVIS=',F6.4,1X,' SRXNIR=',F6.4 5184.
5331     + , 2X,' SRTVIS=',F6.4,' SRRVIS=',F6.4, ' SRAVIS=',F6.4 5185.
5332     + , 2X,' SRTNIR=',F6.4,' SRRNIR=',F6.4, ' SRANIR=',F6.4) 5186.
5333     6307 FORMAT( 1X,'SURF LAYER: ',' TRDRSL=',F6.2,1X,' TRUFSL=',F6.2 5187.
5334     + , 2X,' TRSLCR=',F6.4,'+TRSLTS=',F6.4, '-TRSLTG=',F6.4 5188.
5335     + , 2X,' TRSLWV=',F6.4,' TRSLBS=',F6.3, ' SRSLHR=',F6.4) 5189.
5336     6308 FORMAT(/1X,'FSRNFG(I)=> FRAC SRNFLB(1) EACH SURFTYPE' 5190.
5337     + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5191.
5338     + ,F7.4,1X,' LTOPCL=',I2,' JLAT=',I2,' JYEAR',I4) 5192.
5339     6309 FORMAT( 1X,'FTRUFG(I)=> FRAC TRUFLB(1) EACH SURFTYPE' 5193.
5340     + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5194.
5341     + ,F7.4,1X,' LBOTCL=',I2,' ILON=',I2,' JDAY=',I4) 5195.
5342     6310 FORMAT( 1X,'DTRUFG(I)=> DERIV TRUFLB(1) EACH SURFTYPE' 5196.
5343     + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5197.
5344     + ,F7.4, '=>TTRUFG=',F6.4,' COSZ=',F6.4) 5198.
5345     GO TO 9999 5199.
5346     C 5200.
5347     C------------- 5201.
5348     400 CONTINUE 5202.
5349     C------------- 5203.
5350     GO TO 9999 5204.
5351     C 5205.
5352     C------------- 5206.
5353     500 CONTINUE 5207.
5354     C------------- 5208.
5355     C 5209.
5356     NPAGE=1 5210.
5357     IF(INDEX.LT.11) NPAGE=KPAGE 5211.
5358     SIGMA=5.6697D-08 5212.
5359     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5213.
5360     TGMEAN=SQRT(TGMEAN) 5214.
5361     TGMEAN=SQRT(TGMEAN) 5215.
5362     SIGT4=SIGMA*TGMEAN**4 5216.
5363     ITG=TGMEAN 5217.
5364     WTG=TGMEAN-ITG 5218.
5365     ITG=ITG-IT0 5219.
5366     SUMK=0.0 5220.
5367     DO 501 K=1,NKTR 5221.
5368     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5222.
5369     BGFRAC(K)=BGFLUX(K)/SIGT4 5223.
5370     SUMK=SUMK+BGFLUX(K) 5224.
5371     ITG=ITG+ITNEXT 5225.
5372     501 CONTINUE 5226.
5373     WRITE(6,6501) NPAGE 5227.
5374     WRITE(6,6502) (K,K=1,11) 5228.
5375     DO 502 N=1,NL 5229.
5376     L=NLP-N 5230.
5377     LI=L 5231.
5378     LL=NL*10+L 5232.
5379     WRITE(6,6503) L,PL(L),DPL(L),TLM(L),(TAULAP(I),I=LI,LL,NL) 5233.
5380     502 CONTINUE 5234.
5381     LK=0 5235.
5382     DO 504 K=1,NKTR 5236.
5383     TAUSUM(K)=0. 5237.
5384     DO 503 L=1,NL 5238.
5385     LK=LK+1 5239.
5386     503 TAUSUM(K)=TAUSUM(K)+TAULAP(LK) 5240.
5387     504 CONTINUE 5241.
5388     WRITE(6,6504) (TAUSUM(K),K=1,11) 5242.
5389     WRITE(6,6505) 5243.
5390     WRITE(6,6506) SUMK,(BGFLUX(K),K=1,11) 5244.
5391     WRITE(6,6507) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5245.
5392     NPAGE=0 5246.
5393     IF(NL.GT.13) NPAGE=1 5247.
5394     WRITE(6,6508) NPAGE 5248.
5395     WRITE(6,6509) (K,K=12,25) 5249.
5396     DO 505 N=1,NL 5250.
5397     L=NLP-N 5251.
5398     LI=NL*11+L 5252.
5399     LL=NL*24+L 5253.
5400     WRITE(6,6510) L,(TAULAP(I),I=LI,LL,NL) 5254.
5401     505 CONTINUE 5255.
5402     WRITE(6,6511) (TAUSUM(K),K=12,NKTR) 5256.
5403     WRITE(6,6512) (BGFLUX(K),K=12,NKTR) 5257.
5404     WRITE(6,6513) (BGFRAC(K),K=12,NKTR) 5258.
5405     C 5259.
5406     6501 FORMAT(1I1,'(5) TAULAP TABLE FOR THERMAL RADIATION: INCLUDES' 5260.
5407     + ,' WEAK OVERLAPPING GAS ABSORPTION BY' 5261.
5408     + ,' H2O, CO2, O3, N2O, CH4',T117,'LIST: TAULAP(LK)'/ 5262.
5409     + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5263.
5410     + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5264.
5411     + ,/T30,8('-'),3X,93('-')) 5265.
5412     6502 FORMAT(' LN PL DPL TLM K=' 5266.
5413     + ,I4,5X,'K=',I4,I10,5I9,3I10) 5267.
5414     6503 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5268.
5415     6504 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5269.
5416     6505 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5270.
5417     6506 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5271.
5418     6507 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5272.
5419     + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5273.
5420     6508 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5274.
5421     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5275.
5422     + /4X,92('-'),3X,34('-')) 5276.
5423     6509 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5277.
5424     6510 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5278.
5425     6511 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5279.
5426     6512 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5280.
5427     6513 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5281.
5428     GO TO 9999 5282.
5429     C 5283.
5430     C------------- 5284.
5431     600 CONTINUE 5285.
5432     C------------- 5286.
5433     C 5287.
5434     NPAGE=1 5288.
5435     IF(INDEX.LT.11) NPAGE=KPAGE 5289.
5436     SIGMA=5.6697D-08 5290.
5437     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5291.
5438     TGMEAN=SQRT(TGMEAN) 5292.
5439     TGMEAN=SQRT(TGMEAN) 5293.
5440     SIGT4=SIGMA*TGMEAN**4 5294.
5441     ITG=TGMEAN 5295.
5442     WTG=TGMEAN-ITG 5296.
5443     ITG=ITG-IT0 5297.
5444     SUMK=0.0 5298.
5445     DO 601 K=1,NKTR 5299.
5446     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5300.
5447     BGFRAC(K)=BGFLUX(K)/SIGT4 5301.
5448     SUMK=SUMK+BGFLUX(K) 5302.
5449     ITG=ITG+ITNEXT 5303.
5450     601 CONTINUE 5304.
5451     WRITE(6,6601) NPAGE 5305.
5452     WRITE(6,6602) (K,K=1,11) 5306.
5453     DO 602 N=1,NL 5307.
5454     L=NLP-N 5308.
5455     LI=L 5309.
5456     LL=NL*10+L 5310.
5457     WRITE(6,6603) L,PL(L),DPL(L),TLM(L),(TAUN(I),I=LI,LL,NL) 5311.
5458     602 CONTINUE 5312.
5459     LK=0 5313.
5460     DO 604 K=1,NKTR 5314.
5461     TAUSUM(K)=TAUSL(K) 5315.
5462     DO 603 L=1,NL 5316.
5463     LK=LK+1 5317.
5464     603 TAUSUM(K)=TAUSUM(K)+TAUN(LK) 5318.
5465     604 CONTINUE 5319.
5466     WRITE(6,6604) (TAUSL(K),K=1,11) 5320.
5467     WRITE(6,6605) (TAUSUM(K),K=1,11) 5321.
5468     WRITE(6,6606) SUMK,(BGFLUX(K),K=1,11) 5322.
5469     WRITE(6,6607) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5323.
5470     NPAGE=0 5324.
5471     IF(NL.GT.13) NPAGE=1 5325.
5472     WRITE(6,6608) NPAGE 5326.
5473     WRITE(6,6609) (K,K=12,25) 5327.
5474     DO 605 N=1,NL 5328.
5475     L=NLP-N 5329.
5476     LI=NL*11+L 5330.
5477     LL=NL*24+L 5331.
5478     WRITE(6,6610) L,(TAUN(I),I=LI,LL,NL) 5332.
5479     605 CONTINUE 5333.
5480     WRITE(6,6611) ( TAUSL(K),K=12,NKTR) 5334.
5481     WRITE(6,6612) (TAUSUM(K),K=12,NKTR) 5335.
5482     WRITE(6,6613) (BGFLUX(K),K=12,NKTR) 5336.
5483     WRITE(6,6614) (BGFRAC(K),K=12,NKTR) 5337.
5484     C 5338.
5485     6601 FORMAT(1I1,'(6) TAU TABLE FOR THERMAL RADIATION: INCLUDES ANY' 5339.
5486     + ,' SPECIFIED OVERLAP, CLOUD & AEROSOL ABSORPTION' 5340.
5487     + ,T117,'TAUN(LK),TAUSL(L)'/ 5341.
5488     + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5342.
5489     + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5343.
5490     + ,/T30,8('-'),3X,93('-')) 5344.
5491     6602 FORMAT(' LN PL DPL TLM K=' 5345.
5492     + ,I4,5X,'K=',I4,I10,5I9,3I10) 5346.
5493     6603 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5347.
5494     6604 FORMAT(/13X,'SURFACE LAYER=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5348.
5495     6605 FORMAT(/13X,'COLUMN AMOUNT=',F10.3,F11.3,F10.3,5F9.3,3F10.3) 5349.
5496     6606 FORMAT(/1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5350.
5497     6607 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5351.
5498     + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5352.
5499     6608 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5353.
5500     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5354.
5501     + /4X,92('-'),3X,34('-')) 5355.
5502     6609 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5356.
5503     6610 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5357.
5504     6611 FORMAT(/1X,'SL',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5358.
5505     6612 FORMAT(/1X,'CA',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5359.
5506     6613 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5360.
5507     6614 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5361.
5508     GO TO 9999 5362.
5509     C 5363.
5510     C------------- 5364.
5511     700 CONTINUE 5365.
5512     C------------- 5366.
5513     C 5367.
5514     NPAGE=1 5368.
5515     IF(INDEX.LT.11) NPAGE=KPAGE 5369.
5516     SIGMA=5.6697D-08 5370.
5517     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5371.
5518     TGMEAN=SQRT(TGMEAN) 5372.
5519     TGMEAN=SQRT(TGMEAN) 5373.
5520     SIGT4=SIGMA*TGMEAN**4 5374.
5521     ITG=TGMEAN 5375.
5522     WTG=TGMEAN-ITG 5376.
5523     ITG=ITG-IT0 5377.
5524     SUMK=0.0 5378.
5525     DO 701 K=1,NKTR 5379.
5526     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5380.
5527     BGFRAC(K)=BGFLUX(K)/SIGT4 5381.
5528     SUMK=SUMK+BGFLUX(K) 5382.
5529     ITG=ITG+ITNEXT 5383.
5530     701 CONTINUE 5384.
5531     WRITE(6,6701) NPAGE 5385.
5532     WRITE(6,6702) (K,K=1,11) 5386.
5533     DO 702 N=1,NL 5387.
5534     L=NLP-N 5388.
5535     WRITE(6,6703) L,PL(L),DPL(L),TLM(L),(TRAEXT(L,K),K=1,11) 5389.
5536     702 CONTINUE 5390.
5537     DO 704 K=1,NKTR 5391.
5538     TAUSUM(K)=0. 5392.
5539     DO 703 L=1,NL 5393.
5540     703 TAUSUM(K)=TAUSUM(K)+TRAEXT(L,K) 5394.
5541     704 CONTINUE 5395.
5542     WRITE(6,6704) (TAUSUM(K),K=1,11) 5396.
5543     WRITE(6,6705) 5397.
5544     WRITE(6,6706) SUMK,(BGFLUX(K),K=1,11) 5398.
5545     WRITE(6,6707) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5399.
5546     NPAGE=0 5400.
5547     IF(NL.GT.13) NPAGE=1 5401.
5548     WRITE(6,6708) NPAGE 5402.
5549     WRITE(6,6709) (K,K=12,25) 5403.
5550     DO 705 N=1,NL 5404.
5551     L=NLP-N 5405.
5552     WRITE(6,6710) L,(TRAEXT(L,K),K=12,NKTR) 5406.
5553     705 CONTINUE 5407.
5554     WRITE(6,6711) (TAUSUM(K),K=12,NKTR) 5408.
5555     WRITE(6,6712) (BGFLUX(K),K=12,NKTR) 5409.
5556     WRITE(6,6713) (BGFRAC(K),K=12,NKTR) 5410.
5557     C 5411.
5558     6701 FORMAT(1I1,'(7) AEROSOL TAU TABLE FOR THERMAL RADIATION:' 5412.
5559     + ,' CLOUD & AEROSOL ABSORPTION' 5413.
5560     + ,T116,'LIST: TRAEXT(L,K)'/ 5414.
5561     + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5415.
5562     + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5416.
5563     + ,/T30,8('-'),3X,93('-')) 5417.
5564     6702 FORMAT(' LN PL DPL TLM K=' 5418.
5565     + ,I4,5X,'K=',I4,I10,5I9,3I10) 5419.
5566     6703 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5420.
5567     6704 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5421.
5568     6705 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5422.
5569     6706 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5423.
5570     6707 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5424.
5571     + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5425.
5572     6708 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5426.
5573     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5427.
5574     + /4X,92('-'),3X,34('-')) 5428.
5575     6709 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5429.
5576     6710 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5430.
5577     6711 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5431.
5578     6712 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5432.
5579     6713 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5433.
5580     GO TO 9999 5434.
5581     C 5435.
5582     C------------- 5436.
5583     800 CONTINUE 5437.
5584     C------------- 5438.
5585     C 5439.
5586     NPAGE=1 5440.
5587     IF(INDEX.LT.11) NPAGE=KPAGE 5441.
5588     WRITE(6,6801) NPAGE 5442.
5589     DO 802 K=1,NKSR 5443.
5590     SUM1(K)=0. 5444.
5591     SUM2(K)=0. 5445.
5592     SUM3(K)=0. 5446.
5593     DO 801 L=1,NL 5447.
5594     SUM1(K)=SUM1(K)+EXTAER(L,K) 5448.
5595     SUM2(K)=SUM2(K)+SCTAER(L,K) 5449.
5596     SUM3(K)=SUM3(K)+SCTAER(L,K)*COSAER(L,K) 5450.
5597     801 PI0AER(L,K)=SCTAER(L,K)/(EXTAER(L,K)+1.E-10) 5451.
5598     SUM3(K)=SUM3(K)/(SUM2(K)+1.E-10) 5452.
5599     SUM0(K)=SUM2(K)/(SUM1(K)+1.E-10) 5453.
5600     802 CONTINUE 5454.
5601     WRITE(6,6802) (K,K=1,6),(K,K=1,6) 5455.
5602     DO 803 N=1,NL 5456.
5603     L=NLP-N 5457.
5604     WRITE(6,6803) L,PLB(L),HLB(L) 5458.
5605     + ,(EXTAER(L,J),J=1,6),(SCTAER(L,J),J=1,6) 5459.
5606     803 CONTINUE 5460.
5607     WRITE(6,6804) (SUM1(K),K=1,NKSR),(SUM2(K),K=1,NKSR) 5461.
5608     NPAGE=0 5462.
5609     IF(NL.GT.13) NPAGE=1 5463.
5610     WRITE(6,6805) NPAGE 5464.
5611     WRITE(6,6806) (K,K=1,6),(K,K=1,6) 5465.
5612     DO 804 N=1,NL 5466.
5613     L=NLP-N 5467.
5614     WRITE(6,6807) L,PL(L),DPL(L) 5468.
5615     + ,(COSAER(L,J),J=1,6),(PI0AER(L,J),J=1,6) 5469.
5616     804 CONTINUE 5470.
5617     WRITE(6,6808) (SUM3(K),K=1,NKSR),(SUM0(K),K=1,NKSR) 5471.
5618     WRITE(6,6809) (SRBALB(K),K=1,NKSR) 5472.
5619     WRITE(6,6810) (SRXALB(K),K=1,NKSR) 5473.
5620     WRITE(6,6811) 5474.
5621     SUM=0. 5475.
5622     DO 806 J=1,5 5476.
5623     TAU55=0. 5477.
5624     DO 805 I=1,NAERO 5478.
5625     805 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5479.
5626     WRITE(6,6812) J,FGOLDH(J),TAU55 5480.
5627     806 SUM=SUM+TAU55 5481.
5628     WRITE(6,6813) SUM 5482.
5629     C 5483.
5630     6801 FORMAT(1I1,'(8) AEROSOL INPUT FOR SOLAR RADIATION:' 5484.
5631     + ,' AEROSOL RADIATIVE PROPERTIES' 5485.
5632     + ,T81,'LIST: EXTAER(L,K),SCTAER(L,K),COSAER(L,K),PIZERO(L,K)'5486.
5633     + //T42,'TAU -- EXTINCTION',T99,'TAU -- SCATTERING' 5487.
5634     + ,/T24,53('-'),4X,53('-')) 5488.
5635     6802 FORMAT(' LN PLB HLB K=',I3,5I9,7X,'K=',I3,5I9) 5489.
5636     6803 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5490.
5637     6804 FORMAT(/1X,T7,'COLUMN AMOUNT=',2X,6F9.6,3X,6F9.6) 5491.
5638     6805 FORMAT(1I1/T48,'COSBAR',T105,'PIZERO' 5492.
5639     + ,/T24,53('-'),4X,53('-')) 5493.
5640     6806 FORMAT(' LN PL DPL K=',I3,5I9,7X,'K=',I3,5I9) 5494.
5641     6807 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5495.
5642     6808 FORMAT(/1X,T7,'COLUMN MEAN=',2X,6F9.6,3X,6F9.6) 5496.
5643     6809 FORMAT(/1X,T7,'ALBEDO RSURFB=',2X,6F9.6,3X,6F9.6) 5497.
5644     6810 FORMAT( 1X,T7,'ALBEDO RSURFX=',2X,6F9.6,3X,6F9.6) 5498.
5645     GO TO 9999 5499.
5646     6811 FORMAT(///T44,'AEROSOL COMPOSITION AND TYPE MIX:' 5500.
5647     + ,T81,'FACTOR',6X,'VALUE',T107,'TAU(0.55)'/) 5501.
5648     6812 FORMAT(T81,'FGOLDH(',I1,') =',1P,E9.2,5X,0P,F7.4) 5502.
5649     6813 FORMAT(/T81,'SUM COLUMN TAU(0.55) =',F10.4) 5503.
5650     C 5504.
5651     C------------- 5505.
5652     900 CONTINUE 5506.
5653     C------------- 5507.
5654     C 5508.
5655     SIGMA=5.6697D-08 5509.
5656     TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5510.
5657     TGMEAN=SQRT(TGMEAN) 5511.
5658     TGMEAN=SQRT(TGMEAN) 5512.
5659     SIGT4=SIGMA*TGMEAN**4 5513.
5660     ITG=TGMEAN 5514.
5661     WTG=TGMEAN-ITG 5515.
5662     ITG=ITG-IT0 5516.
5663     DO 901 K=1,NKTR 5517.
5664     BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5518.
5665     BGFRAC(K)=BGFLUX(K)/SIGT4 5519.
5666     ITG=ITG+ITNEXT 5520.
5667     901 CONTINUE 5521.
5668     DO 910 NW=1,5 5522.
5669     DO 903 K=1,NKTR 5523.
5670     DO 902 L=1,NLP 5524.
5671     IF(NW.EQ.1) WFLB(L,K)=DFLB(L,K) 5525.
5672     IF(NW.EQ.2) WFLB(L,K)=UFLB(L,K) 5526.
5673     IF(NW.EQ.3) WFLB(L,K)=UFLB(L,K)-DFLB(L,K) 5527.
5674     IF(NW.GT.3.AND.L.GT.NL) GO TO 902 5528.
5675     IF(NW.EQ.4) WFLB(L,K)=WFLB(L+1,K)-WFLB(L,K) 5529.
5676     IF(NW.EQ.5.AND.ABS(TRFCRL(L)).LT.1.E-10) WFLB(L,K)=1.E-30 5530.
5677     IF(NW.EQ.5) WFLB(L,K)=WFLB(L,K)/(ABS(TRFCRL(L))+1.E-10) 5531.
5678     902 CONTINUE 5532.
5679     IF(NW.EQ.1) WFSL(K)=DFSL(K) 5533.
5680     IF(NW.EQ.2) WFSL(K)=UFSL(K) 5534.
5681     IF(NW.EQ.3) WFSL(K)=UFSL(K)-DFSL(K) 5535.
5682     IF(NW.EQ.4) WFSL(K)=WFSL(K)-UFLB(1,K)+DFLB(1,K) 5536.
5683     IF(NW.EQ.5.AND.ABS(TRSLCR).LT.1.E-10) WFSL(K)=1.E-30 5537.
5684     IF(NW.EQ.5) WFSL(K)=WFSL(K)/(ABS(TRSLCR)+1.E-10) 5538.
5685     903 CONTINUE 5539.
5686     DO 907 L=1,NLP 5540.
5687     IF(L.GT.NL.AND.NW.GT.3) GO TO 907 5541.
5688     ASUM1=0. 5542.
5689     BSUM1=0. 5543.
5690     CSUM1=0. 5544.
5691     DSUM1=0. 5545.
5692     ESUM1=0. 5546.
5693     FSUM1=0. 5547.
5694     SUM=0. 5548.
5695     DO 904 K=2,11 5549.
5696     ASUM1=ASUM1+ WFSL(K) 5550.
5697     BSUM1=BSUM1+ BGFEMT(K) 5551.
5698     CSUM1=CSUM1+BGFLUX(K) 5552.
5699     DSUM1=DSUM1+BGFRAC(K) 5553.
5700     ESUM1=ESUM1+TRCALB(K) 5554.
5701     FSUM1=FSUM1+ TRGALB(K) 5555.
5702     904 SUM=SUM+WFLB(L,K) 5556.
5703     SUM1(L)=SUM 5557.
5704     ASUM2=0. 5558.
5705     BSUM2=0. 5559.
5706     CSUM2=0. 5560.
5707     DSUM2=0. 5561.
5708     ESUM2=0. 5562.
5709     FSUM2=0. 5563.
5710     SUM=0. 5564.
5711     DO 905 K=12,21 5565.
5712     ASUM2=ASUM2+ WFSL(K) 5566.
5713     BSUM2=BSUM2+ BGFEMT(K) 5567.
5714     CSUM2=CSUM2+BGFLUX(K) 5568.
5715     DSUM2=DSUM2+BGFRAC(K) 5569.
5716     ESUM2=ESUM2+TRCALB(K) 5570.
5717     FSUM2=FSUM2+ TRGALB(K) 5571.
5718     905 SUM=SUM+WFLB(L,K) 5572.
5719     SUM2(L)=SUM 5573.
5720     ASUM3=0. 5574.
5721     BSUM3=0. 5575.
5722     CSUM3=0. 5576.
5723     DSUM3=0. 5577.
5724     ESUM3=0. 5578.
5725     FSUM3=0. 5579.
5726     SUM=0. 5580.
5727     DO 906 K=22,NKTR 5581.
5728     ASUM3=ASUM3+ WFSL(K) 5582.
5729     BSUM3=BSUM3+ BGFEMT(K) 5583.
5730     CSUM3=CSUM3+BGFLUX(K) 5584.
5731     DSUM3=DSUM3+BGFRAC(K) 5585.
5732     ESUM3=ESUM3+TRCALB(K) 5586.
5733     FSUM3=FSUM3+ TRGALB(K) 5587.
5734     906 SUM=SUM+WFLB(L,K) 5588.
5735     SUM3(L)=SUM 5589.
5736     907 CONTINUE 5590.
5737     C 5591.
5738     NPAGE=1 5592.
5739     WRITE(6,6901) NPAGE,NW,FTYPE(NW) 5593.
5740     WRITE(6,6902) (K,K=1,11) 5594.
5741     DO 908 N=1,NLP 5595.
5742     L=NLP+1-N 5596.
5743     IF(L.GT.NL.AND.NW.GT.3) GO TO 908 5597.
5744     SUML=SUM1(L)+SUM2(L)+SUM3(L)+WFLB(L,1) 5598.
5745     WRITE(6,6903) L,SUML,SUM1(L),SUM2(L),SUM3(L),(WFLB(L,K),K=1,11) 5599.
5746     908 CONTINUE 5600.
5747     SUMA=ASUM1+ASUM2+ASUM3+ WFSL(1) 5601.
5748     SUMB=BSUM1+BSUM2+BSUM3+ BGFEMT(1) 5602.
5749     SUMC=CSUM1+CSUM2+CSUM3+BGFLUX(1) 5603.
5750     SUMD=DSUM1+DSUM2+DSUM3+BGFRAC(1) 5604.
5751     SUME=ESUM1+ESUM2+ESUM3+TRCALB(1) 5605.
5752     SUMF=FSUM1+FSUM2+FSUM3+TRGALB(1) 5606.
5753     WRITE(6,6904) SUMA,ASUM1,ASUM2,ASUM3,( WFSL(K),K=1,11) 5607.
5754     WRITE(6,6905) SUMB,BSUM1,BSUM2,BSUM3,( BGFEMT(K),K=1,11) 5608.
5755     WRITE(6,6906) SUMC,CSUM1,CSUM2,CSUM3,(BGFLUX(K),K=1,11) 5609.
5756     WRITE(6,6907) SUMD,DSUM1,DSUM2,DSUM3,(BGFRAC(K),K=1,11) 5610.
5757     WRITE(6,6908) SUME,ESUM1,ESUM2,ESUM3,(TRCALB(K),K=1,11) 5611.
5758     WRITE(6,6909) SUMF,FSUM1,FSUM2,FSUM3,(TRGALB(K),K=1,11) 5612.
5759     NPAGE=0 5613.
5760     IF(NL.GT.13) NPAGE=1 5614.
5761     WRITE(6,6910) NPAGE 5615.
5762     WRITE(6,6911) (K,K=12,25) 5616.
5763     DO 909 N=1,NLP 5617.
5764     L=NLP+1-N 5618.
5765     IF(L.GT.NL.AND.NW.GT.3) GO TO 909 5619.
5766     WRITE(6,6912) L,(WFLB(L,K),K=12,NKTR) 5620.
5767     909 CONTINUE 5621.
5768     WRITE(6,6913) ( WFSL(K),K=12,NKTR) 5622.
5769     WRITE(6,6914) ( BGFEMT(K),K=12,NKTR) 5623.
5770     WRITE(6,6915) (BGFLUX(K),K=12,NKTR) 5624.
5771     WRITE(6,6916) (BGFRAC(K),K=12,NKTR) 5625.
5772     WRITE(6,6917) (TRCALB(K),K=12,NKTR) 5626.
5773     WRITE(6,6918) ( TRGALB(K),K=12,NKTR) 5627.
5774     910 CONTINUE 5628.
5775     C 5629.
5776     6901 FORMAT(1I1,'(9.',I1,') THERMAL RADIATION: K-DISTRIBUTION' 5630.
5777     + ,' BREAKDOWN FOR ',1A8,' FLUX'/ 5631.
5778     + /T8,'SUM PRINCIPAL REGION SUM',4X 5632.
5779     + ,'WINDOW',T66,'WATER VAPOR: PRINCIPAL ABSORBER REGION' 5633.
5780     + ,/T7,'-----',2X,20('-'),4X,6('-'),3X,87('-')) 5634.
5781     6902 FORMAT(1X,'LN TOTAL H2O CO2 O3 K=' 5635.
5782     + ,I2,5X,'K=',I2,9I9) 5636.
5783     6903 FORMAT( 1X,I2,F8.2,1X,3F7.2,F10.3,10F9.3) 5637.
5784     6904 FORMAT(/' SL',F8.2,1X,3F7.2,F10.3,10F9.3) 5638.
5785     6905 FORMAT(/' BG',F8.2,1X,3F7.2,F10.3,10F9.3) 5639.
5786     6906 FORMAT( ' PF',F8.2,1X,3F7.2,F10.3,10F9.3) 5640.
5787     6907 FORMAT( ' FR',F8.4,1X,3F7.4,F10.5,10F9.5) 5641.
5788     6908 FORMAT(/' AC',F8.2,1X,3F7.2,F10.3,10F9.3) 5642.
5789     6909 FORMAT( ' AG',F8.2,1X,3F7.2,F10.3,10F9.3) 5643.
5790     6910 FORMAT(1I1/T26,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5644.
5791     + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5645.
5792     + /5X,89('-'),5X,34('-')) 5646.
5793     6911 FORMAT(1X,'LN K=',I4,9I9,7X,'K=',I3,3I9) 5647.
5794     6912 FORMAT( 1X,I2,1X,10F9.3,3X,4F9.3) 5648.
5795     6913 FORMAT(/' SL',1X,10F9.3,3X,4F9.3) 5649.
5796     6914 FORMAT(/' BG',1X,10F9.3,3X,4F9.3) 5650.
5797     6915 FORMAT( ' PF',1X,10F9.3,3X,4F9.3) 5651.
5798     6916 FORMAT( ' FR',1X,10F9.5,3X,4F9.5) 5652.
5799     6917 FORMAT(/' AC',1X,10F9.3,3X,4F9.3) 5653.
5800     6918 FORMAT( ' AG',1X,10F9.3,3X,4F9.3) 5654.
5801     RETURN 5655.
5802     C 5656.
5803     C------------- 5657.
5804     1000 CONTINUE 5658.
5805     C------------- 5659.
5806     C 5660.
5807     NPAGE=1 5661.
5808     IF(INDEX.LT.11) NPAGE=KPAGE 5662.
5809     WRITE(6,7001) NPAGE 5663.
5810     7001 FORMAT(1I1,'(10) BLOCK DATA AEROSOL PROPERTY SPECIFICATION:') 5664.
5811     9999 CONTINUE 5665.
5812     RETURN 5666.
5813     END 5667.
5814     SUBROUTINE SOLARZ(NG,KWRITE) 5668.
5815     #include "B83XX.COM" 5669.
5816     DIMENSION SRDATA(187),ZRDATA(187) 5730.
5817     EQUIVALENCE (SRDFLB(1),SRDATA(1)) 5731.
5818     c DOUBLE PRECISION XMU(50),WT(50) 5732.
5819     dimension XMU(50),WT(50)
5820     DATA NSRD/187/ 5733.
5821     DIMENSION NOFLUX(7) 5734.
5822     DATA NOFLUX/164,167,168,169,170,171,174/ 5735.
5823     C 5736.
5824     C------------------------------------- 5737.
5825     CALL GAUSST(NG,0.D0,1.D0,XMU,WT) 5738.
5826     C------------------------------------- 5739.
5827     DO 100 J=1,NG 5740.
5828     100 WT(J)=WT(J)*2.D0*XMU(J) 5741.
5829     C 5742.
5830     DO 110 I=1,NSRD 5743.
5831     110 ZRDATA(I)=0. 5744.
5832     C 5745.
5833     NORM=NORMS0 5746.
5834     ZCOS=COSZ 5747.
5835     C 5748.
5836     DO 130 J=1,NG 5749.
5837     COSZ=XMU(J) 5750.
5838     NORMS0=1 5751.
5839     C--------------- 5752.
5840     CALL SOLAR 5753.
5841     C--------------- 5754.
5842     DO 120 I=1,NSRD 5755.
5843     120 ZRDATA(I)=ZRDATA(I)+SRDATA(I)*WT(J) 5756.
5844     KPAGE=J-(J/2)*2 5757.
5845     IF(KWRITE.GT.1) CALL WRITER(3,KPAGE) 5758.
5846     130 CONTINUE 5759.
5847     C 5760.
5848     DO 150 I=1,NSRD 5761.
5849     FACTOR=0.25 5762.
5850     DO 140 K=1,7 5763.
5851     IF(I.EQ.NOFLUX(K)) FACTOR=1. 5764.
5852     140 CONTINUE 5765.
5853     IF(I.GT.176) FACTOR=1. 5766.
5854     150 SRDATA(I)=ZRDATA(I)*FACTOR 5767.
5855     COSZ=NG 5768.
5856     IF(NG.GT.9) COSZ=.1*NG 5769.
5857     COSZ=COSZ+NG/1000. 5770.
5858     KPAGE=1 5771.
5859     C 5772.
5860     NORMS0=100 5773.
5861     C 5774.
5862     IF(KWRITE.GT.0) CALL WRITER(13,KPAGE) 5775.
5863     C 5776.
5864     COSZ=ZCOS 5777.
5865     NORMS0=NORM 5778.
5866     C 5779.
5867     RETURN 5780.
5868     END 5781.
5869     SUBROUTINE GAUSST(NG,X1,X2,XP,WT) 5782.
5870     c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 5783.
5871     DIMENSION XP(1),WT(1) 5784.
5872     real*8 pi, ps, dxl
5873     DATA PI,PS,DXL/3.141592653589793D0,1.013211836423378D-01,1.D-16/ 5785.
5874     XMID=(X2+X1)/2.D0 5786.
5875     XDIF=X2-X1 5787.
5876     XHAF=XDIF/2.D0 5788.
5877     DNG=NG 5789.
5878     NN=NG/2 5790.
5879     N2=NN*2 5791.
5880     IF(N2.EQ.NG) GO TO 110 5792.
5881     XP(NN+1)=XMID 5793.
5882     WT(NN+1)=XDIF 5794.
5883     IF(NG.LT.2) RETURN 5795.
5884     PN=1.D0 5796.
5885     N=0 5797.
5886     100 N=N+2 5798.
5887     DN=N 5799.
5888     DM=DN-1.D0 5800.
5889     PN=PN*(DM/DN) 5801.
5890     IF(N.LT.N2) GO TO 100 5802.
5891     WT(NN+1)=XDIF/(DNG*PN)**2 5803.
5892     110 I=0 5804.
5893     C=PI/DSQRT(DNG*(DNG+1.D0)+0.5D0-PS)/105.D0 5805.
5894     120 I=I+1 5806.
5895     DI=I 5807.
5896     Z=PS/(4.D0*DI-1.D0)**2 5808.
5897     ZZ=(105.D0+Z*(210.D0-Z*(2170.D0-Z*(105812.D0-12554474.D0*Z)))) 5809.
5898     X=DCOS(ZZ*C*(DI-0.25D0)) 5810.
5899     130 N=1 5811.
5900     DM=1.D0 5812.
5901     PNI=1.D0 5813.
5902     PNJ=X 5814.
5903     140 N=N+1 5815.
5904     DN=N 5816.
5905     PNK=((DM+DN)*X*PNJ-DM*PNI)/DN 5817.
5906     PNI=PNJ 5818.
5907     PNJ=PNK 5819.
5908     DM=DN 5820.
5909     IF(N.LT.NG) GO TO 140 5821.
5910     DX=PNJ*(1.D0-X*X)/DNG/(PNI-X*PNJ) 5822.
5911     X=X-DX 5823.
5912     IF(DABS(DX).GT.DXL) GO TO 130 5824.
5913     J=NG+1-I 5825.
5914     XP(I)=XMID-XHAF*X 5826.
5915     XP(J)=XMID+XHAF*X 5827.
5916     WT(I)=XDIF*(1.D0-X*X)/(DNG*PNI)**2 5828.
5917     WT(J)=WT(I) 5829.
5918     IF(I.LT.NN) GO TO 120 5830.
5919     RETURN 5831.
5920     END 5832.
5921     SUBROUTINE SETATM 5833.
5922     #include "B83XX.COM" 5834.
5923     DIMENSION NL4(4),PLB4(40,4) 5877.
5924     DATA NL4/12,12,24,35/ 5878.
5925     DATA PLB4/ 5879.
5926     1 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 5880.
5927     1 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 5881.
5928     1 1.E-05, 27*0., 5882.
5929     C 5883.
5930     2 984.0000, 934.0000, 854.0000, 720.0000, 550.0000, 390.0000, 5884.
5931     2 255.0000, 150.0000, 70.0000, 10.0000, 5.0000, 2.0000, 5885.
5932     2 1.E-05, 27*0., 5886.
5933     C 5887.
5934     3 1013.2500, 988.8846, 956.9068, 910.2775, 820.4963, 683.6775, 5888.
5935     3 521.6665, 356.3138, 209.4467, 102.9552, 47.7944, 22.1797, 5889.
5936     3 10.29439, 4.77932, 2.21785, 1.01932, 0.46761, 0.21156, 5890.
5937     3 0.092671, 0.047500, 0.021885, 0.010000, 0.005000, 0.002000, 5891.
5938     3 1.00E-05, 15*0.0, 5892.
5939     C 5893.
5940     4 1013.2500,1000.0000, 950.0000, 900.0000, 850.0000, 800.0000, 5894.
5941     4 750.0000, 700.0000, 650.0000, 600.0000, 550.0000, 500.0000, 5895.
5942     4 450.0000, 400.0000, 350.0000, 300.0000, 250.0000, 200.0000, 5896.
5943     4 150.0000, 100.0000, 50.0000, 20.0000, 10.0000, 5.0000, 5897.
5944     4 2.0000, 1.0000, 0.5000, 0.2000, 0.1000, 0.0500, 5898.
5945     4 0.0200, 0.0100, 0.0050, 0.0020, 0.0010, 1.E-05, 5899.
5946     4 4*0./ 5900.
5947     C 5901.
5948     LAST=LASTVC 5902.
5949     LMAG=100000 5903.
5950     C ------------------------------------------ 5904.
5951     C NLAY: ATMOSPHERIC LAYERING SPECIFICATION 5905.
5952     C ------------------------------------------ 5906.
5953     NLAY=LAST/LMAG 5907.
5954     LAST=LAST-LMAG*NLAY 5908.
5955     LMAG=LMAG/10 5909.
5956     C 5910.
5957     KSCALE=0 5911.
5958     IF(NLAY.GT.9) KSCALE=1 5912.
5959     IF(NLAY.GT.9) NLAY=NLAY-10 5913.
5960     C 5914.
5961     IF(NLAY.LT.1.OR.NLAY.GT.8) GO TO 20 5915.
5962     GO TO (10,10,10,10,12,14,16,18),NLAY 5916.
5963     10 NL=NL4(NLAY) 5917.
5964     NLP=NL+1 5918.
5965     C (1-4)=(12,12,24,35 PRESSURE SPECIFICATIONS)5919.
5966     C -------------------------------------------5920.
5967     DO 11 N=1,NLP 5921.
5968     11 PLB(N)=PLB4(N,NLAY) 5922.
5969     GO TO 20 5923.
5970     C (5)=(1-D MODEL LAYER SPECIFICATION)5924.
5971     C -----------------------------------5925.
5972     12 NL=18 5926.
5973     DO 13 N=1,NL 5927.
5974     HLB(N)=N-1+2*(N/7) 5928.
5975     IF(N.GT. 8) HLB(N)=4*N-24-N/11-N/12 5929.
5976     13 IF(N.GT.13) HLB(N)=30+(N-14)*5 5930.
5977     HLB( 1)=1.0E-10 5931.
5978     HLB(19)=99.99 5932.
5979     GO TO 20 5933.
5980     C (6)=(LINE-BY-LINE LAYER SPECIFICATION)5934.
5981     C --------------------------------------5935.
5982     14 NL=30 5936.
5983     DO 15 N=1,NL 5937.
5984     HLB(N)=N-1+(N-17)*(N/17) 5938.
5985     15 IF(N.GT.20) HLB(N)=20+(N-20)*5 5939.
5986     HLB( 1)=1.0E-10 5940.
5987     HLB(31)=99.99 5941.
5988     GO TO 20 5942.
5989     C (7)=(MCCLATCHEY LAYER SPECIFICATION)5943.
5990     C ------------------------------------5944.
5991     16 NL=32 5945.
5992     DO 17 N=1,NL 5946.
5993     HLB(N)=N-1 5947.
5994     17 IF(N.GT.25) HLB(N)=25+5*(N-26) 5948.
5995     HLB( 1)=1.0E-10 5949.
5996     HLB(32)=70.00 5950.
5997     HLB(33)=99.99 5951.
5998     GO TO 20 5952.
5999     C (8)=(HI-RES LAYER SPECIFICATION)5953.
6000     C --------------------------------5954.
6001     18 NL=39 5955.
6002     DO 19 N=1,NL 5956.
6003     HLB(N)=N-1 5957.
6004     IF(N.GT.21) HLB(N)=20+(N-21)*2 5958.
6005     IF(N.GT.31) HLB(N)=40+(N-31)*5 5959.
6006     19 IF(N.GT.37) HLB(N)=70+(N-37)*10 5960.
6007     HLB( 1)=1.0E-10 5961.
6008     HLB(40)=99.99 5962.
6009     C 5963.
6010     C ------------------------------------------- 5964.
6011     C NATM: ATMOSPHERIC STRUCTURE SPECIFICATION 5965.
6012     C ------------------------------------------- 5966.
6013     20 NATM=LAST/LMAG 5967.
6014     LAST=LAST-LMAG*NATM 5968.
6015     LMAG=LMAG/10 5969.
6016     C 5970.
6017     IF(KSCALE.NE.1) GO TO 24 5971.
6018     C 5972.
6019     C SIGMA LEVEL RESCALING OF PRESSURES RELATIVE TO PSIG05973.
6020     C ----------------------------------------------------5974.
6021     C 5975.
6022     NLMOD=NL-LAYRAD 5976.
6023     IF(NLAY.GT.4) GO TO 22 5977.
6024     PTOP=PLB(NLMOD+1) 5978.
6025     PBOT=PLB(1) 5979.
6026     DO 21 L=1,NLMOD 5980.
6027     PSIG(L)=(PLB(L)-PTOP)/(PBOT-PTOP) 5981.
6028     21 PLB(L) =PSIG(L)*(PSIG0-PTOP)+PTOP 5982.
6029     PSIG(NLMOD+1)=0. 5983.
6030     GO TO 24 5984.
6031     C 5985.
6032     C SIGMA LEVEL RESCALING OF HEIGHTS RELATIVE TO PSIG05986.
6033     C --------------------------------------------------5987.
6034     22 HTOP=HLB(NLMOD+1) 5988.
6035     HBOT=HLB(1) 5989.
6036     DO 23 L=1,NLMOD 5990.
6037     PSIG(L)=(HLB(L)-HTOP)/(HBOT-HTOP) 5991.
6038     23 HLB(L) =PSIG(L)*(PSIG0-HTOP)+HTOP 5992.
6039     PSIG(NLMOD+1)=0. 5993.
6040     24 CONTINUE 5994.
6041     C 5995.
6042     NLP=NL+1 5996.
6043     NPHD=1+NLAY/5 5997.
6044     N=1 5998.
6045     IF(NPHD.EQ.1) P=PLB(N) 5999.
6046     IF(NPHD.EQ.2) H=HLB(N) 6000.
6047     CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6001.
6048     IF(NPHD.EQ.1) HLB(N)=H 6002.
6049     IF(NPHD.EQ.2) PLB(N)=P 6003.
6050     PB=P 6004.
6051     TB=T 6005.
6052     OB=OCM 6006.
6053     WB=WCM 6007.
6054     DO 25 N=1,NL 6008.
6055     IF(NPHD.EQ.1) P=PLB(N+1) 6009.
6056     IF(NPHD.EQ.2) H=HLB(N+1) 6010.
6057     CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6011.
6058     IF(NPHD.EQ.1) HLB(N+1)=H 6012.
6059     IF(NPHD.EQ.2) PLB(N+1)=P 6013.
6060     TLB(N)=TB 6014.
6061     TLT(N)=T 6015.
6062     TLM(N)=0.5*(T+TB) 6016.
6063     U0GAS(N,1)=WB-WCM 6017.
6064     U0GAS(N,3)=OB-OCM 6018.
6065     SHL(N)=U0GAS(N,1)/(U0GAS(N,1)+1268.75*(PB-P)) 6019.
6066     EQ=0.5*(PB+P)*SHL(N)/(0.662+0.338*SHL(N)) 6020.
6067     C$ EQ=0.5*(PB+P)*SHL(N)/(0.622+0.338*SHL(N)) 6021.
6068     ES=10.0**(9.4051-2353.0/TLM(N)) 6022.
6069     RHL(N)=EQ/ES 6023.
6070     PB=P 6024.
6071     TB=T 6025.
6072     OB=OCM 6026.
6073     25 WB=WCM 6027.
6074     TLB(NLP)=TLT(NL) 6028.
6075     TSL=TLB(1) 6029.
6076     TGO=TLB(1) 6030.
6077     TGE=TLB(1) 6031.
6078     TGOI=TGO-5. 6032.
6079     TGLI=TGE-5. 6033.
6080     C ---------------------------------- 6034.
6081     C NSUR: SURFACE TYPE SPECIFICATION 6035.
6082     C ---------------------------------- 6036.
6083     30 NSUR=LAST/LMAG 6037.
6084     LAST=LAST-LMAG*NSUR 6038.
6085     LMAG=LMAG/10 6039.
6086     C 6040.
6087     IF(NSUR.EQ.0) GO TO 40 6041.
6088     POCEAN=0. 6042.
6089     PEARTH=0. 6043.
6090     POICE =0. 6044.
6091     PLICE =0. 6045.
6092     AGESN =0. 6046.
6093     SNOWE =0. 6047.
6094     SNOWOI=0. 6048.
6095     SNOWLI=0. 6049.
6096     C 6050.
6097     IF(NSUR.EQ.1) POCEAN=1. 6051.
6098     IF(NSUR.EQ.2) PEARTH=1. 6052.
6099     IF(NSUR.EQ.3) POICE =1. 6053.
6100     IF(NSUR.EQ.4) PLICE =1. 6054.
6101     IF(NSUR.EQ.5) PEARTH=1. 6055.
6102     IF(NSUR.EQ.5) SNOWE =1. 6056.
6103     IF(NSUR.GT.5) PLICE =1. 6057.
6104     IF(NSUR.EQ.6) SNOWLI=1. 6058.
6105     IF(NSUR.LT.7) GO TO 40 6059.
6106     BXAVIS=0. 6060.
6107     BXANIR=0. 6061.
6108     IF(NSUR.EQ.7) BXAVIS=1. 6062.
6109     IF(NSUR.GT.7) BXANIR=1. 6063.
6110     IF(NSUR.EQ.9) BXAVIS=1. 6064.
6111     DO 31 I=1,5 6065.
6112     SRBXAL(I,1)=BXANIR 6066.
6113     31 SRBXAL(I,2)=BXANIR 6067.
6114     SRBXAL(6,1)=BXAVIS 6068.
6115     SRBXAL(6,2)=BXAVIS 6069.
6116     IF(KALVIS.GT.0) SRBXAL(4,1)=SRBXAL(6,1) 6070.
6117     IF(KALVIS.GT.0) SRBXAL(4,2)=SRBXAL(6,2) 6071.
6118     C 6072.
6119     C ---------------------------------------- 6073.
6120     C NTRA: TRACER COMPOSITION SPECIFICATION 6074.
6121     C ---------------------------------------- 6075.
6122     40 NTRA=LAST/LMAG 6076.
6123     LAST=LAST-LMAG*NTRA 6077.
6124     LMAG=LMAG/10 6078.
6125     C 6079.
6126     TAUT55=1.0 6080.
6127     NTRACE=1 6081.
6128     IF(NTRA.LT.1) TAUT55=0. 6082.
6129     IF(NTRA.LT.1) NTRACE=0 6083.
6130     ITR(1)=NTRA 6084.
6131     DO 41 L=1,NL 6085.
6132     41 TRACER(L,1)=TAUT55*(PLB(L)-PLB(L+1))/PLB(1) 6086.
6133     C 6087.
6134     C ------------------------------------- 6088.
6135     C NVEG: VEGETATION TYPE SPECIFICATION 6089.
6136     C ------------------------------------- 6090.
6137     50 NVEG=LAST/LMAG 6091.
6138     LAST=LAST-LMAG*NVEG 6092.
6139     LMAG=LMAG/10 6093.
6140     C 6094.
6141     DO 51 K=1,11 6095.
6142     51 PVT(K)=0. 6096.
6143     IF(NVEG.LT.1) GO TO 60 6097.
6144     PVT(NVEG)=1. 6098.
6145     C ------------------------------------- 6099.
6146     C NCLD: CLOUD LAYER,TAU SPECIFICATION 6100.
6147     C ------------------------------------- 6101.
6148     60 NCLD=LAST 6102.
6149     DO 61 L=1,NL 6103.
6150     61 CLDTAU(L)=0. 6104.
6151     IF(NCLD.GT.0) CLDTAU(NCLD)=64./2**NCLD 6105.
6152     RETURN 6106.
6153     END 6107.
6154     SUBROUTINE SETFOR(NFTFOR) 6108.
6155     #include "B83XX.COM" 6109.
6156     C COMMON/TMINOR/FCO2,FN2O,FCH4,FF11,FF12,FVOL,FSUN 6150.
6157     C 6151.
6158     C-----------------------------------------------------------------------6152.
6159     C EXTERNAL FORCING FOR CO2,N2O,CH4,F11,F12,VOLCANIC AER,SOLAR CONST6153.
6160     C STARTING FROM JAN 1,1880 PROJECTED THROUGH DEC 31,2100 6154.
6161     C INPUT FORCING DATA READ IN FROM DISK DATA DSN=CLIM.RUN.FORCING 6155.
6162     C 6156.
6163     C CALL SETFOR TO READ IN AND/OR INITIALIZE DATA AND/OR RESET PARAMS6157.
6164     C 6158.
6165     C IF(NFTFOR.GT.0) FORCING DATA WILL BE READ IN FROM DISKUNIT=NFTFOR6159.
6166     C IF(NFTFOR.EQ.0) NO DATA READ, SELECT CONSTITUENTS FOR EXT FORCING6160.
6167     C IF(NFTFOR.LT.0) NO DATA READ, RESET ONLY SOL CONST REFERENCE VALU6161.
6168     C-----------------------------------------------------------------------6162.
6169     C 6163.
6170     DIMENSION YEAR(221),SCO2(221),SCH4(221),SN2O(221) 6164.
6171     DIMENSION SF11(221),SF12(221),UPPM(221) 6165.
6172     DIMENSION TAUS(12,221),TAUM(2652) 6166.
6173     EQUIVALENCE (TAUS(1,1),TAUM(1)) 6167.
6174     C 6168.
6175     DIMENSION INDEX(9),INFOR(9) 6169.
6176     EQUIVALENCE (INFOR(1),KVOL),(INFOR(2),KCO2),(INFOR(3),KXXX) 6170.
6177     EQUIVALENCE (INFOR(4),KSUN),(INFOR(5),KYYY),(INFOR(6),KN2O) 6171.
6178     EQUIVALENCE (INFOR(7),KCH4),(INFOR(8),KF11),(INFOR(9),KF12) 6172.
6179     C 6173.
6180     DIMENSION DMO(12),JDY(12) 6174.
6181     DATA DMO/31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31./ 6175.
6182     DATA JDY/31,59,90,120,151,181,212,243,278,304,334,365/ 6176.
6183     C 6177.
6184     IF(NFTFOR.LT.0) GO TO 150 6178.
6185     IF(NFTFOR.LT.1) GO TO 110 6179.
6186     C 6180.
6187     REWIND NFTFOR 6181.
6188     READ (NFTFOR) NOUT,NEND,KFS,KCS,(YEAR(L),SCO2(L),SCH4(L),SN2O(L) 6182.
6189     + ,SF11(L),SF12(L),UPPM(L),(TAUS(K,L),K=1,12),L=1,221)6183.
6190     + ,IDATE 6184.
6191     REWIND NFTFOR 6184.5
6192     C 6185.
6193     ID5(5)=IDATE+10*KFS+KCS 6186.
6194     C 6187.
6195     C-----------------------------------------------------------------------6188.
6196     C REFERENCE YEAR IS (1958) WHERE FULGAS(K)=1 FOR CO2,N2O,CH4,F11,F126189.
6197     C MEAN 1958 BACKGROUND CO2=315 N2O=.295 CH4=1.4 F11=8.E-6 F12=25.E-66190.
6198     C GAS PPM IS LINEARLY INTERPOLATED (MEAN ANNUAL PPM OCCURS JDAY=183)6191.
6199     C 6192.
6200     C BACKGROUND TAU STRATAER=0.012 (VOLCANIC CONTRIBUTION IS ADDITIVE)6193.
6201     C 6194.
6202     C KFS=IDENTIFIER FOR F11,F12 ABUNDANCE SCENARIOS 6195.
6203     C KCS=IDENTIFIER FOR CO2 ABUNDANCE SCENARIOS 6196.
6204     C ID5(5)=IDATE+10*KFS+KCS IS THE FORCING DATA SET IDENTIFIER 6197.
6205     C-----------------------------------------------------------------------6198.
6206     C 6199.
6207     RRCO2=PPMV58(2) 6200.
6208     RCH4=PPMV58(7) 6201.
6209     RN2O=PPMV58(6) 6202.
6210     C (F11,F12 EXTERNAL FORCING DATA ARE IN PPM) 6203.
6211     RF11=PPMV58(8)*1000. 6204.
6212     RF12=PPMV58(9)*1000. 6205.
6213     C 6206.
6214     RVOL=AGOLDH(1,1) 6207.
6215     C-----------------------------------------------------------------------6208.
6216     C 6209.
6217     C SELECT CONSTITUENTS FOR WHICH EXTERNAL FORCING WILL BE IMPLEMENTED6210.
6218     C 6211.
6219     C KFORCE IS AN INTEGER UP TO NINE DIGITS LONG, SUCH THAT EACH DIGIT6212.
6220     C IS AN ON/OFF SWITCH FOR IMPLEMENTING EXTERNAL FORCING FOR:6213.
6221     C 6214.
6222     C (1) (2) (4) (6) (7) (8) (9) CODED DIGITS 6215.
6223     C VOL-AER, CO2, SOL-CON, N2O, CH4, F11, F12, RESPECTIVELY. 6216.
6224     C (THE DIGITS (3) & (5)...ARE NOT USED)6217.
6225     C 6218.
6226     C EXAMPLE: 1206789 SELECTS FORCING FOR ALL EXCEPT SOL CONST6219.
6227     C (ORDER OR REPETITION OF DIGITS IS NOT IMPORTANT)6220.
6228     C-----------------------------------------------------------------------6221.
6229     110 KFOR=KFORCE 6222.
6230     KMAG=100000000 6223.
6231     DO 120 K=1,9 6224.
6232     KF=KFOR/KMAG 6225.
6233     INDEX(K)=KF 6226.
6234     KFOR=KFOR-KF*KMAG 6227.
6235     120 KMAG=KMAG/10 6228.
6236     DO 130 K=1,9 6229.
6237     130 INFOR(K)=0 6230.
6238     DO 140 K=1,9 6231.
6239     IF(INDEX(K).EQ.0) GO TO 140 6232.
6240     INFOR(INDEX(K))=1 6233.
6241     140 CONTINUE 6234.
6242     C 6235.
6243     C-----------------------------------------------------------------------6236.
6244     C SELECT REFERENCE SOLAR CONSTANT (S0) AS PASSED IN COMMON/RADCOM/6237.
6245     C-----------------------------------------------------------------------6238.
6246     C 6239.
6247     150 S00=S0 6240.
6248     RETURN 6241.
6249     C 6242.
6250     C----------------- 6243.
6251     ENTRY GETFOR 6244.
6252     C----------------- 6245.
6253     C 6246.
6254     C-----------------------------------------------------------------------6247.
6255     C EXTERNAL FORCING RETURNED FOR CONSTITUENTS PRESELECTED IN SETFOR6248.
6256     C 6249.
6257     C RADCOM INPUT DATA: JYEAR, JDAY 6250.
6258     C 6251.
6259     C RADCOM OUTPUT DATA: FULGAS(K),K=2,6,7,8,9; FGOLDH(1), S06252.
6260     C 6253.
6261     C-----------------------------------------------------------------------6254.
6262     C 6255.
6263     JDM=JDAY 6256.
6264     DO 210 JMONTH=1,12 6257.
6265     IF(JDAY.GT.JDY(JMONTH)) GO TO 210 6258.
6266     GO TO 220 6259.
6267     210 JDM=JDAY-JDY(JMONTH) 6260.
6268     JMONTH=12 6261.
6269     220 MO=JMONTH+(JYEAR-1880)*12 6262.
6270     IF(MO.LT. 1) MO=1 6263.
6271     IF(MO.GT.2651) MO=2651 6264.
6272     C 6265.
6273     FRACYR=(JDAY-183)/365. 6266.
6274     FRACMO=JDM/DMO(JMONTH) 6267.
6275     C 6268.
6276     NY=JYEAR-1880+1 6269.
6277     IF(JDAY.LT.183) NY=NY-1 6270.
6278     IF(JDAY.LT.183) FRACYR=FRACYR+0.5 6271.
6279     IF(NY.LT. 1) NY=1 6272.
6280     IF(NY.GT.220) NY=220 6273.
6281     FCO2=SCO2(NY)+(SCO2(NY+1)-SCO2(NY))*FRACYR 6274.
6282     FCH4=SCH4(NY)+(SCH4(NY+1)-SCH4(NY))*FRACYR 6275.
6283     FN2O=SN2O(NY)+(SN2O(NY+1)-SN2O(NY))*FRACYR 6276.
6284     FF11=SF11(NY)+(SF11(NY+1)-SF11(NY))*FRACYR 6277.
6285     FF12=SF12(NY)+(SF12(NY+1)-SF12(NY))*FRACYR 6278.
6286     FSUN=UPPM(NY)+(UPPM(NY+1)-UPPM(NY))*FRACYR 6279.
6287     FVOL=TAUM(MO)+(TAUM(MO+1)-TAUM(MO))*FRACMO 6280.
6288     C 6281.
6289     C-----------------------------------------------------------------------6282.
6290     C OUTPUT FORCING DATA6283.
6291     C-----------------------------------------------------------------------6284.
6292     C 6285.
6293     IF(KCO2.GT.0) FULGAS(2)=FCO2/RRCO2 6286.
6294     IF(KN2O.GT.0) FULGAS(6)=FN2O/RN2O 6287.
6295     IF(KCH4.GT.0) FULGAS(7)=FCH4/RCH4 6288.
6296     IF(KF11.GT.0) FULGAS(8)=FF11/RF11 6289.
6297     IF(KF12.GT.0) FULGAS(9)=FF12/RF12 6290.
6298     IF(KVOL.GT.0) FGOLDH(1)=(RVOL+FVOL)/RVOL 6291.
6299     IF(KSUN.GT.0) S0=S00+S00*0.03*(FSUN-0.2) 6292.
6300     C 6293.
6301     RETURN 6294.
6302     END 6295.
6303     SUBROUTINE HGAER1(XMU,TAU,G,GG) 6301.
6304     C 6302.
6305     DIMENSION C05T00(51),C06T00(51),C07T00(51),C08T00(51),C09T00(51) 6303.
6306     DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6304.
6307     DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6305.
6308     DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6306.
6309     DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6307.
6310     DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6308.
6311     DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6309.
6312     DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6310.
6313     DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6311.
6314     DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6312.
6315     DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6313.
6316     C 6314.
6317     DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6315.
6318     DIMENSION C09TAU(51,11) 6316.
6319     C 6317.
6320     DIMENSION GTAU(51,11,5) 6318.
6321     C 6319.
6322     EQUIVALENCE (C05TAU(1, 1),C05T00(1)),(C05TAU(1, 2),C05T01(1)) 6320.
6323     EQUIVALENCE (C05TAU(1, 3),C05T02(1)),(C05TAU(1, 4),C05T03(1)) 6321.
6324     EQUIVALENCE (C05TAU(1, 5),C05T04(1)),(C05TAU(1, 6),C05T05(1)) 6322.
6325     EQUIVALENCE (C05TAU(1, 7),C05T06(1)),(C05TAU(1, 8),C05T07(1)) 6323.
6326     EQUIVALENCE (C05TAU(1, 9),C05T08(1)),(C05TAU(1,10),C05T09(1)) 6324.
6327     EQUIVALENCE (C05TAU(1,11),C05T10(1)) 6325.
6328     C 6326.
6329     EQUIVALENCE (C06TAU(1, 1),C06T00(1)),(C06TAU(1, 2),C06T01(1)) 6327.
6330     EQUIVALENCE (C06TAU(1, 3),C06T02(1)),(C06TAU(1, 4),C06T03(1)) 6328.
6331     EQUIVALENCE (C06TAU(1, 5),C06T04(1)),(C06TAU(1, 6),C06T05(1)) 6329.
6332     EQUIVALENCE (C06TAU(1, 7),C06T06(1)),(C06TAU(1, 8),C06T07(1)) 6330.
6333     EQUIVALENCE (C06TAU(1, 9),C06T08(1)),(C06TAU(1,10),C06T09(1)) 6331.
6334     EQUIVALENCE (C06TAU(1,11),C06T10(1)) 6332.
6335     C 6333.
6336     EQUIVALENCE (C07TAU(1, 1),C07T00(1)),(C07TAU(1, 2),C07T01(1)) 6334.
6337     EQUIVALENCE (C07TAU(1, 3),C07T02(1)),(C07TAU(1, 4),C07T03(1)) 6335.
6338     EQUIVALENCE (C07TAU(1, 5),C07T04(1)),(C07TAU(1, 6),C07T05(1)) 6336.
6339     EQUIVALENCE (C07TAU(1, 7),C07T06(1)),(C07TAU(1, 8),C07T07(1)) 6337.
6340     EQUIVALENCE (C07TAU(1, 9),C07T08(1)),(C07TAU(1,10),C07T09(1)) 6338.
6341     EQUIVALENCE (C07TAU(1,11),C07T10(1)) 6339.
6342     C 6340.
6343     EQUIVALENCE (C08TAU(1, 1),C08T00(1)),(C08TAU(1, 2),C08T01(1)) 6341.
6344     EQUIVALENCE (C08TAU(1, 3),C08T02(1)),(C08TAU(1, 4),C08T03(1)) 6342.
6345     EQUIVALENCE (C08TAU(1, 5),C08T04(1)),(C08TAU(1, 6),C08T05(1)) 6343.
6346     EQUIVALENCE (C08TAU(1, 7),C08T06(1)),(C08TAU(1, 8),C08T07(1)) 6344.
6347     EQUIVALENCE (C08TAU(1, 9),C08T08(1)),(C08TAU(1,10),C08T09(1)) 6345.
6348     EQUIVALENCE (C08TAU(1,11),C08T10(1)) 6346.
6349     C 6347.
6350     EQUIVALENCE (C09TAU(1, 1),C09T00(1)),(C09TAU(1, 2),C09T01(1)) 6348.
6351     EQUIVALENCE (C09TAU(1, 3),C09T02(1)),(C09TAU(1, 4),C09T03(1)) 6349.
6352     EQUIVALENCE (C09TAU(1, 5),C09T04(1)),(C09TAU(1, 6),C09T05(1)) 6350.
6353     EQUIVALENCE (C09TAU(1, 7),C09T06(1)),(C09TAU(1, 8),C09T07(1)) 6351.
6354     EQUIVALENCE (C09TAU(1, 9),C09T08(1)),(C09TAU(1,10),C09T09(1)) 6352.
6355     EQUIVALENCE (C09TAU(1,11),C09T10(1)) 6353.
6356     C 6354.
6357     EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6355.
6358     EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6356.
6359     EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6357.
6360     C 6358.
6361     C 6359.
6362     DATA C05T00/0.0, 6360.
6363     1 .0179,.0379,.0574,.0767,.0958,.1147,.1334,.1520,.1703,.1884, 6361.
6364     2 .2062,.2238,.2410,.2580,.2747,.2910,.3070,.3226,.3380,.3530, 6362.
6365     3 .3675,.3819,.3958,.4094,.4227,.4355,.4481,.4603,.4722,.4838, 6363.
6366     4 .4950,.5059,.5166,.5269,.5370,.5468,.5563,.5655,.5745,.5832, 6364.
6367     5 .5917,.5999,.6079,.6157,.6233,.6306,.6378,.6445,.6513,.6578/ 6365.
6368     C 6366.
6369     DATA C05T01/0.0, 6367.
6370     1 .0000,.0226,.0463,.0679,.0885,.1084,.1278,.1469,.1655,.1838, 6368.
6371     2 .2018,.2194,.2367,.2537,.2704,.2866,.3026,.3182,.3335,.3484, 6369.
6372     3 .3630,.3773,.3911,.4047,.4180,.4308,.4433,.4556,.4675,.4791, 6370.
6373     4 .4904,.5014,.5121,.5224,.5326,.5424,.5520,.5613,.5703,.5792, 6371.
6374     5 .5877,.5961,.6041,.6120,.6197,.6271,.6344,.6414,.6483,.6550/ 6372.
6375     C 6373.
6376     DATA C05T02/0.0, 6374.
6377     1 .0000,.0207,.0434,.0649,.0856,.1057,.1252,.1444,.1632,.1816, 6375.
6378     2 .1996,.2173,.2346,.2516,.2683,.2845,.3005,.3161,.3313,.3463, 6376.
6379     3 .3608,.3750,.3889,.4024,.4156,.4284,.4410,.4532,.4651,.4767, 6377.
6380     4 .4880,.4990,.5097,.5201,.5303,.5401,.5497,.5591,.5682,.5771, 6378.
6381     5 .5857,.5941,.6022,.6102,.6179,.6254,.6327,.6398,.6467,.6535/ 6379.
6382     C 6380.
6383     DATA C05T03/0.0, 6381.
6384     1 .0095,.0317,.0517,.0712,.0904,.1095,.1283,.1469,.1651,.1832, 6382.
6385     2 .2009,.2184,.2355,.2523,.2688,.2849,.3008,.3162,.3313,.3461, 6383.
6386     3 .3605,.3747,.3885,.4019,.4151,.4278,.4403,.4525,.4643,.4759, 6384.
6387     4 .4872,.4981,.5089,.5192,.5294,.5392,.5488,.5582,.5673,.5762, 6385.
6388     5 .5848,.5932,.6013,.6093,.6170,.6246,.6319,.6391,.6460,.6528/ 6386.
6389     C 6387.
6390     DATA C05T04/0.0, 6388.
6391     1 .0260,.0472,.0656,.0833,.1008,.1183,.1359,.1534,.1709,.1882, 6389.
6392     2 .2053,.2223,.2389,.2554,.2715,.2873,.3029,.3181,.3330,.3476, 6390.
6393     3 .3619,.3759,.3895,.4028,.4158,.4284,.4408,.4529,.4647,.4762, 6391.
6394     4 .4873,.4982,.5089,.5192,.5293,.5391,.5487,.5580,.5671,.5759, 6392.
6395     5 .5845,.5929,.6010,.6090,.6167,.6243,.6316,.6388,.6457,.6525/ 6393.
6396     C 6394.
6397     DATA C05T05/0.0, 6395.
6398     1 .0428,.0635,.0812,.0978,.1140,.1302,.1465,.1629,.1793,.1958, 6396.
6399     2 .2121,.2284,.2444,.2603,.2760,.2914,.3066,.3214,.3360,.3504, 6397.
6400     3 .3643,.3781,.3915,.4046,.4175,.4299,.4422,.4541,.4657,.4771, 6398.
6401     4 .4882,.4990,.5095,.5197,.5298,.5395,.5490,.5583,.5673,.5761, 6399.
6402     5 .5846,.5930,.6011,.6090,.6167,.6243,.6316,.6387,.6457,.6524/ 6400.
6403     C 6401.
6404     DATA C05T06/0.0, 6402.
6405     1 .0590,.0796,.0969,.1129,.1283,.1435,.1588,.1741,.1896,.2051, 6403.
6406     2 .2206,.2360,.2514,.2667,.2818,.2967,.3114,.3258,.3401,.3541, 6404.
6407     3 .3677,.3812,.3943,.4072,.4198,.4321,.4441,.4559,.4673,.4786, 6405.
6408     4 .4895,.5002,.5106,.5207,.5306,.5403,.5497,.5589,.5678,.5766, 6406.
6409     5 .5850,.5934,.6014,.6093,.6170,.6244,.6317,.6388,.6458,.6525/ 6407.
6410     C 6408.
6411     DATA C05T07/0.0, 6409.
6412     1 .0742,.0948,.1120,.1277,.1427,.1572,.1716,.1861,.2007,.2153, 6410.
6413     2 .2300,.2447,.2594,.2740,.2885,.3028,.3171,.3310,.3448,.3584, 6411.
6414     3 .3717,.3849,.3977,.4103,.4227,.4347,.4465,.4581,.4693,.4804, 6412.
6415     4 .4912,.5017,.5120,.5220,.5318,.5413,.5506,.5597,.5686,.5772, 6413.
6416     5 .5856,.5939,.6019,.6097,.6173,.6247,.6320,.6390,.6459,.6526/ 6414.
6417     C 6415.
6418     DATA C05T08/0.0, 6416.
6419     1 .0885,.1090,.1263,.1418,.1565,.1705,.1844,.1982,.2121,.2260, 6417.
6420     2 .2400,.2540,.2680,.2819,.2958,.3096,.3233,.3368,.3502,.3633, 6418.
6421     3 .3763,.3890,.4015,.4138,.4259,.4377,.4493,.4606,.4717,.4825, 6419.
6422     4 .4931,.5035,.5136,.5235,.5331,.5425,.5517,.5607,.5695,.5780, 6420.
6423     5 .5864,.5945,.6024,.6102,.6177,.6251,.6323,.6393,.6461,.6528/ 6421.
6424     C 6422.
6425     DATA C05T09/0.0, 6423.
6426     1 .1017,.1223,.1395,.1550,.1695,.1833,.1968,.2101,.2234,.2367, 6424.
6427     2 .2501,.2634,.2768,.2902,.3035,.3167,.3299,.3429,.3558,.3686, 6425.
6428     3 .3811,.3935,.4057,.4176,.4295,.4409,.4523,.4634,.4742,.4849, 6426.
6429     4 .4952,.5054,.5154,.5251,.5346,.5439,.5530,.5618,.5705,.5789, 6427.
6430     5 .5871,.5952,.6031,.6107,.6182,.6255,.6326,.6396,.6464,.6530/ 6428.
6431     C 6429.
6432     DATA C05T10/0.0, 6430.
6433     1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6431.
6434     2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6432.
6435     3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6433.
6436     4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6434.
6437     5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6435.
6438     C 6436.
6439     DATA C06T00/0.0, 6437.
6440     1 .0250,.0525,.0792,.1056,.1316,.1572,.1823,.2070,.2311,.2547, 6438.
6441     2 .2776,.3000,.3217,.3427,.3631,.3827,.4019,.4201,.4378,.4550, 6439.
6442     3 .4713,.4872,.5024,.5170,.5312,.5446,.5576,.5701,.5820,.5936, 6440.
6443     4 .6047,.6153,.6257,.6354,.6450,.6541,.6628,.6713,.6794,.6873, 6441.
6444     5 .6948,.7021,.7091,.7159,.7224,.7287,.7348,.7407,.7462,.7516/ 6442.
6445     C 6443.
6446     DATA C06T01/0.0, 6444.
6447     1 .0000,.0339,.0652,.0941,.1216,.1480,.1737,.1987,.2229,.2466, 6445.
6448     2 .2694,.2918,.3134,.3344,.3548,.3744,.3935,.4118,.4295,.4467, 6446.
6449     3 .4632,.4792,.4945,.5092,.5236,.5372,.5504,.5631,.5753,.5871, 6447.
6450     4 .5984,.6093,.6198,.6299,.6396,.6490,.6580,.6667,.6751,.6832, 6448.
6451     5 .6909,.6984,.7056,.7126,.7194,.7259,.7322,.7382,.7441,.7498/ 6449.
6452     C 6450.
6453     DATA C06T02/0.0, 6451.
6454     1 .0000,.0307,.0608,.0893,.1168,.1433,.1690,.1941,.2183,.2420, 6452.
6455     2 .2648,.2871,.3087,.3296,.3500,.3696,.3887,.4070,.4247,.4420, 6453.
6456     3 .4584,.4745,.4898,.5047,.5191,.5328,.5461,.5590,.5713,.5832, 6454.
6457     4 .5947,.6057,.6164,.6266,.6365,.6460,.6552,.6641,.6726,.6808, 6455.
6458     5 .6887,.6964,.7038,.7110,.7178,.7245,.7309,.7371,.7431,.7489/ 6456.
6459     C 6457.
6460     DATA C06T03/0.0, 6458.
6461     1 .0130,.0424,.0692,.0953,.1210,.1462,.1709,.1952,.2188,.2420, 6459.
6462     2 .2645,.2865,.3078,.3285,.3486,.3680,.3870,.4051,.4228,.4399, 6460.
6463     3 .4563,.4723,.4877,.5025,.5169,.5306,.5440,.5569,.5692,.5812, 6461.
6464     4 .5927,.6038,.6146,.6248,.6348,.6444,.6537,.6626,.6712,.6796, 6462.
6465     5 .6876,.6954,.7028,.7101,.7170,.7238,.7303,.7366,.7427,.7486/ 6463.
6466     C 6464.
6467     DATA C06T04/0.0, 6465.
6468     1 .0314,.0594,.0842,.1080,.1315,.1549,.1781,.2012,.2238,.2461, 6466.
6469     2 .2678,.2892,.3099,.3302,.3499,.3690,.3876,.4055,.4230,.4399, 6467.
6470     3 .4561,.4720,.4872,.5019,.5163,.5299,.5432,.5561,.5684,.5804, 6468.
6471     4 .5918,.6029,.6137,.6240,.6340,.6436,.6529,.6619,.6705,.6790, 6469.
6472     5 .6870,.6948,.7023,.7096,.7167,.7235,.7300,.7364,.7425,.7485/ 6470.
6473     C 6471.
6474     DATA C06T05/0.0, 6472.
6475     1 .0503,.0777,.1014,.1237,.1456,.1673,.1889,.2105,.2319,.2531, 6473.
6476     2 .2739,.2944,.3145,.3341,.3533,.3718,.3901,.4076,.4247,.4413, 6474.
6477     3 .4573,.4730,.4880,.5025,.5167,.5302,.5434,.5562,.5684,.5803, 6475.
6478     4 .5917,.6028,.6135,.6238,.6338,.6434,.6527,.6617,.6703,.6787, 6476.
6479     5 .6868,.6946,.7021,.7095,.7165,.7233,.7299,.7363,.7425,.7485/ 6477.
6480     C 6478.
6481     DATA C06T06/0.0, 6479.
6482     1 .0686,.0956,.1188,.1403,.1611,.1814,.2017,.2220,.2421,.2622, 6480.
6483     2 .2820,.3016,.3208,.3397,.3582,.3762,.3939,.4110,.4276,.4439, 6481.
6484     3 .4596,.4749,.4897,.5040,.5180,.5313,.5443,.5569,.5690,.5808, 6482.
6485     4 .5921,.6031,.6138,.6240,.6339,.6435,.6527,.6617,.6703,.6787, 6483.
6486     5 .6868,.6946,.7021,.7094,.7165,.7233,.7300,.7364,.7425,.7485/ 6484.
6487     C 6485.
6488     DATA C06T07/0.0, 6486.
6489     1 .0859,.1128,.1357,.1567,.1767,.1961,.2154,.2345,.2535,.2725, 6487.
6490     2 .2913,.3099,.3283,.3464,.3642,.3816,.3987,.4153,.4315,.4473, 6488.
6491     3 .4626,.4776,.4920,.5061,.5198,.5329,.5457,.5582,.5701,.5818, 6489.
6492     4 .5930,.6038,.6144,.6245,.6344,.6439,.6530,.6620,.6705,.6789, 6490.
6493     5 .6869,.6947,.7022,.7095,.7166,.7234,.7300,.7364,.7426,.7486/ 6491.
6494     C 6492.
6495     DATA C06T08/0.0, 6493.
6496     1 .1022,.1290,.1517,.1723,.1919,.2107,.2291,.2473,.2654,.2834, 6494.
6497     2 .3013,.3191,.3366,.3539,.3710,.3877,.4042,.4202,.4360,.4513, 6495.
6498     3 .4662,.4808,.4950,.5087,.5221,.5350,.5476,.5598,.5715,.5830, 6496.
6499     4 .5941,.6048,.6152,.6252,.6350,.6444,.6535,.6624,.6709,.6792, 6497.
6500     5 .6872,.6949,.7024,.7097,.7167,.7235,.7301,.7365,.7427,.7486/ 6498.
6501     C 6499.
6502     DATA C06T09/0.0, 6500.
6503     1 .1173,.1440,.1666,.1871,.2063,.2246,.2425,.2600,.2773,.2945, 6501.
6504     2 .3116,.3285,.3453,.3619,.3783,.3943,.4102,.4257,.4409,.4558, 6502.
6505     3 .4703,.4845,.4982,.5116,.5248,.5374,.5497,.5617,.5732,.5845, 6503.
6506     4 .5954,.6060,.6163,.6262,.6358,.6451,.6541,.6629,.6713,.6796, 6504.
6507     5 .6875,.6952,.7026,.7099,.7168,.7236,.7302,.7365,.7427,.7487/ 6505.
6508     C 6506.
6509     DATA C06T10/0.0, 6507.
6510     1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6508.
6511     2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6509.
6512     3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6510.
6513     4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6511.
6514     5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6512.
6515     C 6513.
6516     DATA C07T00/0.0, 6514.
6517     1 .0360,.0751,.1129,.1498,.1858,.2209,.2546,.2873,.3183,.3484, 6515.
6518     2 .3767,.4040,.4296,.4540,.4773,.4990,.5199,.5392,.5577,.5753, 6516.
6519     3 .5916,.6073,.6220,.6358,.6492,.6615,.6733,.6845,.6950,.7051, 6517.
6520     4 .7147,.7237,.7324,.7406,.7484,.7559,.7630,.7698,.7762,.7824, 6518.
6521     5 .7883,.7940,.7994,.8046,.8096,.8144,.8190,.8234,.8276,.8317/ 6519.
6522     C 6520.
6523     DATA C07T01/0.0, 6521.
6524     1 .0000,.0500,.0929,.1323,.1696,.2052,.2391,.2719,.3029,.3329, 6522.
6525     2 .3612,.3886,.4144,.4390,.4625,.4845,.5058,.5256,.5445,.5626, 6523.
6526     3 .5795,.5957,.6109,.6253,.6392,.6521,.6644,.6762,.6872,.6979, 6524.
6527     4 .7079,.7174,.7266,.7351,.7434,.7513,.7587,.7659,.7727,.7793, 6525.
6528     5 .7855,.7915,.7971,.8026,.8079,.8129,.8177,.8223,.8268,.8310/ 6526.
6529     C 6527.
6530     DATA C07T02/0.0, 6528.
6531     1 .0000,.0433,.0845,.1233,.1604,.1958,.2296,.2623,.2932,.3232, 6529.
6532     2 .3515,.3788,.4047,.4294,.4530,.4753,.4967,.5168,.5360,.5544, 6530.
6533     3 .5715,.5881,.6037,.6184,.6327,.6459,.6586,.6707,.6821,.6931, 6531.
6534     4 .7034,.7133,.7228,.7316,.7402,.7484,.7561,.7636,.7706,.7774, 6532.
6535     5 .7839,.7901,.7960,.8017,.8071,.8123,.8173,.8221,.8267,.8311/ 6533.
6536     C 6534.
6537     DATA C07T03/0.0, 6535.
6538     1 .0139,.0544,.0915,.1272,.1620,.1958,.2284,.2601,.2903,.3197, 6536.
6539     2 .3475,.3745,.4001,.4246,.4481,.4703,.4918,.5119,.5311,.5496, 6537.
6540     3 .5669,.5836,.5993,.6142,.6287,.6420,.6550,.6673,.6789,.6901, 6538.
6541     4 .7006,.7107,.7204,.7294,.7382,.7465,.7545,.7621,.7693,.7763, 6539.
6542     5 .7829,.7893,.7953,.8012,.8067,.8121,.8172,.8221,.8269,.8314/ 6540.
6543     C 6541.
6544     DATA C07T04/0.0, 6542.
6545     1 .0339,.0723,.1065,.1393,.1714,.2028,.2336,.2637,.2927,.3210, 6543.
6546     2 .3480,.3743,.3993,.4234,.4465,.4684,.4897,.5096,.5288,.5471, 6544.
6547     3 .5644,.5811,.5968,.6118,.6263,.6398,.6528,.6652,.6769,.6882, 6545.
6548     4 .6988,.7090,.7188,.7280,.7369,.7454,.7534,.7612,.7685,.7756, 6546.
6549     5 .7823,.7888,.7950,.8009,.8066,.8120,.8173,.8223,.8271,.8317/ 6547.
6550     C 6548.
6551     DATA C07T05/0.0, 6549.
6552     1 .0546,.0920,.1246,.1553,.1852,.2144,.2432,.2715,.2990,.3260, 6550.
6553     2 .3519,.3772,.4015,.4249,.4474,.4689,.4897,.5093,.5283,.5464, 6551.
6554     3 .5635,.5801,.5957,.6106,.6251,.6386,.6516,.6640,.6757,.6871, 6552.
6555     4 .6978,.7080,.7179,.7272,.7361,.7447,.7528,.7606,.7680,.7752, 6553.
6556     5 .7820,.7886,.7948,.8008,.8065,.8121,.8174,.8224,.8273,.8320/ 6554.
6557     C 6555.
6558     DATA C07T06/0.0, 6556.
6559     1 .0749,.1117,.1434,.1728,.2010,.2284,.2554,.2820,.3079,.3335, 6557.
6560     2 .3582,.3825,.4058,.4284,.4502,.4711,.4914,.5106,.5292,.5470, 6558.
6561     3 .5639,.5802,.5957,.6105,.6248,.6382,.6511,.6635,.6752,.6865, 6559.
6562     4 .6972,.7075,.7174,.7267,.7357,.7442,.7524,.7603,.7677,.7750, 6560.
6563     5 .7818,.7884,.7947,.8008,.8065,.8121,.8174,.8226,.8275,.8322/ 6561.
6564     C 6562.
6565     DATA C07T07/0.0, 6563.
6566     1 .0943,.1306,.1617,.1902,.2173,.2434,.2689,.2940,.3185,.3427, 6564.
6567     2 .3662,.3893,.4117,.4334,.4545,.4747,.4944,.5131,.5312,.5486, 6565.
6568     3 .5651,.5812,.5964,.6110,.6252,.6384,.6512,.6635,.6752,.6864, 6566.
6569     4 .6971,.7073,.7172,.7265,.7355,.7440,.7522,.7601,.7676,.7748, 6567.
6570     5 .7817,.7883,.7946,.8007,.8065,.8121,.8175,.8227,.8276,.8324/ 6568.
6571     C 6569.
6572     DATA C07T08/0.0, 6570.
6573     1 .1125,.1486,.1793,.2071,.2334,.2585,.2828,.3066,.3299,.3529, 6571.
6574     2 .3753,.3973,.4186,.4395,.4597,.4792,.4982,.5164,.5340,.5510, 6572.
6575     3 .5672,.5829,.5978,.6122,.6261,.6392,.6518,.6640,.6755,.6867, 6573.
6576     4 .6973,.7074,.7172,.7265,.7354,.7440,.7522,.7600,.7675,.7748, 6574.
6577     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8277,.8325/ 6575.
6578     C 6576.
6579     DATA C07T09/0.0, 6577.
6580     1 .1296,.1655,.1958,.2232,.2489,.2732,.2966,.3194,.3416,.3635, 6578.
6581     2 .3848,.4058,.4262,.4462,.4656,.4844,.5028,.5203,.5374,.5539, 6579.
6582     3 .5697,.5850,.5997,.6137,.6274,.6403,.6527,.6647,.6761,.6872, 6580.
6583     4 .6977,.7077,.7175,.7267,.7356,.7441,.7522,.7601,.7675,.7748, 6581.
6584     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6582.
6585     C 6583.
6586     DATA C07T10/0.0, 6584.
6587     1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 6585.
6588     2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 6586.
6589     3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 6587.
6590     4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 6588.
6591     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6589.
6592     C 6590.
6593     DATA C08T00/0.0, 6591.
6594     1 .0568,.1172,.1747,.2295,.2813,.3300,.3748,.4169,.4547,.4903, 6592.
6595     2 .5220,.5517,.5784,.6030,.6257,.6460,.6652,.6825,.6985,.7134, 6593.
6596     3 .7269,.7396,.7513,.7621,.7723,.7816,.7904,.7987,.8064,.8137, 6594.
6597     4 .8204,.8268,.8329,.8385,.8439,.8490,.8538,.8584,.8627,.8668, 6595.
6598     5 .8707,.8744,.8780,.8814,.8846,.8877,.8906,.8934,.8961,.8987/ 6596.
6599     C 6597.
6600     DATA C08T01/0.0, 6598.
6601     1 .0045,.0786,.1413,.1980,.2505,.2994,.3445,.3870,.4255,.4620, 6599.
6602     2 .4948,.5257,.5538,.5798,.6039,.6258,.6464,.6650,.6823,.6985, 6600.
6603     3 .7132,.7270,.7398,.7516,.7629,.7730,.7826,.7917,.8000,.8080, 6601.
6604     4 .8153,.8223,.8289,.8350,.8408,.8463,.8514,.8564,.8610,.8654, 6602.
6605     5 .8696,.8736,.8773,.8809,.8843,.8876,.8907,.8937,.8965,.8992/ 6603.
6606     C 6604.
6607     DATA C08T02/0.0, 6605.
6608     1 .0000,.0639,.1239,.1794,.2314,.2799,.3249,.3675,.4063,.4431, 6606.
6609     2 .4766,.5081,.5370,.5637,.5888,.6115,.6330,.6525,.6707,.6878, 6607.
6610     3 .7032,.7179,.7314,.7440,.7559,.7667,.7769,.7865,.7954,.8038, 6608.
6611     4 .8117,.8190,.8260,.8325,.8387,.8445,.8499,.8551,.8600,.8647, 6609.
6612     5 .8690,.8733,.8772,.8810,.8845,.8880,.8912,.8943,.8973,.9001/ 6610.
6613     C 6611.
6614     DATA C08T03/0.0, 6612.
6615     1 .0129,.0725,.1266,.1778,.2266,.2730,.3165,.3580,.3962,.4326, 6613.
6616     2 .4659,.4975,.5265,.5536,.5790,.6021,.6241,.6441,.6628,.6804, 6614.
6617     3 .6964,.7116,.7256,.7386,.7510,.7622,.7728,.7828,.7921,.8009, 6615.
6618     4 .8090,.8167,.8240,.8307,.8372,.8432,.8489,.8543,.8594,.8642, 6616.
6619     5 .8688,.8731,.8772,.8811,.8848,.8884,.8917,.8949,.8980,.9009/ 6617.
6620     C 6618.
6621     DATA C08T04/0.0, 6619.
6622     1 .0338,.0901,.1399,.1870,.2320,.2754,.3165,.3561,.3930,.4283, 6620.
6623     2 .4609,.4920,.5207,.5477,.5730,.5962,.6184,.6385,.6575,.6753, 6621.
6624     3 .6916,.7071,.7214,.7347,.7474,.7589,.7698,.7801,.7896,.7987, 6622.
6625     4 .8071,.8150,.8225,.8294,.8361,.8423,.8481,.8537,.8589,.8639, 6623.
6626     5 .8686,.8731,.8773,.8813,.8851,.8887,.8922,.8955,.8986,.9016/ 6624.
6627     C 6625.
6628     DATA C08T05/0.0, 6626.
6629     1 .0561,.1105,.1578,.2017,.2435,.2838,.3224,.3597,.3948,.4287, 6627.
6630     2 .4602,.4904,.5185,.5450,.5699,.5930,.6150,.6351,.6541,.6720, 6628.
6631     3 .6884,.7040,.7185,.7319,.7448,.7565,.7676,.7781,.7877,.7970, 6629.
6632     4 .8056,.8136,.8213,.8284,.8352,.8416,.8476,.8533,.8586,.8637, 6630.
6633     5 .8685,.8731,.8774,.8815,.8854,.8891,.8926,.8960,.8991,.9022/ 6631.
6634     C 6632.
6635     DATA C08T06/0.0, 6633.
6636     1 .0782,.1314,.1770,.2187,.2581,.2958,.3319,.3670,.4002,.4324, 6634.
6637     2 .4626,.4917,.5189,.5447,.5691,.5918,.6134,.6334,.6522,.6700, 6635.
6638     3 .6864,.7020,.7165,.7300,.7430,.7548,.7660,.7766,.7864,.7957, 6636.
6639     4 .8044,.8126,.8204,.8276,.8345,.8410,.8471,.8529,.8583,.8635, 6637.
6640     5 .8684,.8731,.8774,.8816,.8856,.8893,.8929,.8963,.8996,.9027/ 6638.
6641     C 6639.
6642     DATA C08T07/0.0, 6640.
6643     1 .0994,.1518,.1962,.2363,.2739,.3095,.3436,.3765,.4080,.4385, 6641.
6644     2 .4673,.4951,.5213,.5463,.5700,.5921,.6134,.6329,.6515,.6691, 6642.
6645     3 .6854,.7009,.7154,.7289,.7418,.7536,.7649,.7755,.7854,.7948, 6643.
6646     4 .8036,.8118,.8197,.8270,.8340,.8405,.8467,.8526,.8581,.8634, 6644.
6647     5 .8683,.8731,.8775,.8817,.8857,.8896,.8932,.8967,.8999,.9031/ 6645.
6648     C 6646.
6649     DATA C08T08/0.0, 6647.
6650     1 .1197,.1714,.2148,.2538,.2899,.3238,.3562,.3874,.4172,.4461, 6648.
6651     2 .4735,.5001,.5253,.5493,.5722,.5937,.6144,.6335,.6518,.6691, 6649.
6652     3 .6852,.7005,.7148,.7283,.7412,.7529,.7642,.7748,.7847,.7942, 6650.
6653     4 .8030,.8113,.8192,.8265,.8336,.8402,.8464,.8524,.8579,.8632, 6651.
6654     5 .8682,.8730,.8775,.8818,.8858,.8897,.8934,.8969,.9002,.9034/ 6652.
6655     C 6653.
6656     DATA C08T09/0.0, 6654.
6657     1 .1387,.1899,.2326,.2705,.3055,.3382,.3691,.3988,.4271,.4546, 6655.
6658     2 .4808,.5061,.5302,.5533,.5754,.5962,.6163,.6350,.6528,.6698, 6656.
6659     3 .6855,.7007,.7148,.7281,.7409,.7526,.7638,.7744,.7843,.7937, 6657.
6660     4 .8025,.8109,.8188,.8262,.8333,.8399,.8462,.8521,.8577,.8631, 6658.
6661     5 .8681,.8730,.8775,.8818,.8859,.8898,.8935,.8971,.9004,.9036/ 6659.
6662     C 6660.
6663     DATA C08T10/0.0, 6661.
6664     1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 6662.
6665     2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 6663.
6666     3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 6664.
6667     4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 6665.
6668     5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 6666.
6669     C 6667.
6670     DATA C09T00/0.0, 6668.
6671     1 .1151,.2302,.3312,.4172,.4903,.5514,.6016,.6447,.6796,.7102, 6669.
6672     2 .7355,.7578,.7769,.7935,.8085,.8212,.8330,.8432,.8524,.8609, 6670.
6673     3 .8683,.8752,.8815,.8872,.8926,.8974,.9019,.9061,.9100,.9136, 6671.
6674     4 .9170,.9201,.9231,.9258,.9284,.9309,.9332,.9354,.9374,.9394, 6672.
6675     5 .9412,.9430,.9446,.9462,.9477,.9492,.9506,.9519,.9531,.9543/ 6673.
6676     C 6674.
6677     DATA C09T01/0.0, 6675.
6678     1 .0245,.1526,.2576,.3468,.4239,.4902,.5461,.5952,.6357,.6717, 6676.
6679     2 .7017,.7283,.7513,.7712,.7891,.8043,.8183,.8304,.8413,.8512, 6677.
6680     3 .8599,.8680,.8753,.8818,.8880,.8934,.8985,.9032,.9075,.9116, 6678.
6681     4 .9153,.9187,.9220,.9250,.9278,.9305,.9329,.9353,.9375,.9396, 6679.
6682     5 .9415,.9434,.9451,.9468,.9484,.9499,.9513,.9527,.9540,.9552/ 6680.
6683     C 6681.
6684     DATA C09T02/0.0, 6682.
6685     1 .0057,.1184,.2173,.3044,.3816,.4494,.5078,.5598,.6035,.6428, 6683.
6686     2 .6758,.7053,.7309,.7532,.7733,.7904,.8062,.8197,.8320,.8432, 6684.
6687     3 .8529,.8619,.8700,.8772,.8841,.8901,.8956,.9008,.9055,.9099, 6685.
6688     4 .9139,.9177,.9212,.9244,.9274,.9302,.9329,.9354,.9377,.9399, 6686.
6689     5 .9419,.9439,.9457,.9475,.9491,.9507,.9521,.9535,.9549,.9561/ 6687.
6690     C 6688.
6691     DATA C09T03/0.0, 6689.
6692     1 .0177,.1190,.2077,.2880,.3610,.4269,.4847,.5372,.5820,.6227, 6690.
6693     2 .6574,.6886,.7157,.7396,.7612,.7796,.7967,.8113,.8246,.8367, 6691.
6694     3 .8472,.8570,.8657,.8735,.8809,.8873,.8933,.8989,.9039,.9086, 6692.
6695     4 .9129,.9168,.9205,.9239,.9271,.9301,.9329,.9355,.9379,.9402, 6693.
6696     5 .9423,.9444,.9462,.9481,.9497,.9514,.9529,.9543,.9557,.9570/ 6694.
6697     C 6695.
6698     DATA C09T04/0.0, 6696.
6699     1 .0383,.1335,.2145,.2879,.3553,.4173,.4729,.5241,.5685,.6094, 6697.
6700     2 .6446,.6766,.7046,.7294,.7519,.7713,.7891,.8046,.8186,.8314, 6698.
6701     3 .8425,.8529,.8621,.8704,.8782,.8850,.8913,.8972,.9025,.9074, 6699.
6702     4 .9119,.9161,.9200,.9235,.9269,.9300,.9328,.9356,.9381,.9405, 6700.
6703     5 .9427,.9448,.9467,.9486,.9503,.9520,.9535,.9550,.9564,.9577/ 6701.
6704     C 6702.
6705     DATA C09T05/0.0, 6703.
6706     1 .0614,.1528,.2288,.2967,.3590,.4167,.4692,.5181,.5613,.6013, 6704.
6707     2 .6363,.6684,.6966,.7219,.7449,.7648,.7832,.7993,.8138,.8271, 6705.
6708     3 .8387,.8495,.8591,.8678,.8759,.8830,.8896,.8958,.9013,.9064, 6706.
6709     4 .9111,.9154,.9195,.9232,.9266,.9298,.9328,.9356,.9382,.9407, 6707.
6710     5 .9429,.9451,.9471,.9490,.9508,.9525,.9541,.9556,.9570,.9583/ 6708.
6711     C 6709.
6712     DATA C09T06/0.0, 6710.
6713     1 .0849,.1736,.2461,.3098,.3680,.4217,.4710,.5172,.5586,.5974, 6711.
6714     2 .6316,.6632,.6913,.7166,.7398,.7599,.7787,.7951,.8100,.8236, 6712.
6715     3 .8355,.8467,.8566,.8656,.8740,.8813,.8882,.8945,.9002,.9055, 6713.
6716     4 .9104,.9148,.9190,.9228,.9264,.9297,.9328,.9356,.9383,.9408, 6714.
6717     5 .9431,.9454,.9474,.9494,.9512,.9529,.9545,.9561,.9575,.9589/ 6715.
6718     C 6716.
6719     DATA C09T07/0.0, 6717.
6720     1 .1078,.1944,.2643,.3249,.3797,.4300,.4764,.5199,.5594,.5965, 6718.
6721     2 .6296,.6605,.6881,.7132,.7362,.7565,.7753,.7918,.8069,.8208, 6719.
6722     3 .8330,.8443,.8545,.8637,.8723,.8799,.8869,.8934,.8992,.9047, 6720.
6723     4 .9097,.9143,.9186,.9225,.9262,.9295,.9327,.9356,.9384,.9409, 6721.
6724     5 .9433,.9456,.9477,.9497,.9515,.9533,.9549,.9565,.9579,.9593/ 6722.
6725     C 6723.
6726     DATA C09T08/0.0, 6724.
6727     1 .1297,.2146,.2824,.3405,.3927,.4402,.4839,.5250,.5625,.5979, 6725.
6728     2 .6298,.6597,.6866,.7113,.7340,.7541,.7729,.7895,.8046,.8186, 6726.
6729     3 .8309,.8424,.8528,.8621,.8709,.8786,.8858,.8924,.8984,.9040, 6727.
6730     4 .9091,.9138,.9182,.9222,.9259,.9294,.9326,.9356,.9384,.9410, 6728.
6731     5 .9434,.9457,.9479,.9499,.9518,.9536,.9552,.9568,.9583,.9597/ 6729.
6732     C 6730.
6733     DATA C09T09/0.0, 6731.
6734     1 .1505,.2340,.2999,.3561,.4060,.4512,.4927,.5315,.5672,.6009, 6732.
6735     2 .6315,.6603,.6865,.7105,.7328,.7526,.7713,.7878,.8029,.8169, 6733.
6736     3 .8293,.8409,.8513,.8608,.8697,.8775,.8848,.8916,.8976,.9033, 6734.
6737     4 .9085,.9133,.9178,.9219,.9257,.9292,.9325,.9356,.9384,.9411, 6735.
6738     5 .9435,.9459,.9480,.9501,.9520,.9538,.9555,.9571,.9586,.9600/ 6736.
6739     C 6737.
6740     DATA C09T10/0.0, 6738.
6741     1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 6739.
6742     2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 6740.
6743     3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 6741.
6744     4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 6742.
6745     5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 6743.
6746     C 6744.
6747     C 6745.
6748     IF(TAU.GT.1.0) THEN 6746.
6749     CALL HGCLD1(XMU,TAU,G,GG) 6747.
6750     GO TO 130 6748.
6751     ENDIF 6749.
6752     C 6750.
6753     C ---------------------------------------------------------------- 6751.
6754     C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 6752.
6755     C FOR AEROSOL ALBEDOS FOR OPTICAL THICKNESSES OF (0.0 < TAU < 1.0) 6753.
6756     C ---------------------------------------------------------------- 6754.
6757     C 6755.
6758     C 6756.
6759     C ------------------------------------------- 6757.
6760     C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 6758.
6761     C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 6759.
6762     C ------------------------------------------- 6760.
6763     C 6761.
6764     XI=XMU*50.0+0.9999 6762.
6765     IX=XI 6763.
6766     IF(IX.LT.1) IX=1 6764.
6767     JX=IX+1 6765.
6768     WXJ=XI-IX 6766.
6769     WXI=1.0-WXJ 6767.
6770     C 6768.
6771     C ------------------------- 6769.
6772     C AEROSOL TAU INTERPOLATION 6770.
6773     C 0.10 ON (0.0 < XMU < 1.0) 6771.
6774     C ------------------------- 6772.
6775     C 6773.
6776     TI=TAU*10.0+0.9999 6774.
6777     IT=TI 6775.
6778     IF(IT.LT.1) IT=1 6776.
6779     IF(IT.GT.11) IT=11 6777.
6780     JT=IT+1 6778.
6781     IF(JT.GT.11) JT=11 6779.
6782     WTJ=TI-IT 6780.
6783     WTI=1.0-WTJ 6781.
6784     C 6782.
6785     C ------------------------------- 6783.
6786     C COSBAR DEPENDENCE INTERPOLATION 6784.
6787     C 0.10 ON (0.5 < COSBAR < 0.9) 6785.
6788     C LINEAR FOR (0.0 < COSBAR < 0.5) 6786.
6789     C ------------------------------- 6787.
6790     C 6788.
6791     GI=G*10.0 6789.
6792     IF(GI.GT.5.0) GO TO 110 6790.
6793     JG=1 6791.
6794     GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6792.
6795     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6793.
6796     GG=GG+GG 6794.
6797     GO TO 130 6795.
6798     C 6796.
6799     110 IG=GI 6797.
6800     WGJ=GI-IG 6798.
6801     WGI=1.0-WGJ 6799.
6802     IG=IG-4 6800.
6803     JG=IG+1 6801.
6804     IF(IG.GT.4) GO TO 120 6802.
6805     C 6803.
6806     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6804.
6807     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6805.
6808     + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6806.
6809     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6807.
6810     GO TO 130 6808.
6811     C 6809.
6812     120 IG=5 6810.
6813     C 6811.
6814     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6812.
6815     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6813.
6816     + +WGJ 6814.
6817     C 6815.
6818     130 CONTINUE 6816.
6819     C 6817.
6820     RETURN 6818.
6821     END 6819.
6822     SUBROUTINE HGCLD1(XMU,TAU,G,GG) 6820.
6823     C 6821.
6824     DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6822.
6825     DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6823.
6826     DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6824.
6827     DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6825.
6828     DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6826.
6829     DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6827.
6830     DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6828.
6831     DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6829.
6832     DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6830.
6833     DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6831.
6834     DIMENSION C05T99(51),C06T99(51),C07T99(51),C08T99(51),C09T99(51) 6832.
6835     C 6833.
6836     DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6834.
6837     DIMENSION C09TAU(51,11) 6835.
6838     C 6836.
6839     DIMENSION GTAU(51,11,5) 6837.
6840     C 6838.
6841     EQUIVALENCE (C05TAU(1, 1),C05T01(1)),(C05TAU(1, 2),C05T02(1)) 6839.
6842     EQUIVALENCE (C05TAU(1, 3),C05T03(1)),(C05TAU(1, 4),C05T04(1)) 6840.
6843     EQUIVALENCE (C05TAU(1, 5),C05T05(1)),(C05TAU(1, 6),C05T06(1)) 6841.
6844     EQUIVALENCE (C05TAU(1, 7),C05T07(1)),(C05TAU(1, 8),C05T08(1)) 6842.
6845     EQUIVALENCE (C05TAU(1, 9),C05T09(1)),(C05TAU(1,10),C05T10(1)) 6843.
6846     EQUIVALENCE (C05TAU(1,11),C05T99(1)) 6844.
6847     C 6845.
6848     EQUIVALENCE (C06TAU(1, 1),C06T01(1)),(C06TAU(1, 2),C06T02(1)) 6846.
6849     EQUIVALENCE (C06TAU(1, 3),C06T03(1)),(C06TAU(1, 4),C06T04(1)) 6847.
6850     EQUIVALENCE (C06TAU(1, 5),C06T05(1)),(C06TAU(1, 6),C06T06(1)) 6848.
6851     EQUIVALENCE (C06TAU(1, 7),C06T07(1)),(C06TAU(1, 8),C06T08(1)) 6849.
6852     EQUIVALENCE (C06TAU(1, 9),C06T09(1)),(C06TAU(1,10),C06T10(1)) 6850.
6853     EQUIVALENCE (C06TAU(1,11),C06T99(1)) 6851.
6854     C 6852.
6855     EQUIVALENCE (C07TAU(1, 1),C07T01(1)),(C07TAU(1, 2),C07T02(1)) 6853.
6856     EQUIVALENCE (C07TAU(1, 3),C07T03(1)),(C07TAU(1, 4),C07T04(1)) 6854.
6857     EQUIVALENCE (C07TAU(1, 5),C07T05(1)),(C07TAU(1, 6),C07T06(1)) 6855.
6858     EQUIVALENCE (C07TAU(1, 7),C07T07(1)),(C07TAU(1, 8),C07T08(1)) 6856.
6859     EQUIVALENCE (C07TAU(1, 9),C07T09(1)),(C07TAU(1,10),C07T10(1)) 6857.
6860     EQUIVALENCE (C07TAU(1,11),C07T99(1)) 6858.
6861     C 6859.
6862     EQUIVALENCE (C08TAU(1, 1),C08T01(1)),(C08TAU(1, 2),C08T02(1)) 6860.
6863     EQUIVALENCE (C08TAU(1, 3),C08T03(1)),(C08TAU(1, 4),C08T04(1)) 6861.
6864     EQUIVALENCE (C08TAU(1, 5),C08T05(1)),(C08TAU(1, 6),C08T06(1)) 6862.
6865     EQUIVALENCE (C08TAU(1, 7),C08T07(1)),(C08TAU(1, 8),C08T08(1)) 6863.
6866     EQUIVALENCE (C08TAU(1, 9),C08T09(1)),(C08TAU(1,10),C08T10(1)) 6864.
6867     EQUIVALENCE (C08TAU(1,11),C08T99(1)) 6865.
6868     C 6866.
6869     EQUIVALENCE (C09TAU(1, 1),C09T01(1)),(C09TAU(1, 2),C09T02(1)) 6867.
6870     EQUIVALENCE (C09TAU(1, 3),C09T03(1)),(C09TAU(1, 4),C09T04(1)) 6868.
6871     EQUIVALENCE (C09TAU(1, 5),C09T05(1)),(C09TAU(1, 6),C09T06(1)) 6869.
6872     EQUIVALENCE (C09TAU(1, 7),C09T07(1)),(C09TAU(1, 8),C09T08(1)) 6870.
6873     EQUIVALENCE (C09TAU(1, 9),C09T09(1)),(C09TAU(1,10),C09T10(1)) 6871.
6874     EQUIVALENCE (C09TAU(1,11),C09T99(1)) 6872.
6875     C 6873.
6876     EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6874.
6877     EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6875.
6878     EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6876.
6879     C 6877.
6880     C 6878.
6881     DATA C05T01/0.0, 6879.
6882     1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6880.
6883     2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6881.
6884     3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6882.
6885     4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6883.
6886     5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6884.
6887     C 6885.
6888     DATA C05T02/0.0, 6886.
6889     1 .1981,.2188,.2361,.2514,.2656,.2788,.2912,.3031,.3145,.3255, 6887.
6890     2 .3362,.3466,.3569,.3669,.3768,.3865,.3962,.4057,.4151,.4244, 6888.
6891     3 .4337,.4428,.4519,.4609,.4698,.4785,.4872,.4958,.5043,.5127, 6889.
6892     4 .5209,.5290,.5371,.5450,.5528,.5604,.5679,.5753,.5826,.5898, 6890.
6893     5 .5968,.6037,.6105,.6171,.6237,.6301,.6364,.6425,.6486,.6545/ 6891.
6894     C 6892.
6895     DATA C05T03/0.0, 6893.
6896     1 .2435,.2639,.2809,.2960,.3099,.3227,.3348,.3463,.3571,.3676, 6894.
6897     2 .3777,.3874,.3969,.4060,.4150,.4237,.4323,.4407,.4489,.4570, 6895.
6898     3 .4650,.4728,.4806,.4882,.4957,.5031,.5104,.5177,.5248,.5319, 6896.
6899     4 .5388,.5457,.5525,.5592,.5659,.5724,.5788,.5852,.5915,.5977, 6897.
6900     5 .6038,.6098,.6157,.6215,.6273,.6330,.6385,.6440,.6494,.6547/ 6898.
6901     C 6899.
6902     DATA C05T04/0.0, 6900.
6903     1 .2714,.2914,.3081,.3229,.3365,.3491,.3608,.3719,.3824,.3925, 6901.
6904     2 .4022,.4115,.4205,.4292,.4377,.4459,.4540,.4618,.4694,.4769, 6902.
6905     3 .4842,.4914,.4985,.5054,.5122,.5189,.5255,.5320,.5384,.5447, 6903.
6906     4 .5509,.5570,.5631,.5690,.5749,.5807,.5865,.5921,.5977,.6033, 6904.
6907     5 .6087,.6141,.6194,.6246,.6298,.6349,.6399,.6448,.6497,.6545/ 6905.
6908     C 6906.
6909     DATA C05T05/0.0, 6907.
6910     1 .2900,.3097,.3262,.3408,.3541,.3664,.3778,.3887,.3989,.4088, 6908.
6911     2 .4181,.4272,.4358,.4442,.4524,.4602,.4680,.4754,.4827,.4898, 6909.
6912     3 .4967,.5035,.5101,.5166,.5230,.5293,.5354,.5415,.5474,.5533, 6910.
6913     4 .5590,.5647,.5703,.5757,.5812,.5865,.5918,.5970,.6021,.6071, 6911.
6914     5 .6121,.6171,.6219,.6267,.6315,.6361,.6407,.6453,.6498,.6542/ 6912.
6915     C 6913.
6916     DATA C05T06/0.0, 6914.
6917     1 .3033,.3228,.3390,.3534,.3665,.3786,.3898,.4005,.4105,.4201, 6915.
6918     2 .4292,.4380,.4465,.4546,.4625,.4701,.4776,.4848,.4918,.4986, 6916.
6919     3 .5053,.5118,.5182,.5244,.5305,.5364,.5423,.5480,.5537,.5592, 6917.
6920     4 .5646,.5700,.5753,.5804,.5855,.5905,.5955,.6004,.6052,.6099, 6918.
6921     5 .6146,.6192,.6237,.6282,.6326,.6370,.6413,.6456,.6498,.6539/ 6919.
6922     C 6920.
6923     DATA C05T07/0.0, 6921.
6924     1 .3133,.3325,.3485,.3627,.3757,.3876,.3987,.4092,.4190,.4284, 6922.
6925     2 .4374,.4460,.4543,.4622,.4700,.4774,.4846,.4916,.4984,.5051, 6923.
6926     3 .5115,.5178,.5240,.5300,.5359,.5416,.5472,.5528,.5582,.5635, 6924.
6927     4 .5687,.5738,.5789,.5838,.5887,.5935,.5982,.6029,.6074,.6119, 6925.
6928     5 .6164,.6208,.6251,.6293,.6335,.6377,.6418,.6458,.6498,.6537/ 6926.
6929     C 6927.
6930     DATA C05T08/0.0, 6928.
6931     1 .3210,.3400,.3559,.3699,.3827,.3945,.4054,.4158,.4255,.4348, 6929.
6932     2 .4436,.4521,.4602,.4680,.4756,.4829,.4900,.4968,.5034,.5099, 6930.
6933     3 .5162,.5224,.5284,.5342,.5400,.5455,.5510,.5564,.5616,.5667, 6931.
6934     4 .5718,.5767,.5816,.5864,.5911,.5957,.6003,.6047,.6091,.6135, 6932.
6935     5 .6177,.6219,.6261,.6302,.6342,.6381,.6421,.6459,.6497,.6535/ 6933.
6936     C 6934.
6937     DATA C05T09/0.0, 6935.
6938     1 .3271,.3460,.3618,.3757,.3883,.4000,.4108,.4211,.4306,.4398, 6936.
6939     2 .4485,.4569,.4649,.4726,.4800,.4872,.4941,.5008,.5074,.5137, 6937.
6940     3 .5199,.5259,.5318,.5375,.5431,.5486,.5539,.5591,.5642,.5693, 6938.
6941     4 .5742,.5790,.5837,.5884,.5930,.5974,.6018,.6062,.6104,.6146, 6939.
6942     5 .6188,.6228,.6268,.6308,.6347,.6385,.6423,.6460,.6497,.6533/ 6940.
6943     C 6941.
6944     DATA C05T10/0.0, 6942.
6945     1 .3321,.3509,.3665,.3803,.3929,.4045,.4152,.4253,.4348,.4439, 6943.
6946     2 .4525,.4607,.4686,.4762,.4836,.4906,.4975,.5041,.5105,.5168, 6944.
6947     3 .5229,.5288,.5345,.5401,.5457,.5510,.5562,.5614,.5664,.5713, 6945.
6948     4 .5761,.5808,.5854,.5900,.5944,.5988,.6031,.6073,.6115,.6156, 6946.
6949     5 .6196,.6236,.6275,.6313,.6351,.6388,.6425,.6461,.6497,.6532/ 6947.
6950     C 6948.
6951     DATA C05T99/0.0, 6949.
6952     1 .3759,.3933,.4078,.4204,.4320,.4425,.4522,.4614,.4699,.4781, 6950.
6953     2 .4857,.4930,.5000,.5067,.5131,.5192,.5252,.5309,.5364,.5417, 6951.
6954     3 .5469,.5519,.5568,.5615,.5661,.5705,.5749,.5791,.5832,.5873, 6952.
6955     4 .5912,.5950,.5988,.6024,.6060,.6095,.6130,.6164,.6196,.6229, 6953.
6956     5 .6260,.6292,.6322,.6352,.6381,.6410,.6439,.6467,.6494,.6521/ 6954.
6957     C 6955.
6958     DATA C06T01/0.0, 6956.
6959     1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6957.
6960     2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6958.
6961     3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6959.
6962     4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6960.
6963     5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6961.
6964     C 6962.
6965     DATA C06T02/0.0, 6963.
6966     1 .2301,.2561,.2779,.2973,.3151,.3317,.3472,.3620,.3761,.3897, 6964.
6967     2 .4028,.4155,.4279,.4399,.4518,.4633,.4747,.4858,.4968,.5076, 6965.
6968     3 .5182,.5287,.5389,.5490,.5589,.5686,.5781,.5875,.5967,.6057, 6966.
6969     4 .6144,.6230,.6315,.6397,.6478,.6556,.6633,.6708,.6781,.6853, 6967.
6970     5 .6922,.6991,.7057,.7121,.7184,.7246,.7306,.7364,.7421,.7476/ 6968.
6971     C 6969.
6972     DATA C06T03/0.0, 6970.
6973     1 .2848,.3100,.3311,.3497,.3668,.3825,.3971,.4110,.4240,.4365, 6971.
6974     2 .4484,.4599,.4710,.4816,.4921,.5021,.5119,.5214,.5308,.5399, 6972.
6975     3 .5488,.5575,.5661,.5745,.5828,.5908,.5988,.6066,.6142,.6217, 6973.
6976     4 .6291,.6364,.6435,.6505,.6574,.6641,.6707,.6772,.6835,.6898, 6974.
6977     5 .6959,.7019,.7077,.7135,.7191,.7246,.7300,.7353,.7404,.7455/ 6975.
6978     C 6976.
6979     DATA C06T04/0.0, 6977.
6980     1 .3189,.3434,.3639,.3819,.3983,.4134,.4273,.4406,.4529,.4647, 6978.
6981     2 .4759,.4867,.4970,.5069,.5165,.5258,.5348,.5435,.5519,.5602, 6979.
6982     3 .5682,.5761,.5837,.5912,.5985,.6057,.6127,.6196,.6263,.6330, 6980.
6983     4 .6395,.6459,.6521,.6583,.6644,.6703,.6761,.6819,.6875,.6931, 6981.
6984     5 .6985,.7039,.7091,.7143,.7194,.7243,.7292,.7340,.7387,.7433/ 6982.
6985     C 6983.
6986     DATA C06T05/0.0, 6984.
6987     1 .3420,.3660,.3859,.4034,.4193,.4339,.4474,.4601,.4720,.4833, 6985.
6988     2 .4940,.5043,.5141,.5235,.5326,.5413,.5498,.5579,.5658,.5736, 6986.
6989     3 .5810,.5883,.5954,.6023,.6091,.6157,.6221,.6285,.6346,.6407, 6987.
6990     4 .6466,.6525,.6582,.6638,.6693,.6747,.6800,.6853,.6904,.6955, 6988.
6991     5 .7004,.7053,.7101,.7148,.7194,.7240,.7285,.7329,.7372,.7415/ 6989.
6992     C 6990.
6993     DATA C06T06/0.0, 6991.
6994     1 .3586,.3821,.4016,.4187,.4342,.4484,.4615,.4739,.4854,.4964, 6992.
6995     2 .5067,.5166,.5260,.5350,.5438,.5521,.5602,.5680,.5755,.5829, 6993.
6996     3 .5899,.5968,.6036,.6101,.6165,.6227,.6287,.6347,.6405,.6462, 6994.
6997     4 .6517,.6571,.6625,.6677,.6729,.6779,.6828,.6877,.6925,.6972, 6995.
6998     5 .7018,.7063,.7108,.7152,.7195,.7237,.7279,.7320,.7360,.7400/ 6996.
6999     C 6997.
7000     DATA C06T07/0.0, 6998.
7001     1 .3711,.3942,.4133,.4301,.4453,.4592,.4720,.4841,.4953,.5060, 6999.
7002     2 .5160,.5256,.5348,.5435,.5520,.5600,.5678,.5753,.5826,.5896, 7000.
7003     3 .5964,.6031,.6095,.6157,.6219,.6278,.6336,.6392,.6447,.6501, 7001.
7004     4 .6554,.6606,.6657,.6706,.6755,.6802,.6849,.6895,.6940,.6985, 7002.
7005     5 .7028,.7071,.7113,.7154,.7195,.7235,.7274,.7313,.7351,.7388/ 7003.
7006     C 7004.
7007     DATA C06T08/0.0, 7005.
7008     1 .3808,.4036,.4224,.4390,.4539,.4676,.4801,.4920,.5029,.5134, 7006.
7009     2 .5232,.5326,.5415,.5500,.5582,.5660,.5736,.5809,.5880,.5948, 7007.
7010     3 .6014,.6078,.6140,.6200,.6259,.6316,.6372,.6427,.6480,.6532, 7008.
7011     4 .6582,.6632,.6681,.6728,.6775,.6820,.6865,.6909,.6952,.6994, 7009.
7012     5 .7036,.7077,.7117,.7156,.7195,.7233,.7270,.7307,.7343,.7379/ 7010.
7013     C 7011.
7014     DATA C06T09/0.0, 7012.
7015     1 .3886,.4111,.4297,.4460,.4607,.4742,.4865,.4982,.5089,.5192, 7013.
7016     2 .5288,.5380,.5467,.5551,.5631,.5708,.5782,.5853,.5922,.5988, 7014.
7017     3 .6052,.6115,.6175,.6234,.6291,.6347,.6401,.6454,.6505,.6555, 7015.
7018     4 .6604,.6652,.6699,.6745,.6790,.6834,.6877,.6920,.6961,.7002, 7016.
7019     5 .7042,.7081,.7119,.7157,.7195,.7231,.7267,.7303,.7337,.7372/ 7017.
7020     C 7018.
7021     DATA C06T10/0.0, 7019.
7022     1 .3949,.4172,.4356,.4517,.4663,.4796,.4917,.5032,.5138,.5239, 7020.
7023     2 .5334,.5424,.5510,.5592,.5671,.5746,.5819,.5888,.5955,.6021, 7021.
7024     3 .6083,.6144,.6203,.6261,.6317,.6371,.6424,.6475,.6525,.6574, 7022.
7025     4 .6622,.6668,.6714,.6759,.6802,.6845,.6887,.6928,.6968,.7008, 7023.
7026     5 .7046,.7085,.7122,.7159,.7195,.7230,.7265,.7299,.7333,.7366/ 7024.
7027     C 7025.
7028     DATA C06T99/0.0, 7026.
7029     1 .4509,.4707,.4871,.5013,.5141,.5256,.5362,.5461,.5551,.5638, 7027.
7030     2 .5718,.5794,.5866,.5934,.6000,.6062,.6122,.6178,.6233,.6286, 7028.
7031     3 .6336,.6386,.6433,.6478,.6523,.6565,.6607,.6647,.6686,.6724, 7029.
7032     4 .6761,.6797,.6832,.6866,.6900,.6932,.6964,.6995,.7025,.7055, 7030.
7033     5 .7084,.7112,.7140,.7167,.7194,.7220,.7245,.7270,.7295,.7319/ 7031.
7034     C 7032.
7035     DATA C07T01/0.0, 7033.
7036     1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 7034.
7037     2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 7035.
7038     3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 7036.
7039     4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 7037.
7040     5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 7038.
7041     C 7039.
7042     DATA C07T02/0.0, 7040.
7043     1 .2601,.2939,.3219,.3466,.3691,.3898,.4090,.4272,.4442,.4606, 7041.
7044     2 .4762,.4912,.5057,.5198,.5334,.5466,.5596,.5721,.5843,.5963, 7042.
7045     3 .6078,.6192,.6302,.6410,.6515,.6616,.6715,.6811,.6904,.6995, 7043.
7046     4 .7083,.7168,.7251,.7331,.7409,.7483,.7556,.7626,.7694,.7760, 7044.
7047     5 .7824,.7885,.7945,.8002,.8058,.8111,.8163,.8214,.8262,.8309/ 7045.
7048     C 7046.
7049     DATA C07T03/0.0, 7047.
7050     1 .3256,.3578,.3842,.4074,.4283,.4473,.4648,.4813,.4966,.5111, 7048.
7051     2 .5248,.5379,.5504,.5624,.5740,.5851,.5959,.6063,.6163,.6262, 7049.
7052     3 .6357,.6450,.6540,.6628,.6715,.6798,.6880,.6960,.7037,.7113, 7050.
7053     4 .7187,.7259,.7330,.7398,.7465,.7530,.7594,.7656,.7716,.7774, 7051.
7054     5 .7831,.7887,.7940,.7993,.8044,.8093,.8141,.8188,.8233,.8278/ 7052.
7055     C 7053.
7056     DATA C07T04/0.0, 7054.
7057     1 .3675,.3983,.4235,.4455,.4652,.4831,.4995,.5149,.5290,.5424, 7055.
7058     2 .5550,.5670,.5783,.5892,.5996,.6096,.6192,.6284,.6374,.6461, 7056.
7059     3 .6544,.6626,.6705,.6781,.6857,.6929,.7000,.7070,.7137,.7204, 7057.
7060     4 .7268,.7331,.7393,.7453,.7512,.7569,.7625,.7680,.7734,.7786, 7058.
7061     5 .7837,.7887,.7936,.7983,.8030,.8075,.8119,.8163,.8205,.8246/ 7059.
7062     C 7060.
7063     DATA C07T05/0.0, 7061.
7064     1 .3963,.4260,.4503,.4714,.4902,.5073,.5228,.5374,.5507,.5634, 7062.
7065     2 .5752,.5864,.5970,.6071,.6168,.6260,.6349,.6434,.6516,.6596, 7063.
7066     3 .6672,.6746,.6818,.6888,.6956,.7022,.7086,.7149,.7210,.7270, 7064.
7067     4 .7328,.7384,.7440,.7494,.7547,.7599,.7650,.7699,.7748,.7796, 7065.
7068     5 .7842,.7887,.7932,.7976,.8018,.8060,.8101,.8141,.8180,.8218/ 7066.
7069     C 7067.
7070     DATA C07T06/0.0, 7068.
7071     1 .4172,.4461,.4696,.4900,.5082,.5246,.5395,.5535,.5662,.5783, 7069.
7072     2 .5895,.6001,.6102,.6198,.6289,.6376,.6460,.6540,.6617,.6691, 7070.
7073     3 .6763,.6832,.6899,.6964,.7028,.7089,.7148,.7206,.7263,.7318, 7071.
7074     4 .7371,.7424,.7475,.7525,.7574,.7622,.7668,.7714,.7759,.7803, 7072.
7075     5 .7846,.7888,.7929,.7969,.8009,.8048,.8086,.8123,.8159,.8195/ 7073.
7076     C 7074.
7077     DATA C07T07/0.0, 7075.
7078     1 .4331,.4613,.4842,.5040,.5216,.5375,.5520,.5654,.5777,.5893, 7076.
7079     2 .6001,.6104,.6200,.6291,.6379,.6462,.6542,.6618,.6691,.6762, 7077.
7080     3 .6830,.6896,.6959,.7021,.7081,.7138,.7194,.7249,.7302,.7354, 7078.
7081     4 .7404,.7453,.7502,.7548,.7594,.7639,.7683,.7726,.7768,.7809, 7079.
7082     5 .7849,.7888,.7927,.7965,.8002,.8038,.8074,.8109,.8143,.8177/ 7080.
7083     C 7081.
7084     DATA C07T08/0.0, 7082.
7085     1 .4455,.4731,.4955,.5148,.5320,.5475,.5616,.5747,.5866,.5979, 7083.
7086     2 .6083,.6182,.6275,.6363,.6448,.6528,.6605,.6678,.6748,.6816, 7084.
7087     3 .6881,.6944,.7005,.7064,.7121,.7176,.7230,.7282,.7332,.7382, 7085.
7088     4 .7430,.7476,.7522,.7566,.7610,.7652,.7694,.7735,.7774,.7813, 7086.
7089     5 .7851,.7889,.7925,.7961,.7996,.8030,.8064,.8097,.8130,.8162/ 7087.
7090     C 7088.
7091     DATA C07T09/0.0, 7089.
7092     1 .4555,.4826,.5046,.5235,.5404,.5555,.5692,.5820,.5936,.6046, 7090.
7093     2 .6147,.6244,.6334,.6420,.6502,.6579,.6654,.6725,.6793,.6859, 7091.
7094     3 .6921,.6982,.7041,.7098,.7153,.7206,.7257,.7308,.7356,.7404, 7092.
7095     4 .7449,.7494,.7538,.7581,.7622,.7663,.7703,.7742,.7780,.7817, 7093.
7096     5 .7853,.7889,.7924,.7958,.7992,.8024,.8057,.8088,.8119,.8150/ 7094.
7097     C 7095.
7098     DATA C07T10/0.0, 7096.
7099     1 .4637,.4903,.5120,.5306,.5471,.5620,.5754,.5879,.5993,.6101, 7097.
7100     2 .6200,.6294,.6382,.6466,.6546,.6621,.6694,.6763,.6829,.6893, 7098.
7101     3 .6954,.7013,.7070,.7125,.7179,.7230,.7280,.7328,.7375,.7421, 7099.
7102     4 .7465,.7509,.7551,.7592,.7632,.7672,.7710,.7747,.7784,.7820, 7100.
7103     5 .7855,.7889,.7923,.7956,.7988,.8020,.8051,.8081,.8111,.8140/ 7101.
7104     C 7102.
7105     DATA C07T99/0.0, 7103.
7106     1 .5366,.5590,.5770,.5924,.6060,.6180,.6289,.6389,.6480,.6565, 7104.
7107     2 .6643,.6717,.6785,.6850,.6912,.6969,.7025,.7077,.7127,.7175, 7105.
7108     3 .7220,.7264,.7306,.7347,.7386,.7423,.7460,.7495,.7529,.7562, 7106.
7109     4 .7594,.7625,.7655,.7684,.7712,.7740,.7767,.7793,.7818,.7843, 7107.
7110     5 .7867,.7891,.7914,.7937,.7959,.7981,.8002,.8022,.8043,.8062/ 7108.
7111     C 7109.
7112     DATA C08T01/0.0, 7110.
7113     1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 7111.
7114     2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 7112.
7115     3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 7113.
7116     4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 7114.
7117     5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 7115.
7118     C 7116.
7119     DATA C08T02/0.0, 7117.
7120     1 .2878,.3342,.3718,.4041,.4329,.4588,.4824,.5045,.5249,.5442, 7118.
7121     2 .5623,.5797,.5962,.6120,.6272,.6417,.6559,.6693,.6823,.6949, 7119.
7122     3 .7069,.7186,.7298,.7405,.7509,.7606,.7701,.7792,.7879,.7963, 7120.
7123     4 .8042,.8118,.8191,.8260,.8327,.8390,.8451,.8509,.8564,.8617, 7121.
7124     5 .8667,.8716,.8762,.8806,.8848,.8888,.8926,.8963,.8998,.9032/ 7122.
7125     C 7123.
7126     DATA C08T03/0.0, 7124.
7127     1 .3656,.4087,.4432,.4725,.4984,.5215,.5422,.5614,.5789,.5954, 7125.
7128     2 .6106,.6251,.6387,.6517,.6641,.6758,.6872,.6981,.7085,.7187, 7126.
7129     3 .7283,.7378,.7468,.7555,.7641,.7722,.7801,.7878,.7951,.8022, 7127.
7130     4 .8091,.8157,.8221,.8282,.8342,.8399,.8454,.8507,.8558,.8608, 7128.
7131     5 .8655,.8700,.8744,.8786,.8826,.8865,.8903,.8939,.8973,.9006/ 7129.
7132     C 7130.
7133     DATA C08T04/0.0, 7131.
7134     1 .4167,.4573,.4895,.5167,.5405,.5616,.5805,.5979,.6136,.6283, 7132.
7135     2 .6419,.6547,.6668,.6781,.6890,.6992,.7091,.7184,.7274,.7361, 7133.
7136     3 .7444,.7525,.7602,.7677,.7750,.7820,.7888,.7954,.8018,.8080, 7134.
7137     4 .8139,.8197,.8254,.8308,.8361,.8412,.8462,.8510,.8556,.8601, 7135.
7138     5 .8645,.8687,.8728,.8767,.8805,.8842,.8877,.8912,.8945,.8977/ 7136.
7139     C 7137.
7140     DATA C08T05/0.0, 7138.
7141     1 .4528,.4913,.5218,.5473,.5696,.5893,.6069,.6230,.6375,.6511, 7139.
7142     2 .6635,.6752,.6862,.6965,.7063,.7156,.7245,.7329,.7409,.7487, 7140.
7143     3 .7561,.7633,.7703,.7769,.7834,.7896,.7957,.8015,.8072,.8127, 7141.
7144     4 .8180,.8232,.8283,.8332,.8379,.8426,.8470,.8514,.8556,.8598, 7142.
7145     5 .8638,.8677,.8714,.8751,.8787,.8821,.8855,.8887,.8919,.8950/ 7143.
7146     C 7144.
7147     DATA C08T06/0.0, 7145.
7148     1 .4795,.5164,.5454,.5697,.5909,.6095,.6261,.6412,.6548,.6675, 7146.
7149     2 .6791,.6901,.7003,.7098,.7190,.7275,.7357,.7435,.7509,.7581, 7147.
7150     3 .7648,.7714,.7778,.7838,.7898,.7954,.8009,.8063,.8115,.8165, 7148.
7151     4 .8214,.8261,.8307,.8352,.8395,.8437,.8479,.8519,.8558,.8596, 7149.
7152     5 .8633,.8669,.8704,.8738,.8772,.8804,.8836,.8866,.8896,.8925/ 7150.
7153     C 7151.
7154     DATA C08T07/0.0, 7152.
7155     1 .5000,.5356,.5635,.5868,.6070,.6248,.6406,.6550,.6679,.6800, 7153.
7156     2 .6909,.7013,.7109,.7199,.7285,.7365,.7442,.7515,.7584,.7651, 7154.
7157     3 .7715,.7776,.7835,.7892,.7947,.7999,.8051,.8100,.8148,.8195, 7155.
7158     4 .8240,.8284,.8327,.8368,.8408,.8448,.8486,.8523,.8560,.8595, 7156.
7159     5 .8630,.8663,.8696,.8728,.8759,.8790,.8820,.8849,.8877,.8905/ 7157.
7160     C 7158.
7161     DATA C08T08/0.0, 7159.
7162     1 .5162,.5507,.5777,.6002,.6197,.6368,.6519,.6657,.6781,.6896, 7160.
7163     2 .7001,.7100,.7191,.7277,.7359,.7435,.7508,.7577,.7643,.7706, 7161.
7164     3 .7766,.7824,.7880,.7933,.7986,.8035,.8083,.8130,.8175,.8219, 7162.
7165     4 .8261,.8302,.8343,.8381,.8419,.8456,.8492,.8527,.8561,.8595, 7163.
7166     5 .8627,.8659,.8690,.8720,.8750,.8778,.8806,.8834,.8861,.8887/ 7164.
7167     C 7165.
7168     DATA C08T09/0.0, 7166.
7169     1 .5293,.5629,.5891,.6109,.6298,.6464,.6610,.6743,.6862,.6974, 7167.
7170     2 .7074,.7169,.7257,.7340,.7418,.7491,.7561,.7627,.7690,.7750, 7168.
7171     3 .7807,.7863,.7916,.7967,.8016,.8063,.8109,.8154,.8196,.8238, 7169.
7172     4 .8278,.8317,.8356,.8392,.8428,.8463,.8497,.8531,.8563,.8595, 7170.
7173     5 .8625,.8656,.8685,.8714,.8742,.8769,.8796,.8822,.8847,.8872/ 7171.
7174     C 7172.
7175     DATA C08T10/0.0, 7173.
7176     1 .5401,.5729,.5985,.6197,.6381,.6542,.6684,.6813,.6929,.7036, 7174.
7177     2 .7134,.7226,.7311,.7390,.7466,.7536,.7604,.7667,.7728,.7786, 7175.
7178     3 .7841,.7894,.7945,.7994,.8042,.8087,.8131,.8173,.8214,.8254, 7176.
7179     4 .8292,.8330,.8366,.8401,.8436,.8469,.8502,.8534,.8564,.8595, 7177.
7180     5 .8624,.8653,.8681,.8708,.8735,.8761,.8787,.8812,.8836,.8860/ 7178.
7181     C 7179.
7182     DATA C08T99/0.0, 7180.
7183     1 .6384,.6631,.6821,.6978,.7111,.7227,.7328,.7420,.7501,.7576, 7181.
7184     2 .7644,.7707,.7765,.7819,.7870,.7918,.7963,.8005,.8045,.8084, 7182.
7185     3 .8120,.8154,.8187,.8219,.8250,.8278,.8307,.8334,.8360,.8385, 7183.
7186     4 .8409,.8432,.8455,.8477,.8498,.8519,.8539,.8559,.8578,.8596, 7184.
7187     5 .8614,.8632,.8648,.8665,.8681,.8697,.8712,.8728,.8742,.8757/ 7185.
7188     C 7186.
7189     DATA C09T01/0.0, 7187.
7190     1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 7188.
7191     2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 7189.
7192     3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 7190.
7193     4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 7191.
7194     5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 7192.
7195     C 7193.
7196     DATA C09T02/0.0, 7194.
7197     1 .3174,.3895,.4438,.4879,.5256,.5583,.5872,.6136,.6374,.6597, 7195.
7198     2 .6802,.6995,.7175,.7345,.7506,.7655,.7798,.7930,.8055,.8173, 7196.
7199     3 .8281,.8385,.8481,.8570,.8655,.8731,.8804,.8872,.8935,.8994, 7197.
7200     4 .9049,.9099,.9148,.9191,.9233,.9271,.9307,.9341,.9373,.9402, 7198.
7201     5 .9430,.9456,.9480,.9503,.9524,.9544,.9563,.9581,.9598,.9613/ 7199.
7202     C 7200.
7203     DATA C09T03/0.0, 7201.
7204     1 .4078,.4729,.5209,.5592,.5915,.6191,.6431,.6649,.6842,.7022, 7202.
7205     2 .7185,.7339,.7481,.7614,.7741,.7859,.7972,.8078,.8178,.8274, 7203.
7206     3 .8364,.8451,.8532,.8608,.8682,.8750,.8815,.8877,.8934,.8989, 7204.
7207     4 .9040,.9089,.9135,.9177,.9218,.9256,.9292,.9326,.9358,.9388, 7205.
7208     5 .9416,.9443,.9468,.9491,.9514,.9535,.9554,.9573,.9591,.9607/ 7206.
7209     C 7207.
7210     DATA C09T04/0.0, 7208.
7211     1 .4692,.5288,.5723,.6066,.6353,.6597,.6807,.6997,.7163,.7318, 7209.
7212     2 .7457,.7588,.7708,.7821,.7927,.8026,.8121,.8210,.8295,.8376, 7210.
7213     3 .8452,.8525,.8595,.8661,.8724,.8784,.8841,.8896,.8948,.8998, 7211.
7214     4 .9044,.9089,.9132,.9172,.9210,.9247,.9281,.9314,.9345,.9374, 7212.
7215     5 .9402,.9429,.9453,.9477,.9500,.9521,.9541,.9560,.9579,.9596/ 7213.
7216     C 7214.
7217     DATA C09T05/0.0, 7215.
7218     1 .5136,.5690,.6090,.6404,.6666,.6886,.7076,.7246,.7394,.7532, 7216.
7219     2 .7655,.7771,.7877,.7976,.8069,.8156,.8239,.8316,.8390,.8461, 7217.
7220     3 .8528,.8592,.8653,.8711,.8767,.8820,.8871,.8920,.8967,.9012, 7218.
7221     4 .9054,.9095,.9134,.9171,.9207,.9241,.9274,.9305,.9335,.9363, 7219.
7222     5 .9390,.9416,.9440,.9464,.9486,.9507,.9527,.9546,.9565,.9582/ 7220.
7223     C 7221.
7224     DATA C09T06/0.0, 7222.
7225     1 .5473,.5993,.6366,.6658,.6900,.7102,.7277,.7432,.7568,.7693, 7223.
7226     2 .7805,.7910,.8006,.8095,.8179,.8257,.8332,.8401,.8468,.8531, 7224.
7227     3 .8591,.8648,.8703,.8755,.8806,.8853,.8899,.8944,.8986,.9027, 7225.
7228     4 .9066,.9103,.9140,.9174,.9207,.9239,.9270,.9299,.9327,.9354, 7226.
7229     5 .9380,.9405,.9429,.9451,.9473,.9494,.9514,.9533,.9551,.9568/ 7227.
7230     C 7228.
7231     DATA C09T07/0.0, 7229.
7232     1 .5737,.6230,.6581,.6855,.7081,.7271,.7433,.7577,.7703,.7819, 7230.
7233     2 .7922,.8019,.8107,.8189,.8266,.8338,.8406,.8470,.8530,.8588, 7231.
7234     3 .8643,.8695,.8745,.8793,.8839,.8883,.8925,.8966,.9004,.9042, 7232.
7235     4 .9078,.9113,.9146,.9178,.9209,.9239,.9268,.9295,.9322,.9348, 7233.
7236     5 .9372,.9396,.9419,.9441,.9462,.9482,.9502,.9520,.9538,.9555/ 7234.
7237     C 7235.
7238     DATA C09T08/0.0, 7236.
7239     1 .5950,.6420,.6754,.7013,.7226,.7405,.7557,.7693,.7811,.7919, 7237.
7240     2 .8016,.8106,.8188,.8265,.8337,.8403,.8466,.8525,.8582,.8635, 7238.
7241     3 .8686,.8734,.8781,.8825,.8868,.8908,.8947,.8985,.9021,.9056, 7239.
7242     4 .9089,.9121,.9153,.9183,.9212,.9240,.9267,.9293,.9318,.9343, 7240.
7243     5 .9366,.9389,.9411,.9432,.9452,.9472,.9490,.9509,.9526,.9543/ 7241.
7244     C 7242.
7245     DATA C09T09/0.0, 7243.
7246     1 .6125,.6576,.6894,.7142,.7345,.7514,.7659,.7787,.7899,.8001, 7244.
7247     2 .8093,.8177,.8255,.8327,.8394,.8457,.8516,.8572,.8624,.8675, 7245.
7248     3 .8722,.8767,.8811,.8852,.8892,.8930,.8966,.9002,.9035,.9068, 7246.
7249     4 .9100,.9130,.9159,.9187,.9215,.9241,.9267,.9292,.9316,.9339, 7247.
7250     5 .9361,.9383,.9404,.9424,.9443,.9462,.9481,.9498,.9515,.9532/ 7248.
7251     C 7249.
7252     DATA C09T10/0.0, 7250.
7253     1 .6272,.6706,.7012,.7249,.7443,.7605,.7743,.7866,.7972,.8069, 7251.
7254     2 .8156,.8236,.8310,.8378,.8442,.8501,.8558,.8610,.8660,.8708, 7252.
7255     3 .8752,.8795,.8836,.8875,.8913,.8949,.8983,.9016,.9048,.9079, 7253.
7256     4 .9109,.9137,.9165,.9192,.9218,.9243,.9267,.9291,.9314,.9336, 7254.
7257     5 .9357,.9378,.9398,.9417,.9436,.9454,.9472,.9489,.9506,.9522/ 7255.
7258     C 7256.
7259     DATA C09T99/0.0, 7257.
7260     1 .7681,.7934,.8109,.8243,.8350,.8439,.8514,.8579,.8636,.8687, 7258.
7261     2 .8732,.8774,.8812,.8847,.8880,.8910,.8938,.8964,.8989,.9013, 7259.
7262     3 .9035,.9056,.9076,.9095,.9113,.9130,.9147,.9163,.9178,.9193, 7260.
7263     4 .9207,.9221,.9234,.9247,.9260,.9271,.9283,.9294,.9305,.9316, 7261.
7264     5 .9326,.9336,.9346,.9355,.9364,.9373,.9382,.9390,.9398,.9406/ 7262.
7265     C 7263.
7266     C 7264.
7267     C ---------------------------------------------------------------- 7265.
7268     C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 7266.
7269     C FOR CLOUD ALBEDOS FOR OPTICAL THICKNESS FROM (1.0 < TAU < 99.0) 7267.
7270     C ---------------------------------------------------------------- 7268.
7271     C 7269.
7272     C 7270.
7273     C ------------------------------------------- 7271.
7274     C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 7272.
7275     C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 7273.
7276     C ------------------------------------------- 7274.
7277     C 7275.
7278     XI=XMU*50.0+0.9999 7276.
7279     IX=XI 7277.
7280     IF(IX.LT.1) IX=1 7278.
7281     JX=IX+1 7279.
7282     WXJ=XI-IX 7280.
7283     WXI=1.0-WXJ 7281.
7284     C 7282.
7285     C ----------------------- 7283.
7286     C CLOUD TAU INTERPOLATION 7284.
7287     C 1.0 OVER (1 < TAU < 10) 7285.
7288     C LINEAR (10 < TAU < 100) 7286.
7289     C ----------------------- 7287.
7290     C 7288.
7291     TI=TAU 7289.
7292     IT=TI 7290.
7293     IF(IT.LT.1) IT=1 7291.
7294     WTJ=TI-IT 7292.
7295     IF(IT.GT.9) THEN 7293.
7296     WTJ=(TAU-10.0)/90.0 7294.
7297     IT=10 7295.
7298     ENDIF 7296.
7299     WTI=1.0-WTJ 7297.
7300     JT=IT+1 7298.
7301     C 7299.
7302     C ------------------------------- 7300.
7303     C COSBAR DEPENDENCE INTERPOLATION 7301.
7304     C 0.10 ON (0.5 < COSBAR < 0.9) 7302.
7305     C LINEAR FOR (0.0 < COSBAR < 0.5) 7303.
7306     C ------------------------------- 7304.
7307     C 7305.
7308     GI=G*10.0 7306.
7309     IF(GI.GT.5.0) GO TO 110 7307.
7310     JG=1 7308.
7311     GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7309.
7312     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7310.
7313     GG=GG+GG 7311.
7314     GO TO 130 7312.
7315     C 7313.
7316     110 IG=GI 7314.
7317     WGJ=GI-IG 7315.
7318     WGI=1.0-WGJ 7316.
7319     IG=IG-4 7317.
7320     JG=IG+1 7318.
7321     IF(IG.GT.4) GO TO 120 7319.
7322     C 7320.
7323     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7321.
7324     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7322.
7325     + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7323.
7326     + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7324.
7327     GO TO 130 7325.
7328     C 7326.
7329     120 IG=5 7327.
7330     C 7328.
7331     GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7329.
7332     + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7330.
7333     + +WGJ 7331.
7334     C 7332.
7335     130 CONTINUE 7333.
7336     C 7334.
7337     RETURN 7335.
7338     END 7336.
  ViewVC Help
Powered by ViewVC 1.1.22