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

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

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

Revision 1.3 - (show 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 C $Header$
2 C $Name$
3
4 #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 #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 #if ( defined CLM )
209 #include "CLM.h"
210 #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 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 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 Cnext lines - use albedos from ice model
510 #if ( defined OCEAN_3D )
511 BOIVIS=mmsAlb(JLAT)
512 BOINIR=mmsAlbNIR(JLAT)
513 #endif
514 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 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 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 #include "CLM.h"
1825 #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