/[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.2 - (show annotations) (download)
Mon Apr 23 21:20:18 2007 UTC (18 years, 3 months ago) by jscott
Branch: MAIN
Changes since 1.1: +9 -8 lines 
bring igsm atmos code up to date
1 c source sokolov users 559243 Aug 15 2006 /home/sokolov/IGSM2/SRC/r95mit.F
2 #include "ctrparam.h"
3
4 ! ==========================================================
5 !
6 ! R95MIT.F: Model II radiation: 1958 Atmosphere and mean
7 ! strat aeros (.012) Zenith angle dependence
8 ! for aerosols not used.
9 !
10 ! ----------------------------------------------------------
11 !
12 ! Author of Chemistry Modules: Chien Wang
13 !
14 ! ----------------------------------------------------------
15 !
16 ! Important Note: Because the original components of chemistry
17 ! module in this file are used by some runs not using
18 ! interactive chemistry-climate model, therefore, the
19 ! cpp header CPL_CHEM is barely applied. Instead,
20 ! PREDICTED_GASES is appearing at related places.
21 !
22 ! Chien Wang
23 ! 080100
24 !
25 ! Revision History:
26 !
27 ! When Who What
28 ! ---- ---------- -------
29 ! 073100 Chien Wang repack based on CliChem3 & M24x11,
30 ! add cpp, and float -> dble
31 ! 093001 Chien Wang add bc & oc and rewrote aerosol/radiation
32 ! interface including S(VI)
33 ! 062604 Chien Wang merge with current igsm module
34 !
35 ! ==========================================================
36
37
38 C**** R83XX B83XX R83ZA 02/4/93 0.1
39 C**** OPT(3) 0.2
40 C**** 0.3
41 C**** Model II radiation: 1958 Atmosphere and mean strat aeros (.012) 0.4
42 C**** Zenith angle dependence for aerosols not used. 0.5
43 ***** R83ZA B83XX R83ZA 12/23/91 0.1
44 ***** OPT(3) 0.2
45 ***** 0.3
46 ***** Model II radiation with 1958 Atmosphere, mean strat aeros (.012). 0.4
47 ***** Aerosols: Zenith angle dependence and other changes implemented 0.5
48 C SUBROUTINE RCOMP1(NFTTTR,NFTTSR,NFTFOR) 1.
49 c 6/20/2005
50 SUBROUTINE RCOMP1(NFTTTR,NFTTSR,NFTFOR,KTREND)
51
52 #include "chem_para"
53 #include "chem_com"
54 #include "B83XX.COM" 1012.
55
56 c DOUBLE PRECISION PFOFTK,TKOFPF,WAVNA,WAVNB,TK,PFWI 64.
57 DATA WAVNA/850.0/,WAVNB/900.0/ 64.5
58 C 65.
59 NKSR=6 66.
60 C ----------------------------------------------------- 67.
61 C READ IN GAS TAU TABLE AND DISTRIBUTED PLANCK FUNCTION 68.
62 C ALSO THERMAL RAD AEROSOL, CLOUD & SURFACE ALBEDO DATA 69.
63 C 70.
64 C IF(NFTTTR.GE.1) TAU TABLE DATA ARE READ (UNIT=NFTTTR) 71.
65 C WINDOW FLUX B TEMP CONVERSION FACTORS 72.
66 C ARE ALSO COMPUTED AT THIS TIME 73.
67 C 74.
68 C IF(NFTTTR.LT.1) TAU TABLE DATA ARE NOT READ FROM DISK 75.
69 C WINDOW FLUX B TEMP CONVERSION FACTORS 76.
70 C ARE NOT COMPUTED 77.
71 C COMMON/RADCOM/PARAMETERS CAN BE RESET 78.
72 C MORE CONVENIENTLY 79.
73 C ----------------------------------------------------- 80.
74 C 81.
75 IF(NFTTTR.LT.1) GO TO 110 82.
76 C 83.
77 C$ REWIND NFTTTR 84.
78 C$ READ (NFTTTR) ITRHDR,TAUTBL,PLANCK,TRAQEX,TRAQSC,TRACOS 85.
79 C$ + ,TRCQEX,TRCQSC,TRCCOS,AOCEAN,AGSIDV,CLDALB 86.
80 C$ + ,TRACEG 87.
81 REWIND NFTTTR 88.
82 READ (NFTTTR) TAUTBL 89.
83 REWIND NFTTTR 89.5
84 C 90.
85 NFTTTP=NFTTTR+1 91.
86 REWIND NFTTTP 92.
87 READ (NFTTTP) PLANCK 93.
88 REWIND NFTTTP 93.5
89 C 94.
90 C 95.
91 C$ IF(NFTTSR.GT.1) REWIND NFTTSR 96.
92 C$ IF(NFTTSR.GT.1) READ (NFTTSR) ISRHDR,SRTBL 97.
93 C 98.
94 ID5(1)=8304 99.
95 ID5(2)=8106 100.
96 ID5(3)=8106 101.
97 C 102.
98 NKTR =25 103.
99 IT0 =123 104.
100 ITNEXT=250 105.
101 C 106.
102 C --------------------------------------------------------------- 107.
103 C DEFINE WINDOW FLUX TO BRIGHTNESS TEMPERATURE CONVERSION FACTORS 108.
104 C --------------------------------------------------------------- 109.
105 C 110.
106 DO 100 I=1,630 111.
107 PFWI=0.001*I 112.
108 IF(I.GT.100) PFWI=(0.1+0.01*(I-100)) 113.
109 IF(I.GT.190) PFWI=(1.0+0.10*(I-190)) 114.
110 100 TKPFW(I)=TKOFPF(WAVNA,WAVNB,PFWI) 115.
111 110 CONTINUE 116.
112 C --------------------------------------------------- 117.
113 C SET ALBEDO,GAS,AEROSOL DISTRIBUTIONS & COEFFICIENTS 118.
114 C ALSO CALLED ARE ALBDAY,O3DDAY,O3DLAT FOR JDAY,JLAT 119.
115 C-------------------------------------------------------------------- 120.
116 C 121.
117 IF(KFORCE.GT.0) CALL SETFOR(NFTFOR) 122.
118 IF(LASTVC.GE.0) CALL SETATM 123.
119 C **************** Print *******
120 c print *,' from RCOMP1'
121 c print *,'JMLAT=',JMLAT
122 c print *,'DLAT'
123 c print *,DLAT
124 C **************** Print *******
125 CALL SETALB 124.
126 c CALL SETGAS 125.
127 c 6/202005
128 ! print *,' Before CALL SETGAS'
129 CALL SETGAS(KTREND)
130 ! print *,' After CALL SETGAS'
131 CALL SETAER 126.
132
133 C----------------- 127.
134 RETURN 128.
135 C 129.
136 C----------------------------------------------------------------------- 130.
137 C RESET SEASON (JDAY) DEPENDENT QUANTITIES AS NEEDED 131.
138 ENTRY RCOMPT 132.
139 c print *,' from RCOMPT JDAY=',JDAY
140 c print *,'PPMV58 from RCOMPT'
141 c print *,PPMV58
142 C----------------------------------------------------------------------- 133.
143 C 134.
144 IF(KFORCE.GT.0) CALL GETFOR 135.
145 IF(LAPGAS.EQ.2) CALL SETLAP 136.
146 CALL ALBDAY 137.
147 CALL O3DDAY 138.
148
149 #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
150 C--Addition by CEForest (18Mar98)
151 call getforcedozone(jyear,jday)
152 C--End of Addition
153 #endif
154
155 RETURN 139.
156 C 140.
157 C----------------------------------------------------------------------- 141.
158 C RESET LATITUDE (JLAT) DEPENDENT QUANTITIES AS NEEDED 142.
159 ENTRY RCOMPJ 143.
160 C----------------------------------------------------------------------- 144.
161 CALL O3DLAT 145.
162 RETURN 146.
163 C 147.
164 C----------------------------------------------------------------------- 148.
165 C GET ALBEDO,GAS AEROSOL DATA THEN COMPUTE THERML/SOLAR 149.
166 ENTRY RCOMPX 150.
167 C----------------------------------------------------------------------- 151.
168 CALL GETALB 152.
169 CALL GETGAS 153.
170 CALL GETAER 154.
171 C -------------------------------------------- 155.
172 C SPECIFY SURFACE LAYER GAS ABSORPTION AMOUNTS 156.
173 C -------------------------------------------- 157.
174 DO 350 K=1,11 158.
175 TAUSL(K)=RATQSL*FRACSL*TAUN(1+K*NL-NL) 159.
176 350 TAUN(1+K*NL-NL)=TAUN(1+K*NL-NL)-TAUSL(K) 160.
177 DO 360 K=12,NKTR 161.
178 TAUSL(K)= FRACSL*TAUN(1+K*NL-NL) 162.
179 360 TAUN(1+K*NL-NL)=TAUN(1+K*NL-NL)-TAUSL(K) 163.
180 C----------------- 164.
181 CALL THERML 165.
182 C----------------- 166.
183 IF(KGASSR.GT.0) CALL SOLGAS 167.
184 C 168.
185 C$ ****************************COMMENTED OUT CARDS INTERPOLATE SOLAR TAU 169.
186 C$ DO 300 I=1,600 170.
187 C$300 SRTAU(I)=0. 171.
188 C$ CALL SRGAS (NL,PL,DPL,TLM,ULGAS,SRTAU,SRTBL,1,3) 172.
189 C---------------- 173.
190 CALL SOLAR 174.
191 C---------------- 175.
192 C 176.
193
194 RETURN 177.
195 END 178.
196 SUBROUTINE SETALB 179.
197 COMMON/ADDALB/BVSURFA,XVSURFA,BNSURFA,XNSURFA
198
199 #include "B83XX.COM" 180.
200 #include "chem_para"
201 #include "chem_com"
202 #if ( defined CLM )
203 #include "CLM.h"
204 #endif
205
206 DIMENSION ALVISK(11,4),ALNIRK(11,4),FIELDC(11,3),VTMASK(11) 241.
207 C$$ DIMENSION ALMEAN(11,4),RATIRV(11,4) 242.
208 C 243.
209 EQUIVALENCE 244.
210 + (VADATA(1,1,1),ALVISK(1,1)),(VADATA(1,1,2),ALNIRK(1,1)) 245.
211 +, (VADATA(1,1,3),FIELDC(1,1)),(VADATA(1,4,3),VTMASK(1)) 246.
212 C$$ + (VADATA(1,1,1),ALMEAN(1,1)),(VADATA(1,1,2),RATIRV(1,1)) 247.
213 C$$ +, (VADATA(1,1,3),VTMASK(1)),(VADATA(1,2,3),FIELDC(1,1)) 248.
214 C 249.
215 EQUIVALENCE 250.
216 + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 251.
217 +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 252.
218 +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 253.
219 +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 254.
220 +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 255.
221 +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 256.
222 C 257.
223 EQUIVALENCE 258.
224 + (BXA(1),BOCVIS),(BXA(5),BEAVIS),(BXA( 9),BOIVIS),(BXA(13),BLIVIS) 259.
225 +,(BXA(2),BOCNIR),(BXA(6),BEANIR),(BXA(10),BOINIR),(BXA(14),BLINIR) 260.
226 +,(BXA(3),XOCVIS),(BXA(7),XEAVIS),(BXA(11),XOIVIS),(BXA(15),XLIVIS) 261.
227 +,(BXA(4),XOCNIR),(BXA(8),XEANIR),(BXA(12),XOINIR),(BXA(16),XLINIR) 262.
228 C 263.
229 +, (BXA(17),EXPSNE),(BXA(18),EXPSNO),(BXA(19),EXPSNL) 264.
230 C 265.
231 +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 266.
232 +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 267.
233 C 268.
234 EQUIVALENCE (ASNALB(1),ASNVIS),(ASNALB(2),ASNNIR) 269.
235 EQUIVALENCE (AOIALB(1),AOIVIS),(AOIALB(2),AOINIR) 270.
236 EQUIVALENCE (ALIALB(1),ALIVIS),(ALIALB(2),ALINIR) 271.
237 DIMENSION SRBALB(6),SRXALB(6) 272.
238 C 273.
239 EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 274.
240 C 275.
241 C 1 2 3 4 276.
242 C WINTER SPRING SUMMER AUTUMN 277.
243 REAL SEASON(4)/ 15.00, 105.0, 196.0, 288.0/ 278.
244 C 279.
245 C----------------------------------------------------------------------- 280.
246 C SOLAR: OCEAN ALBEDO DEPENDENCE ON ZENITH ANGLE & WIND SPEED 281.
247 C 282.
248 BVH2O(WMAG)=.0488+.0974/(5.679+WMAG)+.0004/(.3333+WMAG) 283.
249 XVH2O(WMAG,X)=.021+X*X*(.0421+X*(.1283+X*(-.04+X*(3.117/ 284.
250 + (5.679+WMAG)+X*.025/(.3333+WMAG))))) 285.
251 C----------------------------------------------------------------------- 286.
252 C 287.
253 data IFFF0 /1/
254 data ICLM /1/
255 C **************** Print *******
256 cprint *,' from SETALB'
257 cprint *,'DLAT'
258 cprint *,DLAT
259 cprint *,'VTMASK'
260 cprint *,VTMASK
261 cprint *,'FIELDC'
262 cprint *,FIELDC
263 C **************** Print *******
264 JNORTH=JMLAT/2+1 288.
265 VISNIR=MEANAL 289.
266 C 290.
267 C**** FOR OLD ALBEDO FILES COMPUTE VISUAL AND NEAR-IR ALBEDOS 290.8
268 c print *,' SETALB NV=',NV
269 c print *,' ALVISK=',ALVISK
270 c print *,' ALNIRK=',ALNIRK
271 IF (VADATA(4,2,3).GT.100.) GO TO 101 290.9
272 DO 100 L=1,4 291.
273 DO 100 K=1,8 292.
274 ALMEAN=ALVISK(K,L) 292.1
275 RATIRV=ALNIRK(K,L) 292.2
276 ALVISK(K,L)=ALMEAN/(0.6+0.4*RATIRV) 293.
277 100 ALNIRK(K,L)=ALMEAN/(0.4+0.6/RATIRV) 294.
278 101 CONTINUE 294.1
279 C 295.
280 C----------------------------------------------------------------------- 296.
281 C DEFINE SEASONAL ALBEDO (ALVISD,ALNIRD) FOR VEG TYPES 297.
282 ENTRY ALBDAY 298.
283 C----------------------------------------------------------------------- 299.
284 C 300.
285 XJDAY=JDAY 301.
286 c print *,'from ALBDAY XJDAY=',XJDAY
287 SEASN1=-77.0 302.
288 DO 110 K=1,4 303.
289 SEASN2=SEASON(K) 304.
290 IF(XJDAY.LE.SEASN2) GO TO 120 305.
291 110 SEASN1=SEASN2 306.
292 K=1 307.
293 SEASN2=380.0 308.
294 120 WT2=(XJDAY-SEASN1)/(SEASN2-SEASN1) 309.
295 WT1=1.-WT2 310.
296 KS1=1+MOD(K,4) 311.
297 KS2=1+MOD(K+1,4) 312.
298 KN1=1+MOD(K+2,4) 313.
299 KN2=K 314.
300 DO 130 K=1,NV 315.
301 C------------------------ 316.
302 C SOUTHERN HEMISPHERE 317.
303 C------------------------ 318.
304 ALVISD(K )=WT1*ALVISK(K,KS1)+WT2*ALVISK(K,KS2) 319.
305 ALNIRD(K )=WT1*ALNIRK(K,KS1)+WT2*ALNIRK(K,KS2) 320.
306 C------------------------ 321.
307 C NORTHERN HEMISPHERE 322.
308 C------------------------ 323.
309 ALVISD(K+NV)=WT1*ALVISK(K,KN1)+WT2*ALVISK(K,KN2) 324.
310 130 ALNIRD(K+NV)=WT1*ALNIRK(K,KN1)+WT2*ALNIRK(K,KN2) 325.
311 c print *,' ALVISK=',ALVISK
312 c print *,' ALNIRK=',ALNIRK
313 c print *,' ALVISD=',ALVISD
314 c print *,' ALNIRD=',ALNIRD
315 RETURN 326.
316 C 327.
317 C----------------------------------------------------------------------- 328.
318 C ALBEDO,THERMAL FLUX,FLUX DERIVATIVE FOR EACH SURF TYPE 329.
319 ENTRY GETALB 330.
320 C----------------------------------------------------------------------- 331.
321 C 332.
322 LATHEM=NV 333.
323 IF(JLAT.LT.JNORTH) LATHEM=0 334.
324 c print *,'From GETALB JLAT=',JLAT
325 c print *,POCEAN,PEARTH,POICE,PLICE
326 C 335.
327 C ------------------------- 336.
328 C SNOW ALBEDO SPECIFICATION 337.
329 C ------------------------- 338.
330 Ccc ASNAGE=0.35*EXP(-0.2*AGESN) 339.
331 if(IFFF0.eq.1)then
332 print *,' FRSNALB=',FRSNALB
333 print *,' ASNALB(1)=',ASNALB(1),' ASNALB(2)=',ASNALB(2)
334 print *,' AOIALB(1)=',AOIALB(1),' AOIALB(2)=',AOIALB(2)
335 print *,' ALIALB(1)=',ALIALB(1),' ALIALB(2)=',ALIALB(2)
336 IFFF0=0
337 endif
338 ASNAGE=FRSNALB*EXP(-0.2*AGESN)
339 BSNVIS=ASNVIS+ASNAGE 340.
340 BSNNIR=ASNNIR+ASNAGE 341.
341 XSNVIS=BSNVIS 342.
342 XSNNIR=BSNNIR 343.
343 C 344.
344 EXPSNE=1. 345.
345 EXPSNO=1. 346.
346 EXPSNL=1. 347.
347 C 348.
348 DO 200 I=1,16 349.
349 200 BXA(I)=0. 350.
350 C 351.
351 DO 210 K=1,NKTR 352.
352 TRGALB(K)=0. 353.
353 BGFEMD(K)=0. 354.
354 210 BGFEMT(K)=0. 355.
355 C 356.
356 BOCSUM=0. 357.
357 BEASUM=0. 358.
358 BOISUM=0. 359.
359 BLISUM=0. 360.
360 C 361.
361 DO 220 K=1,4 362.
362 220 DTRUFG(K)=0. 363.
363 C 364.
364 C -------------------------- 365.
365 C OCEAN ALBEDO SPECIFICATION 366.
366 C -------------------------- 367.
367 IF(POCEAN.LT.1.E-04) GO TO 400 368.
368 X=0.5+(0.5-COSZ)*ZOCSRA 369.
369 BOCVIS=BVH2O(WMAG) 370.
370 XOCVIS=XVH2O(WMAG,X) 371.
371 BOCNIR=BOCVIS 372.
372 XOCNIR=XOCVIS 373.
373 C 374.
374 X=1./(1.+WMAG) 375.
375 AV=(-.0147087*X*X+.0292266*X-.0081079)*EOCTRA 376.
376 BV=(1.01673-0.0083652*WMAG)*EOCTRA 377.
377 C 378.
378 ITOC=TGO 379.
379 WTOC=TGO-ITOC 380.
380 ITOC=ITOC-IT0 381.
381 BOCSUM=0. 382.
382 BOCM=0. 383.
383 BOCP=0. 384.
384 C 385.
385 DO 310 K=1,NKTR 386.
386 TRAPOC=AV+BV*AOCEAN(K) 387.
387 BOCM1 =(PLANCK(ITOC-1)-(PLANCK(ITOC-1)-PLANCK(ITOC ))*WTOC) 388.
388 + *(1.-TRAPOC) 389.
389 BOCM =BOCM+BOCM1 390.
390 BOCP1 =(PLANCK(ITOC+1)-(PLANCK(ITOC+1)-PLANCK(ITOC+2))*WTOC) 391.
391 + *(1.-TRAPOC) 392.
392 BOCP =BOCP+BOCP1 393.
393 BOC =(PLANCK(ITOC )-(PLANCK(ITOC )-PLANCK(ITOC+1))*WTOC) 394.
394 + *(1.-TRAPOC) 395.
395 BOCSUM=BOCSUM+BOC 396.
396 ITOC=ITOC+ITNEXT 397.
397 C 398.
398 TRGALB(K)=TRGALB(K)+POCEAN*TRAPOC 399.
399 BGFEMD(K)=BGFEMD(K)+POCEAN*(BOCP1-BOCM1) 400.
400 310 BGFEMT(K)=BGFEMT(K)+POCEAN*BOC 401.
401 DTRUFG(1)=0.5*(BOCP-BOCM) 402.
402 C ----------------------------- 403.
403 C SOIL/VEG ALBEDO SPECIFICATION 404.
404 C ----------------------------- 405.
405 400 DSFRAC=PVT(1) 406.
406 VGFRAC=1.-DSFRAC 407.
407 IF(PEARTH.LT.1.E-04) GO TO 500 408.
408 IF(SNOWE .GT.1.E-04) GO TO 420 409.
409 C 410.
410 BEAVIS=PVT(1)*ALVISD(1+LATHEM)*(1.0-0.5*WEARTH*WETSRA) 411.
411 BEANIR=PVT(1)*ALNIRD(1+LATHEM)*(1.0-0.5*WEARTH*WETSRA) 412.
412 DO 410 K=2,NV 413.
413 BEAVIS=BEAVIS+PVT(K)*ALVISD(K+LATHEM) 414.
414 410 BEANIR=BEANIR+PVT(K)*ALNIRD(K+LATHEM) 415.
415 GO TO 440 416.
416 420 VTFRAC=PVT(1)*EXP(-SNOWE/VTMASK(1)) 417.
417 EXPSNE=VTFRAC 418.
418 DSFRAC=VTFRAC 419.
419 C$ BEAVIS=VTFRAC*ALVISD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 420.
420 BEAVIS=PVT(1)*ALVISD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 421.
421 + *(1.-VTFRAC) 422.
422 C$ BEANIR=VTFRAC*ALNIRD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 423.
423 BEANIR=PVT(1)*ALNIRD(1+LATHEM)*(1.-0.5*WEARTH*WETSRA) 424.
424 + *(1.-VTFRAC) 425.
425 DO 430 K=2,NV 426.
426 VTFRAC=PVT(K)*EXP(-SNOWE/VTMASK(K)) 427.
427 BEAVIS=BEAVIS+PVT(K)*ALVISD(K+LATHEM)*(1.-VTFRAC) 428.
428 C$ BEAVIS=BEAVIS+VTFRAC*ALVISD(K+LATHEM) *******************CORRECT 429.
429 BEANIR=BEANIR+PVT(K)*ALNIRD(K+LATHEM)*(1.-VTFRAC) 430.
430 C$ BEANIR=BEANIR+VTFRAC*ALNIRD(K+LATHEM) *******************CORRECT 431.
431 430 EXPSNE=EXPSNE+VTFRAC 432.
432 C 433.
433 440 XEAVIS=BEAVIS 434.
434 XEANIR=BEANIR 435.
435 C$ BEAVIS=BEAVIS+BSNVIS*(1.-EXPSNE) 436.
436 C$ BEANIR=BEANIR+BSNNIR*(1.-EXPSNE) 437.
437 C$ XEAVIS=XEAVIS+XSNVIS*(1.-EXPSNE) 438.
438 C$ XEANIR=XEANIR+XSNNIR*(1.-EXPSNE) 439.
439 BEAVIS=BEAVIS*EXPSNE+BSNVIS*(1.-EXPSNE) 440.
440 BEANIR=BEANIR*EXPSNE+BSNNIR*(1.-EXPSNE) 441.
441 XEAVIS=XEAVIS*EXPSNE+XSNVIS*(1.-EXPSNE) 442.
442 XEANIR=XEANIR*EXPSNE+XSNNIR*(1.-EXPSNE) 443.
443 VGFRAC=EXPSNE-DSFRAC 444.
444
445 #if ( defined CLM )
446 c if(ncallclm.ge.1)then
447 i=1
448 BEAVIS=0.7*asdirclm(i,JLAT)+0.3*asdifclm(i,JLAT)
449 BEANIR=0.7*aldirclm(i,JLAT)+0.3*aldifclm(i,JLAT)
450 XEAVIS=BEAVIS
451 XEANIR=BEANIR
452 c endif
453 c if(ncallclm.eq.0)then
454 c print *,JLAT,BEAVIS,BEANIR
455 c endif
456 #endif
457
458 C 445.
459 ITEA=TGE 446.
460 WTEA=TGE-ITEA 447.
461 ITEA=ITEA-IT0 448.
462 BEASUM=0. 449.
463 BEAM=0. 450.
464 BEAP=0. 451.
465 C 452.
466 C 467.
467 DO 450 K=1,NKTR 453.
468 TRAPEA=AGSIDV(K,1)*(1.-EXPSNE) 454.
469 + +AGSIDV(K,3)*DSFRAC*(1.-WETTRA*WEARTH) 455.
470 + +AGSIDV(K,4)*VGFRAC 456.
471 BEAM1 =(PLANCK(ITEA-1)-(PLANCK(ITEA-1)-PLANCK(ITEA ))*WTEA) 457.
472 + *(1.-TRAPEA) 458.
473 BEAM =BEAM+BEAM1 459.
474 BEAP1 =(PLANCK(ITEA+1)-(PLANCK(ITEA+1)-PLANCK(ITEA+2))*WTEA) 460.
475 + *(1.-TRAPEA) 461.
476 BEAP =BEAP+BEAP1 462.
477 BEA =(PLANCK(ITEA )-(PLANCK(ITEA )-PLANCK(ITEA+1))*WTEA) 463.
478 + *(1.-TRAPEA) 464.
479 BEASUM=BEASUM+BEA 465.
480 ITEA=ITEA+ITNEXT 466.
481 TRGALB(K)=TRGALB(K)+PEARTH*TRAPEA 468.
482 BGFEMD(K)=BGFEMD(K)+PEARTH*(BEAP1-BEAM1) 469.
483 450 BGFEMT(K)=BGFEMT(K)+PEARTH*BEA 470.
484 DTRUFG(2)=0.5*(BEAP-BEAM) 471.
485 if(ncallclm.eq.-1)then
486 print *,'471 JLAT=',JLAT
487 print *,(ITEA-1),(ITEA),(ITEA+1)
488 print *,PLANCK(ITEA-1),PLANCK(ITEA),PLANCK(ITEA+1)
489 print *,' VGFRAC=',VGFRAC,' DSFRAC=',DSFRAC
490 print *,' WTEA=',WTEA,' WEARTH=',WEARTH
491 print *,' SNOWE=',SNOWE,' EXPSNE=',EXPSNE
492 c print *,JLAT,' BEAVIS=',BEAVIS,' BEANIR=',BEANIR
493 endif
494 C 472.
495 C ------------------------------ 473.
496 C OCEAN ICE ALBEDO SPECIFICATION 474.
497 C ------------------------------ 475.
498 500 CONTINUE 476.
499 IF(POICE.LT.1.E-04) GO TO 600 477.
500 EXPSNO=EXP(-SNOWOI/DMOICE) 478.
501 BOIVIS=AOIVIS*EXPSNO+BSNVIS*(1.-EXPSNO) 479.
502 BOINIR=AOINIR*EXPSNO+BSNNIR*(1.-EXPSNO) 480.
503 XOIVIS=BOIVIS 481.
504 XOINIR=BOINIR 482.
505 C 483.
506 ITOI=TGOI 484.
507 WTOI=TGOI-ITOI 485.
508 ITOI=ITOI-IT0 486.
509 BOISUM=0. 487.
510 BOIM=0. 488.
511 BOIP=0. 489.
512 C 490.
513 DO 510 K=1,NKTR 491.
514 TRAPOI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNO) 492.
515 + +AGSIDV(K,2)*EICTRA*EXPSNO 493.
516 BOIM1 =(PLANCK(ITOI-1)-(PLANCK(ITOI-1)-PLANCK(ITOI ))*WTOI) 494.
517 + *(1.-TRAPOI) 495.
518 BOIM =BOIM+BOIM1 496.
519 BOIP1 =(PLANCK(ITOI+1)-(PLANCK(ITOI+1)-PLANCK(ITOI+2))*WTOI) 497.
520 + *(1.-TRAPOI) 498.
521 BOIP =BOIP+BOIP1 499.
522 BOI =(PLANCK(ITOI )-(PLANCK(ITOI )-PLANCK(ITOI+1))*WTOI) 500.
523 + *(1.-TRAPOI) 501.
524 BOISUM=BOISUM+BOI 502.
525 ITOI=ITOI+ITNEXT 503.
526 C 504.
527 TRGALB(K)=TRGALB(K)+POICE*TRAPOI 505.
528 BGFEMD(K)=BGFEMD(K)+POICE*(BOIP1-BOIM1) 506.
529 510 BGFEMT(K)=BGFEMT(K)+POICE*BOI 507.
530 DTRUFG(3)=0.5*(BOIP-BOIM) 508.
531 C 509.
532 C ----------------------------- 510.
533 C LAND ICE ALBEDO SPECIFICATION 511.
534 C ----------------------------- 512.
535 600 CONTINUE 513.
536 IF(PLICE.LT.1.E-04) GO TO 700 514.
537 EXPSNL=EXP(-SNOWLI/DMLICE) 515.
538 BLIVIS=ALIVIS*EXPSNL+BSNVIS*(1.-EXPSNL) 516.
539 BLINIR=ALINIR*EXPSNL+BSNNIR*(1.-EXPSNL) 517.
540
541 #if ( defined CLM )
542 c if(ncallclm.ge.1)then
543 i=1
544 BLIVIS=0.7*asdirclm(i,JLAT)+0.3*asdifclm(i,JLAT)
545 BLINIR=0.7*aldirclm(i,JLAT)+0.3*aldifclm(i,JLAT)
546 c endif
547 #endif
548
549 XLIVIS=BLIVIS 518.
550 XLINIR=BLINIR 519.
551 C 520.
552 ITLI=TGLI 521.
553 WTLI=TGLI-ITLI 522.
554 ITLI=ITLI-IT0 523.
555 C 524.
556 BLISUM=0. 525.
557 BLIM=0. 526.
558 BLIP=0. 527.
559 BGF=0. 528.
560 C 529.
561 DO 610 K=1,NKTR 530.
562 TRAPLI=AGSIDV(K,1)*ESNTRA*(1.-EXPSNL) 531.
563 + +AGSIDV(K,2)*EICTRA*EXPSNL 532.
564 BLIM1 =(PLANCK(ITLI-1)-(PLANCK(ITLI-1)-PLANCK(ITLI ))*WTLI) 533.
565 + *(1.-TRAPLI) 534.
566 BLIM =BLIM+BLIM1 535.
567 BLIP1 =(PLANCK(ITLI+1)-(PLANCK(ITLI+1)-PLANCK(ITLI+2))*WTLI) 536.
568 + *(1.-TRAPLI) 537.
569 BLIP =BLIP+BLIP1 538.
570 BLI =(PLANCK(ITLI )-(PLANCK(ITLI )-PLANCK(ITLI+1))*WTLI) 539.
571 + *(1.-TRAPLI) 540.
572 BLISUM=BLISUM+BLI 541.
573 ITLI=ITLI+ITNEXT 542.
574 C 543.
575 TRGALB(K)=TRGALB(K)+PLICE*TRAPLI 544.
576 BGFEMD(K)=BGFEMD(K)+PLICE*(BLIP1-BLIM1) 545.
577 610 BGFEMT(K)=BGFEMT(K)+PLICE*BLI 546.
578 DTRUFG(4)=0.5*(BLIP-BLIM) 547.
579 C 548.
580 700 CONTINUE 549.
581 BVSURF=POCEAN*BOCVIS +PEARTH*BEAVIS +POICE*BOIVIS +PLICE*BLIVIS 550.
582 XVSURF=POCEAN*XOCVIS +PEARTH*XEAVIS +POICE*XOIVIS +PLICE*XLIVIS 551.
583 BNSURF=POCEAN*BOCNIR +PEARTH*BEANIR +POICE*BOINIR +PLICE*BLINIR 552.
584 XNSURF=POCEAN*XOCNIR +PEARTH*XEANIR +POICE*XOINIR +PLICE*XLINIR 553.
585
586 #if ( !defined CPL_CHEM ) && ( (defined SVI_ALBEDO || defined GHS_ALB) )
587 IF(COSZ.GE.0.01) then
588 XALBEDO=0.6*XVSURF+0.4*XNSURF
589 SECZ=1./COSZ
590 if(JLAT.le.-2)then
591 print *,' JLAT=',JLAT
592 print *,' COSZ=',COSZ
593 print*,POCEAN,PEARTH,POICE,PLICE
594 print *,' XALBEDO=',XALBEDO
595 print *,BVSURF,XVSURF,BNSURF,XNSURF
596 endif
597 BVSURF=BVSURF+BVSURFA*(1.-XALBEDO)**2*SECZ
598 XVSURF=XVSURF+XVSURFA*(1.-XALBEDO)**2*SECZ
599 BNSURF=BNSURF+BNSURFA*(1.-XALBEDO)**2*SECZ
600 XNSURF=XNSURF+XNSURFA*(1.-XALBEDO)**2*SECZ
601 if(JLAT.eq.-10)then
602 print *,' After add'
603 print *,'BVSURFA=',BVSURFA
604 print *,'DAsrf=',BVSURFA*(1.-XALBEDO)**2*SECZ
605 print *,BVSURF,XVSURF,BNSURF,XNSURF
606 endif
607 endif
608 #endif
609
610 C ---------------------------------------------------------------- 554.
611 C SPECTRAL DISTRIBUTION ASSUMES THAT: AMEAN = 0.6*AVIS + 0.4*ANIR 555.
612 C ---------------------------------------------------------------- 556.
613 C 557.
614 IF(KEEPAL.EQ.1) GO TO 800 558.
615 SRBALB(6)=BVSURF+0.4*VISNIR*(BNSURF-BVSURF) 559.
616 SRXALB(6)=XVSURF+0.4*VISNIR*(XNSURF-XVSURF) 560.
617 DO 710 I=1,5 561.
618 SRBALB(I)=BNSURF-0.6*VISNIR*(BNSURF-BVSURF) 562.
619 710 SRXALB(I)=XNSURF-0.6*VISNIR*(XNSURF-XVSURF) 563.
620 IF(KALVIS.EQ.0) GO TO 800 564.
621 SRBALB(4)=SRBALB(6) 565.
622 SRXALB(4)=SRXALB(6) 566.
623 C 567.
624 C-------------------------------------------------------------------- 568.
625 C DEFINE SURFACE FLUX FACTORS, FLUX DERIVATIVES FOR EACH SURFTYPE 569.
626 C-------------------------------------------------------------------- 570.
627 800 BGF=0. 571.
628 DO 810 K=1,NKTR 572.
629 BGFEMD(K)=BGFEMD(K)*0.5 573.
630 810 BGF=BGF+BGFEMT(K) 574.
631 C 575.
632 BGM=BOCM*POCEAN+BEAM*PEARTH+BOIM*POICE+BLIM*PLICE 576.
633 BGP=BOCP*POCEAN+BEAP*PEARTH+BOIP*POICE+BLIP*PLICE 577.
634 TTRUFG=0.5*(BGP-BGM) 578.
635 C 579.
636 FTRUFG(1)=BOCSUM/BGF 580.
637 FTRUFG(2)=BEASUM/BGF 581.
638 FTRUFG(3)=BOISUM/BGF 582.
639 FTRUFG(4)=BLISUM/BGF 583.
640 C 584.
641 RETURN 585.
642 END 586.
643 c SUBROUTINE SETGAS 587.
644 c 20/06/2005
645 SUBROUTINE SETGAS(KTREND)
646
647 #include "B83XX.COM" 588.
648 #include "chem_para"
649 #include "chem_com"
650
651 EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 649.
652 EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 650.
653 C 651.
654 C 652.
655 C---------------------------------------------------------------------- 653.
656 C GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS 654.
657 C---------------------------------------------------------------------- 655.
658 C 656.
659 COMMON/O3GLOB/ PLB0(40),TLM0(40),U0GAS3(40) 656.11
660 DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 657.
661 DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 658.
662 + ,3.7338E-03/ 659.
663 DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/ 660.
664 DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 661.
665 DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 662.
666 DATA HPCON/34.16319/ 663.
667 DATA PI/3.1415926/ 664.
668 DATA P0/1013.25/ 665.
669 C 666.
670 DIMENSION KGAS(9,3) 667.
671 DATA KGAS/ 1, 2, 3, 0, 0, 9, 11, 12, 13 668.
672 + , 4, 6, 8, 0, 0,10, 0, 0, 0 669.
673 + , 5, 7, 0, 0, 0, 0, 0, 0, 0/ 670.
674 C 671.
675 C ----------------------------------------------------- 672.
676 C USE PLB TO FIX STANDARD HEIGHTS FOR GAS DISTRIBUTIONS 673.
677 C ----------------------------------------------------- 674.
678 C 675.
679 c print *,'FROM SETGAS PREDICTED_GASES=',PREDICTED_GASES
680 c 6/20/2005
681 if(KTREND.le.0)then
682 C assign background GHGs
683 PPMV58(2)=GHGBGR(1) ! CO2
684 PPMV58(6)=GHGBGR(2) ! N2O
685 PPMV58(7)=GHGBGR(3) ! CH4
686 PPMV58(8)=GHGBGR(4) ! F11
687 PPMV58(9)=GHGBGR(5) ! F12
688 endif
689 print *,'PPMV58 from SETGAS'
690 print *,PPMV58
691 NLP=NL+1 676.
692 NLMOD=NLP-LAYRAD 677.
693 PS0=PLB(1) 678.
694 PTOP=PLB(NLP-LAYRAD) 679.
695 C 680.
696 DO 100 L=1,NL 681.
697 DPL(L)=PLB(L)-PLB(L+1) 682.
698 100 PL(L)=(PLB(L)+PLB(L+1))*0.5 683.
699 NLNKTR=NL*NKTR 684.
700 C 685.
701 IF(LASTVC.GE.0) GO TO 107 686.
702 C 687.
703 DO 105 L=1,NL 688.
704 P=PLB(L) 689.
705 DO 101 N=2,8 690.
706 IF(P.GT.SPLB(N)) GO TO 102 691.
707 101 CONTINUE 691.5
708 N=9 692.
709 102 N=N-1 693.
710 IF(ABS(SDLB(N)).LT.1.E-04) GO TO 103 694.
711 H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 695.
712 GO TO 104 696.
713 C ALOG
714 103 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 697.
715 C ALOG
716 104 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 698.
717 TLB(L)=T 699.
718 105 HLB(L)=H 700.
719 ! print *,' After 105'
720 HLB(1)=1.E-10 701.
721 HLB(NL+1)=99.99 702.
722 TLB(NL+1)=STLB(8) 703.
723 DO 106 L=1,NL 704.
724 TLT(L)=TLB(L+1) 705.
725 106 TLM(L)=0.5*(TLB(L)+TLT(L)) 706.
726 TLB(NL+1)=TLT(NL) 707.
727 C 708.
728 107 NLAY=LASTVC/100000 709.
729 NATM=(LASTVC-NLAY*100000)/10000 710.
730 IF(NATM.GT.0) GO TO 112 711.
731 C 712.
732 C--------------------------------------------------------------------- 713.
733 C DEFINE GLOBAL MEAN GAS AMOUNTS FOR TRACEGAS & OVERLAP ABSORPTION 714.
734 C--------------------------------------------------------------------- 715.
735 C 716.
736 C ---------------------------- 717.
737 C GLOBAL MEAN H2O DISTRIBUTION 718.
738 C ---------------------------- 719.
739 RHP=0.77 720.
740 EST=10.0**(9.4051-2353.0/TLB(1)) 721.
741 FWB=0.662*RHP*EST/(PLB(1)-RHP*EST) 722.
742 DO 111 L=1,NL 723.
743 PLT=PLB(L+1) 724.
744 DP=PLB(L)-PLT 725.
745 RHP=0.77*(PLT/P0-0.02)/.98 726.
746 EST=10.0**(9.4051-2353.0/TLT(L)) 727.
747 FWT=0.662*RHP*EST/(PLT-RHP*EST) 728.
748 IF(FWT.GT.3.E-06) GO TO 110 729.
749 FWT=3.E-06 730.
750 RHP=FWT*PLT/(EST*(FWT+0.662)) 731.
751 110 ULGASL=0.5*(FWB+FWT)*DP*1270. 732.
752 C$110 ULGASL=0.5*(FWB+FWT)*DP*1268.75 733.
753 U0GAS(L,1)=ULGASL 734.
754 SHL(L)=ULGASL/(ULGASL+1268.75*DP) 735.
755 EQ=0.5*(PLB(L)+PLT)*SHL(L)/(0.662+0.378*SHL(L)) 736.
756 ES=10.**(9.4051-2353./TLM(L)) 737.
757 RHL(L)=EQ/ES 738.
758 111 FWB=FWT 739.
759 112 CONTINUE 740.
760 C ---------------------------- 741.
761 C GLOBAL MEAN O3 DISTRIBUTION 742.
762 C---------------- ---------------------------- 743.
763 ! print *,' Before SETO3D'
764 CALL SETO3D 744.
765 ! print *,' After SETO3D'
766 C---------------- 745.
767 JJLAT=JLAT 746.
768 C IF(JDAY.LT.1) KEEP SETATM O3 DISTRIBUTION 747.
769 C ------------------------------------------ 748.
770 IF(JDAY.LT.1) GO TO 125 749.
771 C---------------- 750.
772 ! print *,' Before O3DDAY'
773 CALL O3DDAY 751.
774 ! print *,' After O3DDAY'
775 C---------------- 752.
776 C 753.
777 DO 120 J=1,JMLAT 754.
778 RADLAT=PI*DLAT(J)/180. 755.
779 120 COSLAT(J)=0.5+0.5*SIN(RADLAT) 756.
780 C 757.
781 DO 121 N=1,NL 758.
782 121 UO3L(N)=0. 759.
783 DO 123 JLAT=1,JMLAT 760.
784 C---------------- 761.
785 ! print *,' Before O3DLAT'
786 CALL O3DLAT 762.
787 ! print *,' After O3DLAT'
788 C---------------- 763.
789 JB=JLAT+1 764.
790 JA=JLAT-1 765.
791 IF(JB.GT.JMLAT) JB=JMLAT 766.
792 IF(JA.LT.1 ) JA=1 767.
793 WTLAT=0.5*(COSLAT(JB)-COSLAT(JA)) 768.
794 DO 122 N=1,NL 769.
795 122 UO3L(N)=UO3L(N)+U0GAS(N,3)*WTLAT 770.
796 123 CONTINUE 771.
797 DO 124 N=1,NL 772.
798 124 U0GAS(N,3)=UO3L(N) 773.
799 125 JLAT=JJLAT 774.
800 ! print *,' After 774'
801 XXXX=SETAO3(OCM) 775.
802 ! print *,' After 775'
803 C 775.11
804 C SAVE GLOBAL MEAN P,T,O3 FOR UPDATING LAPGAS TAU TABLE IN SETLAP 775.12
805 C --------------------------------------------------------------- 775.13
806 C 775.14
807 DO 126 N=1,NL 775.15
808 PLB0(N)=PLB(N) 775.16
809 TLM0(N)=TLM(N) 775.17
810 126 U0GAS3(N)=U0GAS(N,3) 775.18
811 PLB0(NLP)=PLB(NLP) 775.19
812 C ---------------------------- 776.
813 C GLOBAL MEAN NO2 DISTRIBUTION 777.
814 C ---------------------------- 778.
815 ! print *,' After 778'
816 ACM=0.0 779.
817 HI=0.0 780.
818 FI=CMANO2(1) 781.
819 HL=HLB(2) 782.
820 L=1 783.
821 J=1 784.
822 130 J=J+1 785.
823 IF(J.GT.42) GO TO 133 786.
824 HJ=HI+2.0 787.
825 FJ=CMANO2(J) 788.
826 131 DH=HJ-HI 789.
827 IF(HJ.GT.HL) GO TO 132 790.
828 ACM=ACM+(FI+FJ)*DH*0.5 791.
829 HI=HJ 792.
830 FI=FJ 793.
831 GO TO 130 794.
832 132 FF=FI+(FJ-FI)*(HL-HI)/DH 795.
833 DH=HL-HI 796.
834 ACM=ACM+(FI+FJ)*DH*0.5 797.
835 U0GAS(L,5)=ACM 798.
836 ACM=0.0 799.
837 HI=HL 800.
838 FI=FF 801.
839 IF(L.EQ.NL) GO TO 133 802.
840 L=L+1 803.
841 HL=HLB(L+1) 804.
842 GO TO 131 805.
843 133 U0GAS(L,5)=ACM 806.
844 ACM=0.0 807.
845 L=L+1 808.
846 IF(L.LT.NLP) GO TO 133 809.
847 ! print *,' After 809'
848 C ----------------------------------------- 810.
849 C (CO2,O2) UNIFORMLY MIXED GAS DISTRIBUTION 811.
850 C ----------------------------------------- 812.
851 DO 141 K=2,4,2 813.
852 DO 140 N=1,NL 814.
853 140 U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 815.
854 141 CONTINUE 816.
855 C PRINT
856 print *,' CO2',PPMV58(2)
857 c print *,'NLMOD=',NLMOD
858 c print *,'PSIG'
859 c print *,(PSIG(L),L=1,NLMOD+1)
860 c print *,'PLB'
861 c print *,(PLB(L),L=1,NLMOD+1)
862 c print *,(U0GAS(n,2),n=1,nl)
863 C PRINT
864 C ----------------------------------------------------- 817.
865 C (N20,CH4,F11,F12) SPECIFIED VERTICAL GAS DISTRIBUTION 818.
866 C ----------------------------------------------------- 819.
867 DO 151 K=6,9 820.
868 DO 150 N=1,NL 821.
869 U0GAS(N,K)=PPMV58(K)*0.8*DPL(N)/P0 822.
870 ZT=(HLB(N+1)-Z0(K))/ZH(K) 823.
871 IF(ZT.LE.0.) GO TO 150 824.
872 ZB=(HLB(N)-Z0(K))/ZH(K) 825.
873 EXPZT=EXP(-ZT) 826.
874 EXPZB=EXP(-ZB) 827.
875 IF(ZB.LT.0.) EXPZB=1.-ZB 828.
876 U0GAS(N,K)=U0GAS(N,K)*(EXPZB-EXPZT)/(ZT-ZB) 829.
877 150 CONTINUE 830.
878 151 CONTINUE 831.
879 C ------------------------------------------------ 832.
880 C SPECIFIED GAS AMOUNTS (INCLUDING SCALING FACTOR) 833.
881 C ------------------------------------------------ 834.
882 C 835.
883 DO 161 K=1,9 836.
884 DO 160 N=1,NL 837.
885 160 ULGAS(N,K)=U0GAS(N,K)*FULGAS(K) 838.
886 161 CONTINUE 839.
887 C PRINT
888 ! print *,' after 161'
889 ! print *,(ULGAS(n,2),n=1,nl)
890 C PRINT
891 C 840.
892 C------------------------------- 841.
893 CALL SETAO2(ULGAS(1,4),NL) 842.
894 C------------------------------- 843.
895 C 844.
896 C -------------------------------------------------------------- 845.
897 C OVERLAP ABSORPTION (ILGAS1,ILGAS2) FOR GLOBAL MEAN GAS AMOUNTS 846.
898 C -------------------------------------------------------------- 847.
899 DO 170 K=1,30 848.
900 170 MLGAS(K)=0 849.
901 IF(LAPGAS.LT.1) GO TO 174 850.
902 DO 172 L=1,3 851.
903 DO 171 K=ILGAS1,ILGAS2 852.
904 M=KGAS(K,L) 853.
905 IF(M.GT.3) MLGAS(M)=1 854.
906 171 CONTINUE 855.
907 172 CONTINUE 856.
908 DO 173 K=1,15 857.
909 173 MLGAS(15+K)=MLGAS(K) 858.
910 174 CONTINUE 859.
911 C 860.
912 C ---------------------------------------------------------------- 861.
913 C TAULAP=OVERLAP ABSORPTION KEPT AS INITIALIZED (NO CHANGES LATER) 862.
914 C ---------------------------------------------------------------- 863.
915 C 864.
916 DO 180 I=1,1000 865.
917 TAULAP(I)=0. 866.
918 180 TAUN(I)=0. 867.
919 C 868.
920 C-------------------------------- 869.
921 IF(LAPGAS.GT.0) CALL TAUGAS 870.
922 C-------------------------------- 871.
923 C 872.
924 DO 181 I=1,NLNKTR 873.
925 181 TAULAP(I)=TAUN(I) 874.
926 C 875.
927 C ---------------------------------------------------------- 876.
928 C MAIN GAS (IMGAS1,IMGAS2) ABSORPTION INTERPOLATED AS NEEDED 877.
929 C ---------------------------------------------------------- 878.
930 C 879.
931 DO 191 L=1,3 880.
932 DO 190 K=IMGAS1,IMGAS2 881.
933 M=KGAS(K,L) 882.
934 IF(M.GT.0) MLGAS(M)=1 883.
935 190 CONTINUE 884.
936 191 CONTINUE 885.
937 DO 192 K=1,13 886.
938 192 MLGAS(K)=MLGAS(K)*(MLGAS(K)-MLGAS(K+15)) 887.
939 IF(IMGAS1.EQ.1) MLGAS(14)=1 888.
940 IF(KWVCON.EQ.1) MLGAS(15)=1 889.
941 DO 193 K=1,30 890.
942 193 MLLAP(K)=MLGAS(K) 891.
943 C 892.
944 RETURN 893.
945 C 894.
946 C----------------------------------------------------------------------- 895.
947 C REDEFINE TAULAP TABLE: GET ABSORPTION FROM TAUGAS TABLE 896.
948 ENTRY SETLAP 897.
949 C----------------------------------------------------------------------- 898.
950 C 899.
951 IF(LAPGAS.EQ.1) RETURN 900.
952 C 901.
953 DO 200 I=1,1000 902.
954 200 TAULAP(I)=0. 903.
955 IF(LAPGAS.EQ.0) RETURN 904.
956 C 905.
957 DO 210 K=1,15 906.
958 210 MLGAS(K)=MLLAP(K+15) 907.
959 C 908.
960 DO 220 I=1,NLNKTR 909.
961 220 TAUN(I)=TAULAP(I) 910.
962 C 911.
963 DO 230 L=1,NL 912.
964 DPL(L)=PLB0(L)-PLB0(L+1) 912.11
965 PL(L)=(PLB0(L)+PLB0(L+1))*0.5 912.12
966 TLM(L)=TLM0(L) 912.13
967 U0GAS(L,3)=U0GAS3(L) 912.14
968 C 912.15
969 ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 913.
970 ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 914.
971 230 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 915.
972 C 916.
973 c
974 tropmass = 28.97296245*1.e-3*0.8/P0
975 trpm=tropmass*1.e3
976 DO 240 L=1,nlev
977 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
978
979 #ifdef PREDICTED_GASES
980 pxxx = dpl(l)
981
982 ULGAS(L,2)=glbgas(l,1)*tropmass/44.0098
983 & *pxxx
984 ULGAS(L,6)=glbgas(l,2)*tropmass/44.0000
985 & *pxxx
986 ULGAS(L,7)=glbgas(l,3)*tropmass/16.0426
987 & *pxxx
988 ULGAS(L,8)=glbgas(l,4)*tropmass/137.3675
989 & *pxxx
990 ULGAS(L,9)=glbgas(l,5)*tropmass/120.9054
991 & *pxxx
992 #else
993 !
994 !prescribed greenhouse
995 ! gas profiles
996 !
997 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2) 918.
998 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6) 920.
999 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7) 921.
1000 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8) 922.
1001 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1002 #endif
1003 240 continue
1004 ll=nlev
1005 do 2240 l=nlev+1,NL
1006 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)
1007 #ifdef PREDICTED_GASES
1008 pxxx = dpl(l)
1009
1010 ULGAS(L,2)=glbgas(ll,1)*tropmass/44.0098
1011 & *pxxx
1012 ULGAS(L,6)=glbgas(ll,2)*tropmass/44.0000
1013 & *pxxx
1014 ULGAS(L,7)=glbgas(ll,3)*tropmass/16.0426
1015 & *pxxx
1016 ULGAS(L,8)=glbgas(ll,4)*tropmass/137.3675
1017 & *pxxx
1018 ULGAS(L,9)=glbgas(ll,5)*tropmass/120.9054
1019 & *pxxx
1020 #else
1021 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)
1022 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)
1023 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)
1024 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)
1025 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)
1026 #endif
1027 2240 continue
1028 C PRINT
1029 c print *,' after 240'
1030 c print *,(ULGAS(n,2),n=1,nl)
1031 C PRINT
1032 C 924.
1033 C----------------- 925.
1034 CALL TAUGAS 926.
1035 C----------------- 927.
1036 C 928.
1037 DO 250 I=1,NLNKTR 929.
1038 250 TAULAP(I)=TAUN(I) 930.
1039 C 931.
1040 DO 260 K=1,15 932.
1041 260 MLGAS(K)=MLLAP(K) 933.
1042 C 934.
1043 RETURN 935.
1044 C 936.
1045 C----------------------------------------------------------------------- 937.
1046 C SPECIFY ULGAS: GET MAINGAS ABSORPTION FROM TAUGAS TABLE 938.
1047 ENTRY GETGAS 939.
1048 C----------------------------------------------------------------------- 940.
1049 C 941.
1050 C----------------- 942.
1051 CALL O3DLON 943.
1052 C----------------- 944.
1053 C 945.
1054 DO 300 L=1,NL 946.
1055 DPL(L)=PLB(L)-PLB(L+1) 947.
1056 300 PL(L)=(PLB(L)+PLB(L+1))*0.5 948.
1057 C 949.
1058 IF(KEEPRH.EQ.1) GO TO 311 950.
1059 DO 310 L=1,NL 951.
1060 310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 952.
1061 C$310 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 953.
1062 GO TO 313 954.
1063 311 CONTINUE 955.
1064 DO 312 L=1,NL 956.
1065 ES=10.0**(9.4051-2353.0/TLM(L)) 957.
1066 SHL(L)=0.622*(RHL(L)*ES)/(PL(L)-0.378*(RHL(L)*ES)) 958.
1067 312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L) 959.
1068 C$312 U0GAS(L,1)=1268.75*DPL(L)*SHL(L)/(1.-SHL(L)) ********CORRECT 960.
1069 313 CONTINUE 961.
1070 C 962.
1071 DO 320 I=1,NLNKTR 963.
1072 320 TAUN(I)=TAULAP(I) 964.
1073 C 965.
1074 DO 330 L=1,NL 966.
1075 ULGAS(L,1)=U0GAS(L,1)*FULGAS(1) 967.
1076 ULGAS(L,3)=U0GAS(L,3)*FULGAS(3) 968.
1077 330 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5) 969.
1078 C 970.
1079 PART=(PLB(1)-PTOP)/(PS0-PTOP) 971.
1080
1081 !
1082 ! --- Chemistry model patch 080895
1083 !
1084 ! --- Note: most of the modifications in following
1085 ! sections were made originally as a part of chemistry
1086 ! module ( PREDICTED_GASES == CPL_CHEM ). However,
1087 ! they can be used by non-interactive
1088 ! chemistry-climate runs now, as far as the prescribed
1089 ! profiles of chemical species and aerosols are
1090 ! available.
1091 !
1092 ! Chien Wang
1093 ! 080100
1094 !
1095
1096 c ===
1097 c Prescribed gaseous profiles:
1098 c
1099 c DO 340 L=1,NL 972.
1100 c IF(L.EQ.NLMOD) PART=1. 973.
1101 c ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART 974.
1102 c ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART 975.
1103 c ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART 976.
1104 c ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART 977.
1105 c ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART 978.
1106 c ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART 979.
1107 c340 continue
1108 c goto 9341
1109 c
1110 c ===
1111
1112 !
1113 ! --- Use predicted gaseous profiles:
1114 !
1115 tropmass = 28.97296245*1.e-3*0.8/P0
1116 trpm=tropmass*1.e3
1117
1118 !
1119 ! --- Use internal point to avoid possible unstable
1120 ! --- problem related to LBC:
1121 !
1122 jyyy = max(3, min(nlat2,JLAT))
1123 !
1124
1125 do 2340 l=1,nlev
1126 IF(L.EQ.NLMOD) PART=1.
1127
1128 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1129
1130 #ifdef PREDICTED_GASES
1131 !
1132 ! --- predicted greenhouse gas profiles
1133 !
1134 pxxx = dpl(l)*part
1135
1136 c if (JLAT.eq.12) then
1137 c print *,'zco2=',zco2(1,jlat,l)
1138 c endif
1139 ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,l))/44.0098
1140 & *pxxx*tropmass
1141 c if (JLAT.eq.12) then
1142 c print *,'l=',L,' ULGAS(L,2)=',ULGAS(L,2)
1143 c endif
1144
1145 #ifdef O3_RAD
1146 !
1147 ! === Chien Wang 121797 then 062498 ===
1148 ! === add to use predicted ozone ===
1149 ! === in troposphere only ===
1150 if(l.le.n_tropopause)
1151 & ULGAS(L,3)=dmax1(0.0,o3(ILON,jyyy,l))/48.0
1152 & *pxxx*tropmass
1153 #endif
1154
1155 !
1156 ! --- Chem adjustmen of N2O and CH4 concentrations
1157 !
1158 xxxo=dmax1(0.0,xn2o(ILON,jyyy,l))
1159 & *tropmass/44.0000*1.25*P0
1160 yyyo=dmax1(0.0,ch4(ILON,jyyy,l))
1161 & *tropmass/16.0426*1.25*P0
1162 call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1163
1164 ULGAS(L,6)=xxxn*0.8*pxxx/P0
1165 ULGAS(L,7)=yyyn*0.8*pxxx/P0
1166
1167 #ifdef INC_3GASES
1168 !
1169 ! === if hfc, pfc, and sf6 are included:
1170 !
1171 ! === 032698
1172 ! === add hfc134a, pfc and sf6 to equivilent f11:
1173 ! ===
1174 equi_cfc11 = cfc11(ILON,jyyy,l)
1175 & + hfc134a(ilon,jyyy,l)*dhfc134a_df11
1176 & + pfc (ilon,jyyy,l)*dpfmethane_df11
1177 & + sf6 (ilon,jyyy,l)*dsf6_df11
1178 #else
1179 equi_cfc11 = cfc11(ILON,jyyy,l)
1180 #endif
1181 ! ===
1182 ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1183 & *tropmass/137.3675
1184 & *pxxx
1185 ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,l))
1186 & *tropmass/120.9054
1187 & *pxxx
1188
1189 #else
1190 !
1191 ! --- prescribed greenhouse gas profiles
1192 !
1193 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1194 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1195 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1196 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1197 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1198 #endif
1199
1200 #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1201 C-- Added ozone forcing from external source.
1202 C-- changed 18Mar98 CEForest
1203 C NB. ozone is updated daily
1204 C o3 = ppb(m)
1205 C 48 = mol weight of o3
1206 C ULGAS = cm^3 (STP)/cm^2
1207 C
1208 C 15JAN03 CEForest
1209 C changed to use total ozone, rather than anomalies, from GISS data
1210 C
1211 pxxx = dpl(l)*part
1212 ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1213 & *pxxx*tropmass
1214 C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1215 C-- end of change 18Mar98
1216 #endif
1217
1218 2340 continue
1219
1220 ll=nlev
1221 do 2342 l=nlev+1,NL
1222 IF(L.EQ.NLMOD) PART=1.
1223
1224 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4)*PART !O2
1225
1226 #ifdef PREDICTED_GASES
1227 !
1228 ! --- predicted greenhouse gas profiles
1229 !
1230 pxxx = dpl(l)*part
1231
1232 ULGAS(L,2)=dmax1(0.0,zco2(ILON,jyyy,ll))
1233 & *tropmass/44.0098
1234 & *pxxx
1235 !
1236 ! --- Chem adjustmen of N2O and CH4 concentrations
1237 !
1238 xxxo=dmax1(0.0,xn2o(ILON,jyyy,ll))
1239 & *tropmass/44.0000*1.25*P0
1240 yyyo=dmax1(0.0,ch4(ILON,jyyy,ll))
1241 & *tropmass/16.0426*1.25*P0
1242 call newcon(xxxn,yyyn,xxxo,yyyo,ppmv58(6),ppmv58(7))
1243
1244 ULGAS(L,6)=xxxn*0.8*pxxx/P0
1245 ULGAS(L,7)=yyyn*0.8*pxxx/P0
1246
1247 #ifdef INC_3GASES
1248 !
1249 ! === if hfc, pfc, and sf6 are included:
1250 !
1251 ! === 032698
1252 ! === add hfc134a, pfc and sf6 to equivilent f11:
1253 ! ===
1254 equi_cfc11 = cfc11(ILON,jyyy,ll)
1255 & + hfc134a(ilon,jyyy,ll)*dhfc134a_df11
1256 & + pfc (ilon,jyyy,ll)*dpfmethane_df11
1257 & + sf6 (ilon,jyyy,ll)*dsf6_df11
1258 #else
1259 equi_cfc11 = cfc11(ILON,jyyy,ll)
1260 #endif
1261 ULGAS(L,8)=dmax1(0.0,equi_cfc11)
1262 & *tropmass/137.3675
1263 & *pxxx
1264 ULGAS(L,9)=dmax1(0.0,cfc12(ILON,jyyy,ll))
1265 & *tropmass/120.9054
1266 & *pxxx
1267 #else
1268 !
1269 ! --- prescribed greenhouse gas profiles
1270 !
1271 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2)*PART
1272 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6)*PART
1273 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7)*PART
1274 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8)*PART
1275 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9)*PART
1276 #endif
1277
1278 #if ( !defined CPL_CHEM ) && ( defined O3_FORCED )
1279 C-- Added ozone forcing from external source.
1280 C-- changed 18Mar98 CEForest
1281 C NB. ozone is updated daily
1282 C o3 = ppb(m)
1283 C 48 = mol weight of o3
1284 C ULGAS = cm^3 (STP)/cm^2
1285 C
1286 C 15JAN03 CEForest
1287 C changed to use total ozone, rather than anomalies, from GISS data
1288 C
1289 C added adjustment to layers (nlev+1:nlev+3) above dynamics layers
1290 pxxx = dpl(l)*part
1291 ULGAS(L,3)= o3dev(ILON,jlat,l)/48.0
1292 & *pxxx*tropmass
1293 C if (l.eq.9) print *,'Ozone Dev: ',jlat,o3dev(ILON,jlat,l)
1294 C-- end of change 18Mar98
1295 #endif
1296
1297
1298 2342 continue
1299
1300 c
1301 c-------------------------------------------------------
1302
1303 C----------------- 981.
1304 CALL TAUGAS 982.
1305 C----------------- 983.
1306 C 984.
1307 RETURN 985.
1308 C 986.
1309 C----------------------------------------------------------------------- 987.
1310 C IF(KGASSR.GT.0) REDEFINE ULGAS FOR SOLAR FULGAS VALUES 988.
1311 ENTRY SOLGAS 989.
1312 C----------------------------------------------------------------------- 990.
1313 C 991.
1314 C 992.
1315 DO 400 L=1,NL 993.
1316 ULGAS(L,1)=U0GAS(L,1)*FULGAS(1+9) 994.
1317 ULGAS(L,3)=U0GAS(L,3)*FULGAS(3+9) 995.
1318 400 ULGAS(L,5)=U0GAS(L,5)*FULGAS(5+9) 996.
1319 C 997.
1320 PART=(PLB(1)-PTOP)/(PS0-PTOP) 998.
1321 DO 410 L=1,NL 999.
1322 IF(L.EQ.NLMOD) PART=1. 1000.
1323 ULGAS(L,2)=U0GAS(L,2)*FULGAS(2+9)*PART 1001.
1324 ULGAS(L,4)=U0GAS(L,4)*FULGAS(4+9)*PART 1002.
1325 ULGAS(L,6)=U0GAS(L,6)*FULGAS(6+9)*PART 1003.
1326 ULGAS(L,7)=U0GAS(L,7)*FULGAS(7+9)*PART 1004.
1327 ULGAS(L,8)=U0GAS(L,8)*FULGAS(8+9)*PART 1005.
1328 410 ULGAS(L,9)=U0GAS(L,9)*FULGAS(9+9)*PART 1006.
1329 C 1007.
1330 C 1008.
1331 RETURN 1009.
1332 END 1010.
1333 SUBROUTINE SETAER 1011.
1334
1335 #include "chem_para"
1336 #include "chem_com"
1337 #include "B83XX.COM" 1012.
1338
1339 C 1073.
1340 EQUIVALENCE (FEMTRA(1),ECLTRA) 1074.
1341 EQUIVALENCE (ISPARE(2),NEWAQA) 1074.1
1342 EQUIVALENCE (ISPARE(3),NEWCQA) 1074.2
1343 C 1075.
1344 DIMENSION SRAX(40,6,5),SRAS(40,6,5),SRAC(40,6,5) 1076.
1345 C 1077.
1346 C-----------------------------------------------------------------------1078.
1347 C THERMAL: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1079.
1348 C-----------------------------------------------------------------------1080.
1349 C 1081.
1350 DO 100 J=1,NGOLDH 1082.
1351 DO 100 K=1,NKTR 1083.
1352 DO 100 L=1,NL 1084.
1353 100 TRAX(L,K,J)=0. 1085.
1354 C 1086.
1355 DO 103 I=1,NAERO 1087.
1356 DO 103 J=1,NGOLDH 1088.
1357 IF(AGOLDH(I,J).LT.1.E-06) GO TO 103 1089.
1358 C=CGOLDH(I,J) 1090.
1359 BC=EXP(-BGOLDH(I,J)/C) 1091.
1360 ABC=AGOLDH(I,J)*(1.0+BC) 1092.
1361 C 1093.
1362 DO 102 L=1,NL 1094.
1363 C AMIN
1364 ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1365 + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1366 C AMIN
1367 DO 101 K=1,NKTR 1097.
1368 TRANEW=TRACOS(K,I) 1097.5
1369 IF(NEWAQA.GT.0) TRANEW=1.0 1097.6
1370 101 TRAX(L,K,J)=TRAX(L,K,J)+ABCD*(TRAQEX(K,I)-TRANEW*TRAQSC(K,I)) 1098.
1371 102 CONTINUE 1099.
1372 103 CONTINUE 1100.
1373 C 1101.
1374 DO 104 J=1,2 1102.
1375 DO 104 K=1,NKTR 1103.
1376 TRCNEW=TRCCOS(K,J) 1103.5
1377 IF(NEWCQA.GT.0) TRCNEW=1.0 1103.6
1378 104 TRCX(K,J)=TRCQEX(K,J)-TRCNEW*TRCQSC(K,J) 1104.
1379 C 1105.
1380 C-----------------------------------------------------------------------1106.
1381 C SOLAR: SET (5) AEROSOL TYPE COMPOSITIONS & VERTICAL DISTRIBUTION1107.
1382 C-----------------------------------------------------------------------1108.
1383 C 1109.
1384 DO 110 J=1,NGOLDH 1110.
1385 DO 110 K=1,NKSR 1111.
1386 DO 110 L=1,NL 1112.
1387 SRAX(L,K,J)=1.E-30 1113.
1388 SRAS(L,K,J)=1.E-31 1114.
1389 110 SRAC(L,K,J)=0. 1115.
1390 C 1116.
1391 DO 113 I=1,NAERO 1117.
1392 DO 113 J=1,NGOLDH 1118.
1393 IF(AGOLDH(I,J).LT.1.E-06) GO TO 113 1119.
1394 C=CGOLDH(I,J) 1120.
1395 BC=EXP(-BGOLDH(I,J)/C) 1121.
1396 ABC=AGOLDH(I,J)*(1.0+BC) 1122.
1397 C 1123.
1398 DO 112 L=1,NL 1124.
1399 C AMIN
1400 ABCD=ABC/(1.0+BC*EXP(DMIN1(HLB(L )/C,80.))) 1095.
1401 + -ABC/(1.0+BC*EXP(DMIN1(HLB(L+1)/C,80.))) 1096.
1402 C AMIN
1403 DO 111 K=1,NKSR 1127.
1404 SRAX(L,K,J)=SRAX(L,K,J)+ABCD*SRAQEX(K,I) 1128.
1405 SRAS(L,K,J)=SRAS(L,K,J)+ABCD*SRAQSC(K,I) 1129.
1406 111 SRAC(L,K,J)=SRAC(L,K,J)+ABCD*SRACOS(K,I)*SRAQSC(K,I) 1130.
1407 112 CONTINUE 1131.
1408 113 CONTINUE 1132.
1409 C 1133.
1410 DO 114 J=1,NGOLDH 1134.
1411 DO 114 K=1,NKSR 1135.
1412 DO 114 L=1,NL 1136.
1413 114 SRAC(L,K,J)=SRAC(L,K,J)/SRAS(L,K,J) 1137.
1414 C 1138.
1415 C----------------- 1139.
1416 ENTRY GETAER 1140.
1417 C----------------- 1141.
1418 C 1142.
1419 C-----------------------------------------------------------------------1143.
1420 C GET CLOUD & AEROSOL AMOUNTS & DISTRIBUTIONS1144.
1421 C-----------------------------------------------------------------------1145.
1422 LBOTCL=0 1146.
1423 LTOPCL=0 1147.
1424 DO 203 L=1,NL 1148.
1425 KCLD=1 1149.
1426 IF(TLM(L).LT.TKCICE) KCLD=2 1150.
1427 IF(CLDTAU(NLP-L).GT.0.1) LTOPCL=NLP-L 1151.
1428 C$ IF(CLDTAU(NLP-L).GT.0.1) LBOTCL=NLP-L *******************CORRECT1152.
1429 IF(CLDTAU( L).GT.0.1) LBOTCL=L 1153.
1430 C$ IF(CLDTAU( L).GT.0.1) LTOPCL=L ***********************CORRECT1154.
1431 C (THERMAL) 1155.
1432 C --------- 1156.
1433 DO 202 K=1,NKTR 1157.
1434 SUMEXT=1.E-30 1158.
1435 DO 201 J=1,NGOLDH 1159.
1436 201 SUMEXT=SUMEXT+FGOLDH(J)*TRAX(L,K,J) 1160.
1437 TRAEXT(L,K)=SUMEXT+CLDTAU(L)*TRCX(K,KCLD)*FCLDTR 1161.
1438 202 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+TRAEXT(L,K) 1162.
1439 203 CONTINUE 1163.
1440 C 1164.
1441 C-----------------------------------------------------------------------1165.
1442 C CLOUD ALBEDO & SURFACE LAYER FOG SPECIFICATION1166.
1443 C-----------------------------------------------------------------------1167.
1444 C 1168.
1445 DO 204 K=1,NKTR 1169.
1446 204 FTAUSL(K)=FOGTSL*TRCX(K,1)*FCLDTR 1170.
1447 IF(LTOPCL.GT.0) GO TO 206 1171.
1448 DO 205 K=1,NKTR 1172.
1449 205 TRCALB(K)=0. 1173.
1450 GO TO 210 1174.
1451 206 KCLD=1 1175.
1452 IF(TLM(LTOPCL).LT.TKCICE) KCLD=2 1176.
1453 DO 207 K=1,NKTR 1177.
1454 207 TRCALB(K)=(1.0-EXP(-CLDTAU(LTOPCL)*TRCX(K,KCLD)))*CLDALB(K,KCLD) 1178.
1455 + *ECLTRA*FCLDTR 1179.
1456 210 CONTINUE 1180.
1457 C (SOLAR) 1181.
1458 C ------- 1182.
1459 KSR=9*KAERSR 1183.
1460 DO 9212 K=1,NKSR 1184.
1461 DO 212 L=1,NL 1185.
1462 EXTSUM=1.E-30 1186.
1463 SCTSUM=1.E-31 1187.
1464 COSSUM=0. 1188.
1465 DO 211 J=1,NGOLDH 1189.
1466 EXTSUM=EXTSUM+FGOLDH(J+KSR)*SRAX(L,K,J) 1190.
1467 SCTSUM=SCTSUM+FGOLDH(J+KSR)*SRAS(L,K,J) 1191.
1468 211 COSSUM=COSSUM+FGOLDH(J+KSR)*SRAS(L,K,J)*SRAC(L,K,J) 1192.
1469
1470 #if ( defined PREDICTED_BC || defined PREDICTED_AEROSOL)
1471 !
1472 ! --- Chemistry model patch, 092901
1473 !
1474 ! === Chien Wang
1475 ! === (1) add to type 3 aerosol with
1476 ! === chemistry model predicted S(VI);
1477 ! === (2) add type 11 aerosol with
1478 ! === chemistry model predicted bcarbon
1479 ! ===
1480 if ( L .le. nlev1 ) then
1481 !
1482 ! === add as global aerosol
1483 ! Note: if needed the AGOLDH for prescribed
1484 ! tropospheric S(VI), SLFT1 & SLFT2, can be
1485 ! set to zero in later part of the code
1486 !
1487 ! FAERSOL/svi_intensity is added for using
1488 ! FAERSOL to switch between diagnostic/prognostic loops
1489 ! while normalize it to 1 in prognostic loop
1490 ! FBC added for black carbon 7/22/04
1491 !
1492 dsviod = 0.0
1493 dbcod = 0.0
1494
1495 #if ( defined PREDICTED_AEROSOL )
1496 dsviod = max(0.0,
1497 & (sviod(1,jlat,L) - sviod(1,jlat,L+1))
1498 & *FAERSOL )
1499 #endif
1500
1501 #if ( defined PREDICTED_BC)
1502 dbcod = max(0.0,
1503 & (bcod(1,jlat,L) - bcod(1,jlat,L+1))
1504 & *FBC )
1505 #endif
1506
1507 EXTSUM = EXTSUM
1508 & + dsviod*SRAQEX(K,3)
1509 & + dbcod*SRAQEX(K,11)
1510 SCTSUM = SCTSUM
1511 & + dsviod*SRAQSC(K,3)
1512 & + dbcod*SRAQSC(K,11)
1513 COSSUM = COSSUM
1514 & + dsviod*SRAQSC(K,3)*SRACOS(K,3)
1515 & + dbcod*SRAQSC(K,11)*SRACOS(K,11)
1516
1517 if(jlat.eq.-22.or.jlat.eq.-33)then
1518 if(L.eq.1.and.k.eq.1)then
1519 print *,'From r95 jlat=',jlat,' L=',L
1520 c print *,' LATHEM=',LATHEM, ' JNORTH=',JNORTH
1521 c print *,'FAERSOL=',FAERSOL,' FBC=',FBC
1522 print *,sviod(1,jlat,L),sviod(1,jlat,L+1)
1523 c print *,dsviod,SRAQEX(K,3)
1524 print *,bcod(1,jlat,L),bcod(1,jlat,L+1)
1525 c print *,dbcod,SRAQEX(K,11)
1526 c print *,SRAQSC(K,11),SRACOS(K,11)
1527 endif
1528 endif
1529 end if
1530 #endif
1531
1532 EXTAER(L,K)=EXTSUM 1193.
1533 SCTAER(L,K)=SCTSUM 1194.
1534 COSAER(L,K)=COSSUM/SCTSUM 1195.
1535
1536 212 continue
1537 9212 continue
1538 c
1539 c ======================================================
1540
1541 IF(NTRACE.GT.0) GO TO 300 1196.
1542 C 1197.
1543 C----------- 1198.
1544 RETURN 1199.
1545 C----------- 1200.
1546 C 1201.
1547 300 CONTINUE 1202.
1548 C-----------------------------------------------------------------------1203.
1549 C ADD TRACER AEROSOL THERMAL & SOLAR CONTRIBUTIONS 1204.
1550 C-----------------------------------------------------------------------1205.
1551 DO 303 JJ=1,NTRACE 1206.
1552 J=NGOLDH+JJ 1207.
1553 I=ITR(JJ) 1208.
1554 C (THERMAL) 1209.
1555 C --------- 1210.
1556 DO 302 K=1,NKTR 1211.
1557 C$ SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRACOS(K,I)*TRAQSC(K,I)) 1212.
1558 SUMEXT=FGOLDH(J+KSR)*(TRAQEX(K,I)-TRAQSC(K,I)) 1212.11
1559 DO 301 L=1,NL 1213.
1560 301 TAUN(L+(K-1)*NL)=TAUN(L+(K-1)*NL)+SUMEXT*TRACER(L,JJ) 1214.
1561 302 CONTINUE 1215.
1562 303 CONTINUE 1216.
1563 C 1217.
1564 C (SOLAR) 1218.
1565 C ------- 1219.
1566 DO 305 K=1,NKSR 1220.
1567 DO 305 L=1,NL 1221.
1568 EXTSUM=EXTAER(L,K) 1222.
1569 SCTSUM=SCTAER(L,K) 1223.
1570 COSSUM=COSAER(L,K)*SCTAER(L,K) 1224.
1571 DO 304 JJ=1,NTRACE 1225.
1572 J=NGOLDH+JJ 1226.
1573 I=ITR(JJ) 1227.
1574 EXTSUM=EXTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQEX(K,I) 1228.
1575 SCTSUM=SCTSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I) 1229.
1576 304 COSSUM=COSSUM+FGOLDH(J+KSR)*TRACER(L,JJ)*SRAQSC(K,I)*SRACOS(K,I) 1230.
1577 EXTAER(L,K)=EXTSUM 1231.
1578 SCTAER(L,K)=SCTSUM 1232.
1579 305 COSAER(L,K)=COSSUM/SCTSUM 1233.
1580 RETURN 1234.
1581 END 1235.
1582 SUBROUTINE TAUGAS 1236.
1583
1584 #include "B83XX.COM"
1585
1586 C TAUGAS INPUT REQUIRES: NL,TLM,ULGAS,TRACEG,PL,DPL,TAUTBL,MLGAS 1295.11
1587 C TAUGAS OUTPUT DATA IS: TAUN 1295.12
1588 C 1296.
1589 DIMENSION IGASX(11),KGX(11),NUX(11),IGUX(11),NGX(3),IG1X(3) 1297.
1590 DIMENSION ULOX(165),DUX(165),PX(15),H2OCON(25) 1298.
1591 C 1299.
1592 DATA NTX/8/, TLOX/181./,DTX/23./ 1300.
1593 DATA NPX/15/, PX/1000., 975., 910., 800., 645., 1301.
1594 * 480., 330., 205., 110., 40., 1302.
1595 * 7.5, 3.5, 1.0, 0.1, .001/ 1303.
1596 C 1304.
1597 DATA NGUX/652/, NPUX/15/ 1305.
1598 DATA NGX/10,10,04/, IG1X/2,12,22/ 1306.
1599 DATA 1307.
1600 * IGASX/ 1, 2, 3, 1, 1, 2, 2, 3, 6, 6, 7/, 1308.
1601 * KGX/ 1, 2, 3, 2, 3, 1, 3, 2, 1, 2, 1/, 1309.
1602 * NUX/ 25, 9, 9, 9, 9, 5, 5, 5, 1, 1, 1/, 1310.
1603 * IGUX/ 0,250,340,376,466,502,552,572,622,632,642/ 1311.
1604 C 1312.
1605 C 1313.
1606 DATA ULOX/ .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1,.10E+1, 1314.
1607 *.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1315.
1608 *.50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+1,.10E+2,.80E+1, 1316.
1609 *.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3, 1317.
1610 *.40E-3,.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2, 1318.
1611 *.40E-2,.10E-4,.80E-7,.40E-7, .25E+2,.25E+2,.50E+2,.50E+2, 1319.
1612 *.25E+2,.50E+1,.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3, 1320.
1613 *.10E-5,.10E-5, .25E+2,.25E+2,.50E+2,.50E+2,.25E+2,.50E+1, 1321.
1614 *.10E+1,.25E+0,.10E+0,.50E-1,.10E-1,.10E-1,.10E-3,.10E-5,.10E-5, 1322.
1615 * .50E+1,.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2, 1323.
1616 *.80E+1,.10E+1,.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .50E+1, 1324.
1617 *.50E+1,.80E+1,.10E+2,.20E+2,.20E+2,.10E+2,.10E+2,.80E+1,.10E+1, 1325.
1618 *.10E+1,.25E+0,.50E-1,.50E-2,.50E-3, .10E-3,.10E-3,.40E-3, 1326.
1619 *.60E-3,.10E-2,.24E-2,.48E-2,.48E-2,.64E-2,.64E-2,.64E-2,.40E-2, 1327.
1620 *.10E-4,.80E-7,.40E-7, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1, 1328.
1621 *.35E-1,.31E-1,.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4, 1329.
1622 *.44E-6, .11E-1,.11E-1,.18E-1,.31E-1,.37E-1,.35E-1,.31E-1, 1330.
1623 *.24E-1,.18E-1,.13E-1,.11E-2,.66E-3,.44E-3,.44E-4,.44E-6, 1331.
1624 *.64E-1,.64E-1,.10E+0,.18E+0,.22E+0,.20E+0,.18E+0,.14E+0,.10E+0, 1332.
1625 *.77E-1,.64E-2,.38E-2,.26E-2,.26E-3,.26E-5/ 1333.
1626 C 1334.
1627 DATA DUX/ .75E+2,.75E+2,.10E+3,.10E+3,.75E+2,.50E+2,.10E+2, 1335.
1628 *.20E+1,.20E+0,.10E+0,.50E-1,.10E-1,.40E-2,.40E-3,.40E-4, 1336.
1629 *.50E+1,.50E+1,.80E+1,.10E+2,.10E+2,.10E+2,.10E+2,.10E+2,.80E+1, 1337.
1630 *.50E+1,.35E+1,.25E+0,.25E+0,.10E+0,.10E-1, .30E-3,.30E-3, 1338.
1631 *.50E-3,.80E-3,.10E-2,.16E-2,.64E-2,.16E-2,.25E-1,.25E-1,.25E-1, 1339.
1632 *.45E-2,.25E-2,.10E-2,.25E-4, .24E+3,.24E+3,.30E+3,.30E+3, 1340.
1633 *.24E+3,.15E+3,.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1, 1341.
1634 *.12E-2,.12E-3, .24E+3,.24E+3,.30E+3,.30E+3,.24E+3,.15E+3, 1342.
1635 *.30E+2,.60E+1,.60E+0,.30E+0,.15E+0,.30E-1,.12E-1,.12E-2,.12E-3, 1343.
1636 * .10E+2,.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2, 1344.
1637 *.16E+2,.10E+2,.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .10E+2, 1345.
1638 *.10E+2,.16E+2,.20E+2,.20E+2,.20E+2,.20E+2,.20E+2,.16E+2,.10E+2, 1346.
1639 *.70E+1,.50E+0,.50E+0,.20E+0,.20E-1, .60E-3,.60E-3,.10E-2, 1347.
1640 *.16E-2,.20E-2,.32E-2,.13E-1,.32E-1,.50E-1,.50E-1,.50E-1,.90E-2, 1348.
1641 *.50E-2,.20E-2,.50E-4, 45*0./ 1349.
1642 C 1350.
1643 DATA H2OCON/ .767116, .322401, .572299,.58537, .48869, 1351.
1644 * .43539, .44322, .64072, .89293, 1.12733,1.65550, .865210, 1352.
1645 * 1.38403,1.80159,1.99196, 2.03403, 2.20561,2.42859,2.56883, 1353.
1646 * 2.67157,2.71888, .45534, .44735, .44534, .44365/ 1354.
1647 C 1355.
1648 C-------------------------------------------------------------------- 1356.
1649 C ABSORPTION (TAU) INTERPOLATION FOR GAS AMOUNTS IN ULGAS(N,K) 1357.
1650 C-------------------------------------------------------------------- 1358.
1651 C 1359.
1652 IPX=2 1360.
1653 DO 100 IP=1,NL 1361.
1654 C 1362.
1655 20 WPB = (PL(IP)-PX(IPX))/(PX(IPX-1)-PX(IPX)) 1363.
1656 IF(WPB.GE.0. .OR. IPX.GE.NPX) GO TO 30 1364.
1657 IPX = IPX+1 1365.
1658 GO TO 20 1366.
1659 C 1367.
1660 30 WTB = (TLM(IP)-TLOX)/DTX 1368.
1661 ITX = MIN0(MAX0(INT(WTB),0),NTX-2) 1369.
1662 WTB = WTB-FLOAT(ITX) 1370.
1663 C 1371.
1664 WBB = WPB*WTB 1372.
1665 WBA = WPB-WBB 1373.
1666 WAB = WTB-WBB 1374.
1667 WAA = 1.-(WBB+WBA+WAB) 1375.
1668 C 1376.
1669 IAA = NGUX*(ITX+NTX*(IPX-1)) 1377.
1670 IBA = IAA-NGUX*NTX 1378.
1671 C 1379.
1672 DO 90 IGAS=1,11 1380.
1673 IF(MLGAS(IGAS).LT.1) GO TO 90 1381.
1674 C 1382.
1675 UGAS = ULGAS(IP,IGASX(IGAS)) 1383.
1676 IF(UGAS.LT.1.E-10) GO TO 90 1384.
1677 C 1385.
1678 IU = IPX + NPUX*(IGAS-1) 1386.
1679 NU = NUX(IGAS) 1387.
1680 IF(NU.GT.1) GO TO 40 1388.
1681 XUA = 0. 1389.
1682 XUB = 0. 1390.
1683 GO TO 50 1391.
1684 40 XUA = (UGAS-ULOX(IU))/DUX(IU) 1392.
1685 XUB = (UGAS-ULOX(IU-1))/DUX(IU-1) 1393.
1686 50 IUA = INT(XUA) 1394.
1687 IUB = INT(XUB) 1395.
1688 C 1396.
1689 QAA = 1. 1397.
1690 QAB = 1. 1398.
1691 IF(XUA.GT.0. .AND. IUA.LT.NU-1) GO TO 60 1399.
1692 c XUA = DMIN1(DMAX1(XUA,0.),FLOAT(NU-1)) 1400.
1693 XUA = DMIN1(DMAX1(XUA,0.),dble(NU-1)) 1400.
1694 IUA = MIN0(INT(XUA),NU-2) 1401.
1695 QAA = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA)) 1402.
1696 QAB = UGAS/(ULOX(IU)+DUX(IU)*FLOAT(IUA+1)) 1403.
1697 C 1404.
1698 60 QBA = 1. 1405.
1699 QBB = 1. 1406.
1700 IF(XUB.GT.0. .AND. IUB.LT.NU-1) GO TO 70 1407.
1701 c XUB = DMIN1(DMAX1(XUB,0.),FLOAT(NU-1)) 1408.
1702 XUB = DMIN1(DMAX1(XUB,0.),dble(NU-1)) 1408.
1703 IUB = MIN0(INT(XUB),NU-2) 1409.
1704 QBA = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB)) 1410.
1705 QBB = UGAS/(ULOX(IU-1)+DUX(IU-1)*FLOAT(IUB+1)) 1411.
1706 C 1412.
1707 70 UAB = XUA-FLOAT(IUA) 1413.
1708 UBB = XUB-FLOAT(IUB) 1414.
1709 UAA = 1.-UAB 1415.
1710 UBA = 1.-UBB 1416.
1711 C 1417.
1712 C 1418.
1713 WAAA = WAA*UAA*QAA 1419.
1714 WAAB = WAA*UAB*QAB 1420.
1715 WABA = WAB*UAA*QAA 1421.
1716 WABB = WAB*UAB*QAB 1422.
1717 WBAA = WBA*UBA*QBA 1423.
1718 WBAB = WBA*UBB*QBB 1424.
1719 WBBA = WBB*UBA*QBA 1425.
1720 WBBB = WBB*UBB*QBB 1426.
1721 C 1427.
1722 NG = NGX(KGX(IGAS)) 1428.
1723 IAAA = IAA+IGUX(IGAS) + NG*IUA 1429.
1724 IAAB = IAAA+NG 1430.
1725 IABA = IAAA+NGUX 1431.
1726 IABB = IABA+NG 1432.
1727 IBAA = IBA+IGUX(IGAS) + NG*IUB 1433.
1728 IBAB = IBAA+NG 1434.
1729 IBBA = IBAA+NGUX 1435.
1730 IBBB = IBBA+NG 1436.
1731 C 1437.
1732 C 1438.
1733 IPG = IP+NL*(IG1X(KGX(IGAS))-1) 1439.
1734 DO 80 IG=1,NG 1440.
1735 TAUN(IPG) = TAUN(IPG) 1441.
1736 * + WAAA*TAUTBL(IAAA+IG) 1442.
1737 * + WAAB*TAUTBL(IAAB+IG) 1443.
1738 * + WABA*TAUTBL(IABA+IG) 1444.
1739 * + WABB*TAUTBL(IABB+IG) 1445.
1740 * + WBAA*TAUTBL(IBAA+IG) 1446.
1741 * + WBAB*TAUTBL(IBAB+IG) 1447.
1742 * + WBBA*TAUTBL(IBBA+IG) 1448.
1743 * + WBBB*TAUTBL(IBBB+IG) 1449.
1744 80 IPG = IPG+NL 1450.
1745 90 CONTINUE 1451.
1746 100 CONTINUE 1452.
1747 C 1453.
1748 IF(MLGAS(12).LT.1) GO TO 110 1454.
1749 C------------------------------------------------------------------- 1455.
1750 C PICK UP CCL3F1 (F11) ABSORPTION 1456.
1751 C------------------------------------------------------------------- 1457.
1752 C 1458.
1753 DO 102 K=1,25 1459.
1754 XKPCMA=TRACEG(K,1) 1460.
1755 IF(XKPCMA.LT.1.E-10) GO TO 102 1461.
1756 DO 101 N=1,NL 1462.
1757 NK=N+(K-1)*NL 1463.
1758 101 TAUN(NK)=TAUN(NK)+ULGAS(N,8)*XKPCMA 1464.
1759 102 CONTINUE 1465.
1760 C 1466.
1761 110 IF(MLGAS(13).LT.1) GO TO 120 1467.
1762 C------------------------------------------------------------------- 1468.
1763 C PICK UP CCL2F2 (F12) ABSORPTION 1469.
1764 C------------------------------------------------------------------- 1470.
1765 C 1471.
1766 DO 112 K=1,25 1472.
1767 XKPCMA=TRACEG(K,2) 1473.
1768 IF(XKPCMA.LT.1.E-10) GO TO 112 1474.
1769 DO 111 N=1,NL 1475.
1770 NK=N+(K-1)*NL 1476.
1771 111 TAUN(NK)=TAUN(NK)+ULGAS(N,9)*XKPCMA 1477.
1772 112 CONTINUE 1478.
1773 C 1479.
1774 120 IF(MLGAS(14).LT.1) GO TO 130 1480.
1775 C------------------------------------------------------------------- 1481.
1776 C PICK UP WINDOW H2O GASEOUS ABSORPTION 1482.
1777 C------------------------------------------------------------------- 1483.
1778 C 1484.
1779 DO 121 N=1,NL 1485.
1780 TAUN(N) = TAUN(N) 1486.
1781 121 CONTINUE 1487.
1782 130 CONTINUE 1488.
1783 C------------------------------------------------------------------- 1489.
1784 C PICK UP H2O CONTINUUM ABSORPTION 1490.
1785 C------------------------------------------------------------------- 1491.
1786 C 1492.
1787 IF(MLGAS(15).LT.1) GO TO 140 1493.
1788 DO 131 N=1,NL 1494.
1789 TAUN(N) = TAUN(N) + 2.21866E-11* 1495.
1790 * PL(N)*ULGAS(N,1)*EXP(1800./TLM(N))* 1496.
1791 * (ULGAS(N,1)/DPL(N)+.808563) 1497.
1792 131 CONTINUE 1498.
1793 C 1499.
1794 C$ ********************************REMOVE FOLLOWING STATEMENT TO CORRECT1500.
1795 IF(NL.GT.0) RETURN 1501.
1796 DO 133 N=1,NL 1502.
1797 PH2O=12.38E-4*ULGAS(N,1)*PL(N)/DPL(N) 1503.
1798 TH2O=EXP(1800./TLM(N)-6.081081) 1504.
1799 COEC=PH2O*TH2O+.0015*(PL(N)-PH2O) 1505.
1800 DO 132 K=2,25 1506.
1801 COEF=H2OCON(K)*1.E-5 1507.
1802 NK=N+(K-1)*NL 1508.
1803 132 TAUN(NK)=TAUN(NK)+ULGAS(N,1)*COEC*COEF 1509.
1804 133 CONTINUE 1510.
1805 140 CONTINUE 1511.
1806 C 1512.
1807 RETURN 1513.
1808 END 1514.
1809 SUBROUTINE THERML 1515.
1810
1811 #include "B83XX.COM"
1812 #if ( defined CLM )
1813 #include "CLM.h"
1814 #endif
1815
1816 DATA R6,R24/.1666667,4.166667E-02/ 1577.
1817 DATA A,B,C/0.3825,0.5742,0.0433/ 1578.
1818 C 1579.
1819 C-----------------------------------------------------------------------1580.
1820 C LAYER EDGE TEMPERATURE INTERPOLATION1581.
1821 C-----------------------------------------------------------------------1582.
1822 IF(TLGRAD.LT.0.) GO TO 103 1583.
1823 TA=TLM(1) 1584.
1824 TB=TLM(2) 1585.
1825 P1=PLB(1) 1586.
1826 P2=PLB(2) 1587.
1827 P3=PLB(3) 1588.
1828 DT1CPT=0.5*TA*(EXPBYK(PLB(1))-EXPBYK(PLB(2)))/EXPBYK(PL(1)) 1589.
1829 DTHALF=(TA-TB)*(P1-P2)/(P1-P3) 1590.
1830 IF(DTHALF.GT.DT1CPT) DTHALF=DT1CPT 1591.
1831 TLB(1)=TA+DTHALF*TLGRAD 1592.
1832 TLT(1)=TA-DTHALF*TLGRAD 1593.
1833 DO 101 L=3,NL 1594.
1834 TC=TLM(L) 1595.
1835 P4=PLB(L+1) 1596.
1836 DTHALF=0.5*((TA-TB)/(P1-P3)+(TB-TC)/(P2-P4))*(P2-P3)*TLGRAD 1597.
1837 TLB(L-1)=TB+DTHALF 1598.
1838 TLT(L-1)=TB-DTHALF 1599.
1839 TA=TB 1600.
1840 TB=TC 1601.
1841 P1=P2 1602.
1842 P2=P3 1603.
1843 101 P3=P4 1604.
1844 DTHALF=(TA-TB)*(P2-P3)/(P1-P3)*TLGRAD 1605.
1845 TLB(NL)=TC+DTHALF 1606.
1846 TLT(NL)=TC-DTHALF 1607.
1847 L=NLP 1608.
1848 DO 102 N=1,NL 1609.
1849 L=L-1 1610.
1850 IF(PLB(L).GT.PTLISO) GO TO 103 1611.
1851 TLT(L)=TLM(L) 1612.
1852 102 TLB(L)=TLM(L) 1613.
1853 103 CONTINUE 1614.
1854 C-----------------------------------------------------------------------1615.
1855 C WEIGHT ASSIGNMENTS FOR PLANCK FUNCTION INTERPOLATION1616.
1856 C-----------------------------------------------------------------------1617.
1857 DO 104 L=1,NL 1618.
1858 ITL=TLB(L) 1619.
1859 WTLB(L)=TLB(L)-ITL 1620.
1860 ITLB(L)=ITL-IT0 1621.
1861 ITL=TLT(L) 1622.
1862 WTLT(L)=TLT(L)-ITL 1623.
1863 104 ITLT(L)=ITL-IT0 1624.
1864 ITS=TSL 1625.
1865 WTS=TSL-ITS 1626.
1866 ITS=ITS-IT0 1627.
1867 C 1628.
1868 C ------------------------------------------------------------------1629.
1869 C WINDOW REGION FLUX COMPUTATION1630.
1870 C ------------------------------------------------------------------1631.
1871 C DOWNWARD FLUX1632.
1872 C ------------------------------------------------------------------1633.
1873 K=1 1634.
1874 BG=BGFEMT(K) 1635.
1875 c print *,'1635 K=',k,' PEARTH=',PEARTH
1876 c print *,'BG=',BG
1877 WTS1=1.-WTS 1636.
1878 TRSLTS=0. 1637.
1879 TRSLTG=0. 1638.
1880 TRSLWV=0. 1639.
1881 TRSLBS=0. 1640.
1882 DNA=0. 1641.
1883 DNB=0. 1642.
1884 DNC=0. 1643.
1885 NLK0=0 1644.
1886 NLK=NL 1645.
1887 TRDFLB(NLP)=0. 1646.
1888 100 TAUA=TAUN(NLK) 1647.
1889 IF(TAUA.GT.1.E-05) GO TO 120 1648.
1890 TRDFLB(NLK)=0. 1649.
1891 NLK=NLK-1 1650.
1892 IF(NLK.GT.NLK0) GO TO 100 1651.
1893 110 NLK=NLK+1 1652.
1894 TRUFLB(NLK)=BG 1653.
1895 IF(NLK.LT.NLP) GO TO 110 1654.
1896 TRUFG=BG 1655.
1897 TRDFG=0. 1656.
1898 TRUFGW=BG 1657.
1899 TRUFGW=0. 1658.
1900 TRUFTW=TRUFLB(NLP) 1659.
1901 GO TO 200 1660.
1902 120 N=NLK 1661.
1903 130 ITL=ITLT(N) 1662.
1904 BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1663.
1905 ITL=ITLB(N) 1664.
1906 BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1665.
1907 TAUA=TAUN(N) 1666.
1908 TAUB=TAUA+TAUA 1667.
1909 TAUC=10.*TAUA 1668.
1910 IF(TAUA.GT.1.E-01) GO TO 140 1669.
1911 IF(TAUA.LT.1.E-03) GO TO 135 1670.
1912 TAU2=TAUA*TAUA 1671.
1913 BDIF=BBOT-BTOP 1672.
1914 BBTA=BDIF/TAUA 1673.
1915 BBTB=BDIF/TAUB 1674.
1916 BBTC=BDIF/TAUC 1675.
1917 TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1676.
1918 GO TO 145 1677.
1919 135 BDIF=.5*(BTOP+BBOT) 1678.
1920 TRA(N)=1.-TAUA 1679.
1921 ENA(N)=BDIF*TAUA 1680.
1922 DNA=DNA*TRA(N)+ENA(N) 1681.
1923 TRB(N)=1.-TAUB 1682.
1924 ENB(N)=BDIF*TAUB 1683.
1925 DNB=DNB*TRB(N)+ENB(N) 1684.
1926 TRC(N)=1.-TAUC 1685.
1927 ENC(N)=BDIF*TAUC 1686.
1928 DNC=DNC*TRC(N)+ENC(N) 1687.
1929 GO TO 160 1688.
1930 140 BDIF=BBOT-BTOP 1689.
1931 BBTA=BDIF/TAUA 1690.
1932 BBTB=BDIF/TAUB 1691.
1933 BBTC=BDIF/TAUC 1692.
1934 IF(TAUA.GT.7.) GO TO 150 1693.
1935 TRAN=EXP(-TAUA) 1694.
1936 145 TRA(N)=TRAN 1695.
1937 ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1696.
1938 DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1697.
1939 TRBN=TRAN*TRAN 1698.
1940 TRB(N)=TRBN 1699.
1941 ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1700.
1942 DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1701.
1943 TRCN=(TRBN*TRBN*TRAN)**2 1702.
1944 TRC(N)=TRCN 1703.
1945 ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1704.
1946 DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1705.
1947 GO TO 160 1706.
1948 150 TRA(N)=0. 1707.
1949 TRB(N)=0. 1708.
1950 TRC(N)=0. 1709.
1951 ENA(N)=BTOP+BBTA 1710.
1952 ENB(N)=BTOP+BBTB 1711.
1953 ENC(N)=BTOP+BBTC 1712.
1954 DNA=BBOT-BBTA 1713.
1955 DNB=BBOT-BBTB 1714.
1956 DNC=BBOT-BBTC 1715.
1957 160 TRDFLB(N)=A*DNA+B*DNB+C*DNC 1716.
1958 N=N-1 1717.
1959 IF(N.GT.0) GO TO 130 1718.
1960 IF(LTOPCL.LT.1) GO TO 165 1719.
1961 ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1720.
1962 ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1721.
1963 ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*TRDFLB(LTOPCL+1)1722.
1964 165 CONTINUE 1723.
1965 C ------------------------------------------------------------------1724.
1966 C SURFACE LAYER FLUX COMPUTATION1725.
1967 C ------------------------------------------------------------------1726.
1968 N=1 1727.
1969 TRDFG=TRDFLB(1) 1728.
1970 TAUA=TAUSL(1)+FTAUSL(1) 1729.
1971 IF(TAUA.GT.1.E-05) GO TO 170 1730.
1972 BG=BG+TRDFG*TRGALB(K) 1731.
1973 UNB=BG 1733.
1974 UNC=BG 1734.
1975 FUNABC=BG 1735.
1976 GO TO 180 1736.
1977 170 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1737.
1978 TA=EXP(-TAUA) 1738.
1979 TB=TA*TA 1739.
1980 TC=(TB*TB*TA)**2 1740.
1981 DNA=(DNA-BS)*TA+BS 1741.
1982 DNB=(DNB-BS)*TB+BS 1742.
1983 DNC=(DNC-BS)*TC+BS 1743.
1984 TRDFG=A*DNA+B*DNB+C*DNC 1744.
1985 BG=BG+TRDFG*TRGALB(K) 1745.
1986 UNA=(BG-BS)*TA+BS 1746.
1987 UNB=(BG-BS)*TB+BS 1747.
1988 UNC=(BG-BS)*TC+BS 1748.
1989 FUNABC=A*UNA+B*UNB+C*UNC 1749.
1990 BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1750.
1991 BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1751.
1992 SLABS=1.-A*TA-B*TB-C*TC 1752.
1993 TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1753.
1994 TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1754.
1995 TRSLBS=TRSLBS+BS*SLABS 1755.
1996 C ------------------------------------------------------------------1756.
1997 C UPWARD FLUX COMPUTATION1757.
1998 C ------------------------------------------------------------------1758.
1999 180 TRUFLB(N)=FUNABC 1759.
2000 IF(N.GT.NLK) GO TO 190 1760.
2001 UNA=UNA*TRA(N)+ENA(N) 1761.
2002 UNB=UNB*TRB(N)+ENB(N) 1762.
2003 UNC=UNC*TRC(N)+ENC(N) 1763.
2004 FUNABC=A*UNA+B*UNB+C*UNC 1764.
2005 190 N=N+1 1765.
2006 IF(N.LT.NLP) GO TO 180 1766.
2007 TRUFLB(N)=FUNABC 1767.
2008 TRUFTW=FUNABC 1768.
2009 TRDFGW=TRDFG 1769.
2010 TRUFGW=BG 1770.
2011 TRUFG=BG 1771.
2012 DO 195 L=1,NLP 1772.
2013 DFLB(L,1)=TRDFLB(L) 1773.
2014 195 UFLB(L,1)=TRUFLB(L) 1774.
2015 DFSL(1)=TRDFLB(1) 1775.
2016 UFSL(1)=TRUFLB(1) 1776.
2017 DFLB(1,1)=TRDFGW 1777.
2018 UFLB(1,1)=TRUFGW 1778.
2019 c print *,' 1778 TRUFLB(1)=',TRUFLB(1)
2020 C ------------------------------------------------------------------1779.
2021 C END WINDOW REGION FLUX COMPUTATION; CONTINUE INTEGRATION1780.
2022 C ------------------------------------------------------------------1781.
2023 C ------------------------------------------------------------------1782.
2024 C DOWNWARD FLUX COMPUTATION 1783.
2025 C ------------------------------------------------------------------1784.
2026 200 ITK0=K*ITNEXT 1785.
2027 K=K+1 1786.
2028 IF(K.GT.NKTR) GO TO 300 1787.
2029 DFLB(NLP,K)=0. 1788.
2030 BG=BGFEMT(K) 1789.
2031 ITS=ITS+ITNEXT 1790.
2032 NLK0=NLK0+NL 1791.
2033 NLK=NLK0+NL 1792.
2034 NLL=NL 1793.
2035 210 TAUA=TAUN(NLK) 1794.
2036 IF(TAUA.GT.1.E-05) GO TO 220 1795.
2037 DFLB(NLL,K)=0. 1796.
2038 NLK=NLK-1 1797.
2039 NLL=NLL-1 1798.
2040 IF(NLL.GT.0) GO TO 210 1799.
2041 TRUFG=TRUFG+BG 1800.
2042 DO 215 N=1,NLP 1801.
2043 UFLB(N,K)=BG 1802.
2044 215 TRUFLB(N)=TRUFLB(N)+BG 1803.
2045 GO TO 200 1804.
2046 220 N=NLL 1805.
2047 DNA=0. 1806.
2048 DNB=0. 1807.
2049 DNC=0. 1808.
2050 230 ITL=ITLT(N)+ITK0 1809.
2051 BTOP=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLT(N) 1810.
2052 ITL=ITLB(N)+ITK0 1811.
2053 BBOT=PLANCK(ITL)-(PLANCK(ITL)-PLANCK(ITL+1))*WTLB(N) 1812.
2054 TAUA=TAUN(NLK) 1813.
2055 TAUB=TAUA+TAUA 1814.
2056 TAUC=10.*TAUA 1815.
2057 IF(TAUA.GT.1.E-01) GO TO 240 1816.
2058 IF(TAUA.LT.1.E-03) GO TO 235 1817.
2059 TAU2=TAUA*TAUA 1818.
2060 BDIF=BBOT-BTOP 1819.
2061 BBTA=BDIF/TAUA 1820.
2062 BBTB=BDIF/TAUB 1821.
2063 BBTC=BDIF/TAUC 1822.
2064 TRAN=1.-TAUA+(0.5-R6*TAUA+R24*TAU2)*TAU2 1823.
2065 GO TO 245 1824.
2066 235 BDIF=.5*(BTOP+BBOT) 1825.
2067 TRA(N)=1.-TAUA 1826.
2068 ENA(N)=BDIF*TAUA 1827.
2069 DNA=DNA*TRA(N)+ENA(N) 1828.
2070 TRB(N)=1.-TAUB 1829.
2071 ENB(N)=BDIF*TAUB 1830.
2072 DNB=DNB*TRB(N)+ENB(N) 1831.
2073 TRC(N)=1.-TAUC 1832.
2074 ENC(N)=BDIF*TAUC 1833.
2075 DNC=DNC*TRC(N)+ENC(N) 1834.
2076 GO TO 260 1835.
2077 240 BDIF=BBOT-BTOP 1836.
2078 BBTA=BDIF/TAUA 1837.
2079 BBTB=BDIF/TAUB 1838.
2080 BBTC=BDIF/TAUC 1839.
2081 IF(TAUA.GT.7.) GO TO 250 1840.
2082 TRAN=EXP(-TAUA) 1841.
2083 245 TRA(N)=TRAN 1842.
2084 ENA(N)=BTOP+BBTA-(BBOT+BBTA)*TRAN 1843.
2085 DNA =BBOT-BBTA-(BTOP-BBTA-DNA)*TRAN 1844.
2086 TRBN=TRAN*TRAN 1845.
2087 TRB(N)=TRBN 1846.
2088 ENB(N)=BTOP+BBTB-(BBOT+BBTB)*TRBN 1847.
2089 DNB =BBOT-BBTB-(BTOP-BBTB-DNB)*TRBN 1848.
2090 TRCN=(TRBN*TRBN*TRAN)**2 1849.
2091 TRC(N)=TRCN 1850.
2092 ENC(N)=BTOP+BBTC-(BBOT+BBTC)*TRCN 1851.
2093 DNC =BBOT-BBTC-(BTOP-BBTC-DNC)*TRCN 1852.
2094 GO TO 260 1853.
2095 250 TRA(N)=0. 1854.
2096 TRB(N)=0. 1855.
2097 TRC(N)=0. 1856.
2098 ENA(N)=BTOP+BBTA 1857.
2099 ENB(N)=BTOP+BBTB 1858.
2100 ENC(N)=BTOP+BBTC 1859.
2101 DNA=BBOT-BBTA 1860.
2102 DNB=BBOT-BBTB 1861.
2103 DNC=BBOT-BBTC 1862.
2104 260 FDNABC=A*DNA+B*DNB+C*DNC 1863.
2105 TRDFLB(N)=TRDFLB(N)+FDNABC 1864.
2106 DFLB(N,K)=FDNABC 1865.
2107 N=N-1 1866.
2108 NLK=NLK-1 1867.
2109 IF(N.GT.0) GO TO 230 1868.
2110 DFSL(K)=FDNABC 1869.
2111 IF(LTOPCL.LT.1) GO TO 265 1870.
2112 ENA(LTOPCL)=ENA(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1871.
2113 ENB(LTOPCL)=ENB(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1872.
2114 ENC(LTOPCL)=ENC(LTOPCL)*(1.0-TRCALB(K))+TRCALB(K)*DFLB(LTOPCL+1,K)1873.
2115 265 CONTINUE 1874.
2116 C ------------------------------------------------------------------1875.
2117 C SURFACE LAYER FLUX COMPUTATION1876.
2118 C ------------------------------------------------------------------1877.
2119 N=1 1878.
2120 TAUA=TAUSL(K)+FTAUSL(K) 1879.
2121 IF(TAUA.GT.1.E-05) GO TO 270 1880.
2122 BG=BG+FDNABC*TRGALB(K) 1881.
2123 UNA=BG 1882.
2124 UNB=BG 1883.
2125 UNC=BG 1884.
2126 FUNABC=BG 1885.
2127 GO TO 280 1886.
2128 270 BS=PLANCK(ITS)*WTS1+PLANCK(ITS+1)*WTS 1887.
2129 TA=EXP(-TAUA) 1888.
2130 TB=TA*TA 1889.
2131 TC=(TB*TB*TA)**2 1890.
2132 DNA=(DNA-BS)*TA+BS 1891.
2133 DNB=(DNB-BS)*TB+BS 1892.
2134 DNC=(DNC-BS)*TC+BS 1893.
2135 FDNABC=A*DNA+B*DNB+C*DNC 1894.
2136 BG=BGFEMT(K)+FDNABC*TRGALB(K) 1895.
2137 UNA=(BG-BS)*TA+BS 1896.
2138 UNB=(BG-BS)*TB+BS 1897.
2139 UNC=(BG-BS)*TC+BS 1898.
2140 FUNABC=A*UNA+B*UNB+C*UNC 1899.
2141 BSP=PLANCK(ITS+1)*WTS1+PLANCK(ITS+2)*WTS 1900.
2142 BSM=PLANCK(ITS-1)*WTS1+PLANCK(ITS )*WTS 1901.
2143 SLABS=1.-A*TA-B*TB-C*TC 1902.
2144 TRSLTS=TRSLTS+(BSP-BSM)*SLABS 1903.
2145 TRSLTG=TRSLTG+BGFEMD(K)*SLABS 1904.
2146 TRSLBS=TRSLBS+BS*SLABS 1905.
2147 C ------------------------------------------------------------------1906.
2148 C UPWARD FLUX COMPUTATION1907.
2149 C ------------------------------------------------------------------1908.
2150 280 TRUFLB(N)=TRUFLB(N)+FUNABC 1909.
2151 UFLB(N,K)=FUNABC 1910.
2152 IF(N.GT.NLL) GO TO 290 1911.
2153 UNA=UNA*TRA(N)+ENA(N) 1912.
2154 UNB=UNB*TRB(N)+ENB(N) 1913.
2155 UNC=UNC*TRC(N)+ENC(N) 1914.
2156 FUNABC=A*UNA+B*UNB+C*UNC 1915.
2157 290 N=N+1 1916.
2158 IF(N.LT.NLP) GO TO 280 1917.
2159 TRUFLB(NLP)=TRUFLB(NLP)+FUNABC 1918.
2160 UFLB(NLP,K)=FUNABC 1919.
2161 UFSL(K)=UFLB(1,K) 1920.
2162 TRDFG=TRDFG+FDNABC 1921.
2163 DFLB(1,K)=FDNABC 1922.
2164 TRUFG=TRUFG+BG 1923.
2165 UFLB(1,K)=BG 1924.
2166 IF(K.EQ.11) TRSLWV=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1925.
2167 GO TO 200 1926.
2168 300 CONTINUE 1927.
2169 c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2170 c print * ,'1927 JLAT=',JLAT,PEARTH,PLICE
2171 c print *,' TRUFLB(1)=',TRUFLB(1),' TRUFG=',TRUFG
2172 c endif
2173
2174 #if ( defined CLM)
2175 c if(ncallclm.ge.1)then
2176 c if(PEARTH.gt.0.0.or.PLICE.gt.0.0)then
2177 c TRUFG=-lwuclm(ILON,JLAT)
2178 c print *,' CLM TRUFG=',TRUFG
2179 c endif
2180 c endif
2181 #endif
2182 C ------------------------------------------------------------------1928.
2183 C END FLUX COMPUTATION1929.
2184 C ------------------------------------------------------------------1930.
2185 TRSLCR=TRUFLB(1)-TRDFLB(1)+TRDFG-TRUFG 1931.
2186 TRDFSL=TRDFLB(1) 1932.
2187 TRDFLB(1)=TRDFG 1933.
2188 TRUFSL=TRUFLB(1) 1934.
2189 TRUFLB(1)=TRUFG 1935.
2190 DO 310 L=1,NLP 1936.
2191 310 TRNFLB(L)=TRUFLB(L)-TRDFLB(L) 1937.
2192 DO 320 L=1,NL 1938.
2193 320 TRFCRL(L)=TRNFLB(L+1)-TRNFLB(L) 1939.
2194 PFW=10.*TRUFTW 1940.
2195 IPF=PFW 1941.
2196 IF(IPF.LT.10) GO TO 330 1942.
2197 DPF=PFW-IPF 1943.
2198 IPF=IPF+180 1944.
2199 GO TO 350 1945.
2200 330 PFW=10.*PFW 1946.
2201 IPF=PFW 1947.
2202 IF(IPF.LT.10) GO TO 340 1948.
2203 DPF=PFW-IPF 1949.
2204 IPF=IPF+90 1950.
2205 GO TO 350 1951.
2206 340 PFW=10.*PFW 1952.
2207 IPF=PFW 1953.
2208 IF(IPF.LT.1) IPF=1 1954.
2209 350 BTEMPW=TKPFW(IPF)+DPF*(TKPFW(IPF+1)-TKPFW(IPF)) 1955.
2210 RETURN 1956.
2211 END 1957.
2212 SUBROUTINE SOLAR 1958.
2213 C-----------------------------------------------------------------------1959.
2214 C SOLAR RETURNS 1960.
2215 C-----------------------------------------------------------------------1961.
2216 C SRDFLB SOLAR DOWNWARD FLUX AT LAYER BOTTOM 1962.
2217 C SRUFLB SOLAR UPWARD FLUX AT LAYER BOTTOM EDGE 1963.
2218 C SRNFLB SOLAR NET (DOWNWARD) FLUX (WATTS/M**2) 1964.
2219 C SRFHRL SOLAR HEATING RATE : FLUX (WATTS/M**2) 1965.
2220 C SRRVIS VISALB OF ATMOSPHERE (AS IF RSURFX=0.) 1966.
2221 C SRTATM ATMOS. TRANSMISSIVITY (TOTAL SPECTRUM) 1967.
2222 C PLAVIS PLANETARY ALBEDO 0.2-0.7 MICRON REGION 1968.
2223 C ALBVIS ALBEDO AT GROUND 0.2-0.7 MICRON REGION 1969.
2224 C PLANIR PLANETARY ALBEDO WAV>0.7 MICRON REGION 1970.
2225 C ALBNIR ALBEDO AT GROUND WAV>0.7 MICRON REGION 1971.
2226 C-----------------------------------------------------------------------1972.
2227 C COMMENT 1973.
2228 C-----------------------------------------------------------------------1974.
2229 C SOLAR DATA IS RETURNED IN RADCOM LINES: N,O,P,Q1975.
2230 C NORMS0=1 FLUXES ARE NORMALIZED BY SOLAR CONSTANT1976.
2231 C VERTICAL FLUX DISTRIBUTIONS CONTAIN SOLAR ZENITH1977.
2232 C ANGLE (COSZ) DEPENDENCE 1978.
2233 C RETURNED SOLAR FLUX VALUES SHOULD BE MULTIPLIED 1979.
2234 C BY COSZ WHEN COMPUTING ATMOSPHERIC HEATING RATE 1980.
2235 C-----------------------------------------------------------------------1981.
2236
2237 #include "B83XX.COM"
2238
2239 DIMENSION PFR(52),PFRI(52), PI0C(14),DKS0(14) 2036.
2240 DATA PFR/ 2037.
2241 1.4144,.4917,.5265,.5530,.5757,.5966,.6159,.6345,.6522,.6689,.6849,2038.
2242 2.7003,.7152,.7293,.7428,.7557,.7680,.7796,.7905,.8008,.8105,.8198,2039.
2243 3.8286,.8368,.8444,.8515,.8581,.8642,.8699,.8750,.8798,.8843,.8886,2040.
2244 4.8928,.8968,.9005,.9040,.9072,.9101,.9129,.9153,.9174,.9193,.9212,2041.
2245 5.9227,.9242,.9254,.9266,.9275,.9284,.864245 ,.864245 / 2042.
2246 DATA PFRI/ 2043.
2247 1.4950,.5300,.5620,.5882,.6088,.6302,.6537,.6763,.6969,.7157,.7332,2044.
2248 2.7499,.7658,.7806,.7945,.8074,.8194,.8306,.8409,.8504,.8592,.8674,2045.
2249 3.8751,.8822,.8886,.8946,.9000,.9050,.9097,.9139,.9177,.9210,.9246,2046.
2250 4.9280,.9313,.9343,.9371,.9394,.9415,.9438,.9458,.9475,.9488,.9500,2047.
2251 5.9507,.9515,.9529,.9532,.9538,.9541,.876178 ,.876178 / 2048.
2252 DATA PI0C/.66,.91,.975,.99,.995,.999,.999,.999,.999,.999,.999, 2049.
2253 + .999,.9999,.99999/ 2050.
2254 DATA DKS0/.01,.03,.04,.04,.04,.002,.004,.013,.002,.003,.003, 2051.
2255 + .072,.20,.53/ 2052.
2256 DIMENSION DBLN(20), KSLAM(14), CPFFL(40) 2053.
2257 DATA DBLN/2.,4.,8.,16.,32.,64.,128.,256.,512.,1024.,2048.,4096., 2054.
2258 + 8192.,16384.,32768.,65536.,131072.,262144.,524288.,1048576./ 2055.
2259 DATA NKSLAM/14/, KSLAM/1,1,2,2,5,5,5,5,1,1,1,3,4,6/ 2056.
2260 DATA XCMNO2/5.465/ 2057.
2261 DATA XCMO3/.0399623/ 2058.
2262 DATA TOTRAY/0.000155/ 2059.
2263 C 2060.
2264 DIMENSION SRBALB(6),SRXALB(6) 2061.
2265 EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 2062.
2266 C 2063.
2267 EQUIVALENCE 2064.
2268 + (BXA(1),BOCVIS),(BXA(5),BEAVIS),(BXA( 9),BOIVIS),(BXA(13),BLIVIS)2065.
2269 +,(BXA(2),BOCNIR),(BXA(6),BEANIR),(BXA(10),BOINIR),(BXA(14),BLINIR)2066.
2270 +,(BXA(3),XOCVIS),(BXA(7),XEAVIS),(BXA(11),XOIVIS),(BXA(15),XLIVIS)2067.
2271 +,(BXA(4),XOCNIR),(BXA(8),XEANIR),(BXA(12),XOINIR),(BXA(16),XLINIR)2068.
2272 +, (BXA(17),EXPSNE),(BXA(18),EXPSNO),(BXA(19),EXPSNL)2069.
2273 +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 2070.
2274 +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 2071.
2275 C 2072.
2276 EQUIVALENCE (SRXATM(1),SRXVIS),(SRXATM(2),SRXNIR) 2073.
2277 EQUIVALENCE (SRXATM(3),XXAVIS),(SRXATM(4),XXANIR) 2074.
2278 C 2075.
2279 EQUIVALENCE (ISPARE(1),NEWASZ) 2075.5
2280 C 2076.
2281 C-----------------------------------------------------------------------2077.
2282 C SOLAR: NET FLUX AT GROUND FOR FRACTIONAL GRID SURFACE ALBEDOS 2078.
2283 C 2079.
2284 C PFNFG(DT,XA,RSA,RX,RB)=(DT*(1.-RB)-XA*(RX-RB)*(1.-RSA)) 2080.
2285 C + /(1.-RSA*RB) 2081.
2286 C-----------------------------------------------------------------------2082.
2287 C 2083.
2288 C 2084.
2289 C O3ABS(X)= 1.08173*X/(1.00+ 2085.
2290 C $ 138.57*X)**0.805 + 0.0658*X/(1.00+(103.63*X)**3) 2086.
2291 C 2087.
2292 S0COSZ=S0 2088.
2293 IF(NORMS0.EQ.0) S0COSZ=S0*COSZ 2089.
2294 C 2090.
2295 DO 10 N=1,NLP 2091.
2296 SRNFLB(N)=0. 2092.
2297 SRDFLB(N)=0. 2093.
2298 SRUFLB(N)=0. 2094.
2299 SRFHRL(N)=0. 2095.
2300 10 CONTINUE 2096.
2301 SRIVIS=0. 2097.
2302 SROVIS=0. 2098.
2303 SRINIR=0. 2099.
2304 SRONIR=0. 2100.
2305 SRDVIS=0. 2101.
2306 SRUVIS=0. 2102.
2307 SRDNIR=0. 2103.
2308 SRUNIR=0. 2104.
2309 SRTVIS=0. 2105.
2310 SRAVIS=0. 2106.
2311 SRTNIR=0. 2107.
2312 SRANIR=0. 2108.
2313 SRSLHR=0. 2109.
2314 PLAVIS=1. 2110.
2315 PLANIR=1. 2111.
2316 ALBVIS=1. 2112.
2317 ALBNIR=1. 2113.
2318 SRRVIS=1. 2114.
2319 SRRNIR=0. 2115.
2320 SRTNIR=0. 2116.
2321 SRXVIS=0. 2117.
2322 SRXNIR=0. 2118.
2323 C 2119.
2324 XXVIS=.53/(1.-SRBALB(6)) 2120.
2325 XXNIR=.47/(1.-SRBALB(5)) 2121.
2326 DO 20 N=1,4 2122.
2327 20 FSRNFG(N)=XXVIS*(1.-BXA(4*N-3))+XXNIR*(1.-BXA(4*N-2)) 2123.
2328 C 2124.
2329 IF(COSZ.LT.0.01) RETURN 2125.
2330 COSMAG=35.0/SQRT(1224.*COSZ*COSZ+1.0) 2126.
2331 TAURAY=TOTRAY*FRAYLE 2127.
2332 CPF=49.999/COSMAG 2128.
2333 IPF=CPF 2129.
2334 DPF=CPF-IPF 2130.
2335 IF(ISOSCT.EQ.1) IPF=51 2131.
2336 CPFF=(1.0-DPF)*PFR(IPF)+DPF*PFR(IPF+1) 2132.
2337 CPFFI=(1.0-DPF)*PFRI(IPF)+DPF*PFRI(IPF+1) 2133.
2338 SECZ=1./COSZ 2134.
2339 DO 100 N=1,NL 2135.
2340 CPFFL(N)=CPFF 2136.
2341 IF(TLM(N).LT.TKCICE) CPFFL(N)=CPFFI 2137.
2342 100 CONTINUE 2138.
2343 C 2139.
2344 K = 0 2140.
2345 300 K = K+1 2141.
2346 C 2142.
2347 KLAM=KSLAM(K) 2143.
2348 DKS0K=DKS0(K) 2144.
2349 DKS0X=DKS0K*S0COSZ 2145.
2350 RBNB=SRBALB(KLAM) 2146.
2351 RBNX=SRXALB(KLAM) 2147.
2352 RCNB=0.0 2148.
2353 RCNX=0.0 2149.
2354 C 2150.
2355 N = 0 2151.
2356 200 N = N+1 2152.
2357 C 2153.
2358 CPFF=CPFFL(N) 2154.
2359 SRB(N)=RBNB 2155.
2360 SRX(N)=RBNX 2156.
2361 TLN=TLM(N) 2157.
2362 PLN=PL(N) 2158.
2363 ULN=ULGAS(N,1) 2159.
2364 RTAU=1.E-06 2160.
2365 GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114),K 2161.
2366 101 CONTINUE 2162.
2367 C--------K=6-------H2O DS0=.01 2163.
2368 TERMA=(35.66+TLN*(.0416-.0004622*TLN+.001057*PLN))*(1.+.04286*PLN)2164.
2369 TERMB=(1.+.00171*ULN)*(1.+PLN*(189.088+.1316*PLN)) 2165.
2370 TAU1 =TERMA/TERMB 2166.
2371 IF(TAU1.GT.0.02343) TAU1=0.02343 2167.
2372 TAU=TAU1*ULN 2168.
2373 GO TO 120 2169.
2374 102 CONTINUE 2170.
2375 C--------K=5-------H2O DS0=.03 2171.
2376 TERMA=(2.792+TLN*(.0914-.0002848*TLN+.0003395*PLN)) 2172.
2377 + *(1.+.02964*PLN) 2173.
2378 TERMB=(1.0+.000657*ULN)*(1.+PLN*(240.70+.13847*PLN)) 2174.
2379 TAU1 =TERMA/TERMB 2175.
2380 IF(TAU1.GT.0.00520) TAU1=0.00520 2176.
2381 TAU=TAU1*ULN 2177.
2382 GO TO 120 2178.
2383 103 CONTINUE 2179.
2384 C--------K=4-------H2O DS0=.04 2180.
2385 TERMA=(.4768+.467E-04*PLN*TLN)*(1.+TLN*(.00191-.719E-05*TLN)) 2181.
2386 TERMB=(1.+.717E-04*ULN)*(1.+PLN*(130.56+.0876*PLN))/(1.+.0266*PLN)2182.
2387 TAU1 =TERMA/TERMB 2183.
2388 IF(TAU1.GT.0.00150) TAU1=0.0015 2184.
2389 TAU=TAU1*ULN 2185.
2390 GO TO 120 2186.
2391 104 CONTINUE 2187.
2392 C--------K=3-------H2O DS0=.04 2188.
2393 TERMA=(.000247*TLN-.091+PLN*(.00035+.78E-06*TLN))*(1.+.2847*PLN) 2189.
2394 TERMB=(1.+.2066E-04*ULN)*(1.+PLN*(137.17+.16132*PLN)) 2190.
2395 TAU =(TERMA/TERMB)*ULN 2191.
2396 GO TO 120 2192.
2397 105 CONTINUE 2193.
2398 C--------K=2-------H2O DS0=.04 2194.
2399 TERMA=(PLN*(1.974/TLN+.0001117*TLN)-10.713)*(1.+.005788*TLN) 2195.
2400 + *(1.+.001517*PLN) 2196.
2401 TERMB=(1.+.3218E-04*ULN)*(1.+PLN*(863.44+.2048*PLN)) 2197.
2402 TAU =(TERMA/TERMB)*ULN 2198.
2403 GO TO 120 2199.
2404 106 CONTINUE 2200.
2405 C--------K=4-------O2 DS0=.002 2201.
2406 ULN=ULGAS(N,4) 2202.
2407 TERMA=(.2236E-05-.1181E-09*TLN)*(1.+PLN*(.6364E-05*PLN+.001168)) 2203.
2408 TERMB=1.+.1521E-05*ULN 2204.
2409 TAU =(TERMA/TERMB)*ULN 2205.
2410 GO TO 120 2206.
2411 107 CONTINUE 2207.
2412 C--------K=3-------O2 DS0=.004 2208.
2413 ULN=ULGAS(N,4) 2209.
2414 TERMA=(.3179E-06-.9263E-11*TLN)*(1.+PLN*(.8832E-05*PLN+.0005292)) 2210.
2415 TERMB=1.+.1968E-06*ULN 2211.
2416 TAU =(TERMA/TERMB)*ULN 2212.
2417 GO TO 120 2213.
2418 108 CONTINUE 2214.
2419 C--------K=2-------O2 DS0=.013 2215.
2420 ULN=ULGAS(N,4) 2216.
2421 TERMA=(.2801E-07-.1638E-12*TLN)*(1.+PLN*(.1683E-04*PLN-.001721)) 2217.
2422 TERMB=1.+.8097E-07*ULN 2218.
2423 TAU =(TERMA/TERMB)*ULN 2219.
2424 GO TO 120 2220.
2425 109 CONTINUE 2221.
2426 C--------K=4-------CO2 DS0=.002 2222.
2427 ULN=ULGAS(N,2) 2223.
2428 TERMA=(50.73-.03155*TLN-PLN*(.5543+.00091*TLN))*(1.-.1004*PLN) 2224.
2429 TERMB=(1.+.006468*ULN)*(1.+PLN*(49.51+.8285*PLN)) 2225.
2430 TAU =(TERMA/TERMB)*ULN 2226.
2431 IF(PLN.LT.175.0) TAU=(.00018*PLN+0.00001)*ULN 2227.
2432 GO TO 120 2228.
2433 110 CONTINUE 2229.
2434 C--------K=3-------CO2 DS0=.003 2230.
2435 ULN=ULGAS(N,2) 2231.
2436 TERMA=(1.+.01319*TLN)*(PLN*(.008001*ULN+.4589E-03)-.8396*ULN) 2232.
2437 TERMB=ULN*(PLN+295.7+1.967*ULN)+.15126*PLN 2233.
2438 TAU =(TERMA/TERMB)*ULN 2234.
2439 GO TO 120 2235.
2440 111 CONTINUE 2236.
2441 C--------K=2-------CO2 DS0=.003 2237.
2442 ULN=ULGAS(N,2) 2238.
2443 TERMA=(1.+.02257*TLN)*(PLN*(.002295*ULN-.5489E-04)-.7571*ULN) 2239.
2444 TERMB=ULN*(PLN+803.9+2.477*ULN)-.09899*PLN 2240.
2445 TAU =(TERMA/TERMB)*ULN 2241.
2446 GO TO 120 2242.
2447 112 CONTINUE 2243.
2448 TAU=0.0 2244.
2449 GO TO 120 2245.
2450 113 CONTINUE 2246.
2451 TAU=0.0 2247.
2452 GO TO 120 2248.
2453 114 CONTINUE 2249.
2454 TAU=XCMNO2*ULGAS(N,5)+XCMO3*ULGAS(N,3) 2250.
2455 RTAU=TAURAY*(PLB(N)-PLB(N+1)) 2251.
2456 120 CONTINUE 2252.
2457 IF(TAU.LT.0.0) TAU=0.0 2253.
2458 CTAU=CLDTAU(N)*FCLDSR 2254.
2459 CPI0=PI0C(K) 2255.
2460 ATAU=EXTAER(N,KLAM) 2256.
2461 TAU=TAU+CTAU+ATAU+RTAU 2257.
2462 IF(TAU.LT.TAUMIN) GO TO 180 2258.
2463 CTAUSC=CPI0*CTAU 2259.
2464 ATAUSC=SCTAER(N,KLAM) 2260.
2465 TAUSCT=CTAUSC+ATAUSC+RTAU 2261.
2466 PIZERO=TAUSCT/TAU 2262.
2467 IF(PIZERO.GT.0.001) GO TO 130 2263.
2468 GO TO 180 2264.
2469 130 CONTINUE 2265.
2470 APFF=COSAER(N,KLAM) 2266.
2471 APFF0=APFF 2266.1
2472 IF(NEWASZ.GT.0) CALL HGAER1(COSZ,ATAUSC,APFF0,APFF) 2266.2
2473 PFF=(CPFF*CTAUSC+APFF*ATAUSC)/TAUSCT 2267.
2474 IF(ISOSCT.GT.1) GO TO 131 2268.
2475 GO TO 132 2269.
2476 131 TAU=TAU-TAUSCT*PFF 2270.
2477 PIZERO=PIZERO*(1.-PFF)/(1.-PIZERO*PFF) 2271.
2478 PFF=0. 2272.
2479 132 CONTINUE 2273.
2480 PR=1.0-PFF 2274.
2481 PT=1.0+PFF 2275.
2482 IF(TAU.LT.0.015625) GO TO 140 2276.
2483 C ALOG
2484 DBLS=7.001+1.44269*LOG(TAU) 2277.
2485 C ALOG
2486 NDBLS=DBLS 2278.
2487 TAU=TAU/DBLN(NDBLS) 2279.
2488 GO TO 150 2280.
2489 140 XANB=EXP(-TAU-TAU) 2281.
2490 XANX=EXP(-TAU*SECZ) 2282.
2491 TANB=PT*XANB 2283.
2492 XXT=(SECZ-2.0)*TAU 2284.
2493 TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2285.
2494 RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2286.
2495 XXT=(SECZ+2.0)*TAU 2287.
2496 RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2288.
2497 BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2289.
2498 XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2290.
2499 RASB=RASB*BNORM 2291.
2500 RASX=RASX*XNORM 2292.
2501 TANB=TANB*BNORM 2293.
2502 TANX=TANX*XNORM 2294.
2503 GO TO 170 2295.
2504 150 XANB=EXP(-TAU-TAU) 2296.
2505 XANX=EXP(-TAU*SECZ) 2297.
2506 TANB=PT*XANB 2298.
2507 XXT=(SECZ-2.0)*TAU 2299.
2508 TANX=PT*SECZ*(.5+XXT*(.25+XXT*(.0833333+XXT*(.0208333+XXT))))*XANX2300.
2509 RASB=PR*(1.0-TAU*(2.0-2.66667*TAU*(1.0-TAU))) 2301.
2510 XXT=(SECZ+2.0)*TAU 2302.
2511 RASX=PR*SECZ*(.5-XXT*(.25-XXT*(.0833333-XXT*(.0208333-XXT)))) 2303.
2512 BNORM=(1.0-XANB)/(RASB+TANB)*PIZERO 2304.
2513 XNORM=(1.0-XANX)/(RASX+TANX)*PIZERO 2305.
2514 RASB=RASB*BNORM 2306.
2515 RASX=RASX*XNORM 2307.
2516 TANB=TANB*BNORM 2308.
2517 TANX=TANX*XNORM 2309.
2518 DO 160 NN=1,NDBLS 2310.
2519 RARB=RASB*RASB 2311.
2520 RARX=XANX*RASX 2312.
2521 XATB=XANB+TANB 2313.
2522 DENOM=1.0-RARB 2314.
2523 DB=(TANB+XANB*RARB)/DENOM 2315.
2524 DX=(TANX+RARX*RASB)/DENOM 2316.
2525 UB=RASB*(XANB+DB) 2317.
2526 UX=RARX+RASB*DX 2318.
2527 RASB=RASB+XATB*UB 2319.
2528 RASX=RASX+XATB*UX 2320.
2529 TANB=XANB*TANB+XATB*DB 2321.
2530 TANX=XANX*TANX+XATB*DX 2322.
2531 XANB=XANB*XANB 2323.
2532 XANX=XANX*XANX 2324.
2533 160 CONTINUE 2325.
2534 170 RARB=RASB*RBNB 2326.
2535 RARX=RASB*RBNX 2327.
2536 XATB=XANB+TANB 2328.
2537 DENOM=1.0-RARB 2329.
2538 DB=(TANB+XANB*RARB)/DENOM 2330.
2539 DX=(TANX+XANX*RARX)/DENOM 2331.
2540 UB=RBNB*(XANB+DB) 2332.
2541 UX=RBNX*XANX+RBNB*DX 2333.
2542 RBNB=RASB+XATB*UB 2334.
2543 RBNX=RASX+XATB*UX 2335.
2544 XATC=XATB/(1.0-RASB*RCNB) 2336.
2545 RCNX=RASX+(XANX*RCNX+TANX*RCNB)*XATC 2337.
2546 RCNB=RASB+RCNB*XATB*XATC 2338.
2547 GO TO 190 2339.
2548 180 RASB=0.0 2340.
2549 RASX=0.0 2341.
2550 TANB=0.0 2342.
2551 TANX=0.0 2343.
2552 XANB=EXP(-TAU-TAU) 2344.
2553 XANX=EXP(-TAU*SECZ) 2345.
2554 DX=0.0 2346.
2555 UX=RBNX*XANX 2347.
2556 RBNB=RBNB*XANB*XANB 2348.
2557 RBNX=UX*XANB 2349.
2558 RCNB=RCNB*XANB*XANB 2350.
2559 RCNX=RCNX*XANX*XANB 2351.
2560 190 RNB(N)=RASB 2352.
2561 RNX(N)=RASX 2353.
2562 TNB(N)=TANB 2354.
2563 TNX(N)=TANX 2355.
2564 XNB(N)=XANB 2356.
2565 XNX(N)=XANX 2357.
2566 IF(N.LT.NL) GO TO 200 2358.
2567 C 2359.
2568 IF(K.EQ.NKSLAM) GO TO 301 2360.
2569 SRDFLB(NLP)=SRDFLB(NLP)+DKS0X 2361.
2570 SRUFLB(NLP)=SRUFLB(NLP)+DKS0X*RBNX 2362.
2571 SRDFLB(NL)=SRDFLB(NL)+DKS0X*(XANX+DX) 2363.
2572 SRUFLB(NL)=SRUFLB(NL)+DKS0X*UX 2364.
2573 RMEAN=RBNX 2365.
2574 DO 230 M=2,NL 2366.
2575 N=NLP-M 2367.
2576 XBNB=XNB(N) 2368.
2577 XBNX=XNX(N) 2369.
2578 RBNX=RNX(N) 2370.
2579 IF(RBNX.GT.1.E-05) GO TO 210 2371.
2580 RASB=RASB*XBNB*XBNB 2372.
2581 TANX=TANX*XBNB 2373.
2582 GO TO 220 2374.
2583 210 RBNB=RNB(N) 2375.
2584 TBNB=TNB(N) 2376.
2585 TBNX=TNX(N) 2377.
2586 RARB=RASB*RBNB 2378.
2587 XBTB=XBNB+TBNB 2379.
2588 DENOM=1.0-RARB 2380.
2589 TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2381.
2590 RASB=RBNB+XBTB*XBTB*RASB/DENOM 2382.
2591 220 XANX=XANX*XBNX 2383.
2592 RBNB=SRB(N) 2384.
2593 RBNX=SRX(N) 2385.
2594 DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2386.
2595 UX=RBNX*XANX+RBNB*DX 2387.
2596 SRUFLB(N)=SRUFLB(N)+DKS0X*UX 2388.
2597 230 SRDFLB(N)=SRDFLB(N)+DKS0X*(XANX+DX) 2389.
2598 SRRNIR=SRRNIR+DKS0K*RCNX 2390.
2599 SRTNIR=SRTNIR+DKS0K*(TANX+XANX) 2391.
2600 SRXNIR=SRXNIR+DKS0K*XANX 2392.
2601 GO TO 300 2393.
2602 C 2394.
2603 301 CONTINUE 2395.
2604 SRTNIR=SRTNIR/0.459 2396.
2605 SRRNIR=SRRNIR/0.459 2397.
2606 SRXNIR=SRXNIR/0.459 2398.
2607 SRANIR=1.0-SRTNIR-SRRNIR 2399.
2608 C 2400.
2609 VRD(NLP)=DKS0X 2401.
2610 VRU(NLP)=DKS0X*RBNX 2402.
2611 O3PATH=(1.9+XANX*(COSMAG-1.9))*ULGAS(NL,3) 2403.
2612 ATOP=0. 2404.
2613 ABOT=O3ABS(O3PATH) 2405.
2614 ASUM=(ABOT-ATOP)*XANX 2406.
2615 O3A(NL)=ASUM*S0COSZ 2407.
2616 ATOP=ABOT 2408.
2617 VRD(NL)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2409.
2618 VRU(NL)=DKS0X*UX 2410.
2619 FAC(NL)=UX 2411.
2620 RMEAN=RBNX 2412.
2621 N=NL 2413.
2622 305 N=N-1 2414.
2623 XBNB=XNB(N) 2415.
2624 XBNX=XNX(N) 2416.
2625 RBNX=RNX(N) 2417.
2626 IF(RBNX.GT.1.E-05) GO TO 310 2418.
2627 RASB=RASB*XBNB*XBNB 2419.
2628 TANX=TANX*XBNB 2420.
2629 GO TO 320 2421.
2630 310 RBNB=RNB(N) 2422.
2631 TBNB=TNB(N) 2423.
2632 TBNX=TNX(N) 2424.
2633 RARB=RASB*RBNB 2425.
2634 XBTB=XBNB+TBNB 2426.
2635 DENOM=1.0-RARB 2427.
2636 TANX=TBNX*XANX+XBTB*(TANX+XANX*RBNX*RASB)/DENOM 2428.
2637 RASB=RBNB+XBTB*XBTB*RASB/DENOM 2429.
2638 320 XANX=XANX*XBNX 2430.
2639 RBNB=SRB(N) 2431.
2640 RBNX=SRX(N) 2432.
2641 DX=(TANX+XANX*RBNX*RASB)/(1.0-RASB*RBNB) 2433.
2642 UX=RBNX*XANX+RBNB*DX 2434.
2643 FAC(N)=UX 2435.
2644 VRU(N)=DKS0X*UX 2436.
2645 O3PATH=O3PATH+(1.9+XANX*(COSMAG-1.9))*ULGAS(N,3) 2437.
2646 ABOT=O3ABS(O3PATH) 2438.
2647 ASUM=ASUM+(ABOT-ATOP)*XANX 2439.
2648 ATOP=ABOT 2440.
2649 VRD(N)=DKS0X*(XANX+DX)-ASUM*S0COSZ 2441.
2650 O3A(N)=ASUM*S0COSZ 2442.
2651 IF(N.GT.1) GO TO 305 2443.
2652 C 2444.
2653 O3SUM=0. 2445.
2654 DO 324 I=1,NL 2446.
2655 324 O3SUM=O3SUM+ULGAS(I,3) 2447.
2656 SRXVIS=XANX*(1.-O3ABS(COSMAG*O3SUM)/0.53) 2448.
2657 SRTVIS=TANX+XANX-ASUM/DKS0K 2449.
2658 RGRND=UX/(XANX+DX+1.E-05) 2450.
2659 IF(RGRND.GT.1.0) RGRND=1.0 2451.
2660 ASUM=ASUM*RGRND 2452.
2661 VRU(N)=VRU(N)-ASUM*S0COSZ 2453.
2662 325 CONTINUE 2454.
2663 O3PATH=O3PATH+1.9*ULGAS(N,3) 2455.
2664 ATOP=O3ABS(O3PATH) 2456.
2665 ASUM=ASUM+(ATOP-ABOT)*FAC(N) 2457.
2666 ABOT=ATOP 2458.
2667 N=N+1 2459.
2668 VRU(N)=VRU(N)-ASUM*S0COSZ 2460.
2669 IF(N.LT.NLP) GO TO 325 2461.
2670 SRRVIS=RCNX-ASUM/DKS0K 2462.
2671 SRAVIS=1.0-SRRVIS-SRTVIS 2463.
2672 TFU=VRU(NLP) 2464.
2673 BFU=VRU(1) 2465.
2674 IF(BFU.GE.0.) GO TO 327 2466.
2675 DO 326 N=1,NLP 2467.
2676 326 VRU(N)=(VRU(N)-BFU)*(TFU/(TFU-BFU)) 2468.
2677 BFU=VRU(1) 2469.
2678 327 BFD=VRD(1) 2470.
2679 IF(BFD.GT.BFU) GO TO 329 2471.
2680 TFD=VRD(NLP) 2472.
2681 BFUD=BFU/TFD 2473.
2682 TFDD=TFD/(TFD-BFD) 2474.
2683 DO 328 N=1,NLP 2475.
2684 328 VRD(N)=(VRD(N)*(1.-BFUD)-BFD+BFUD*TFD)*TFDD 2476.
2685 329 SRDVIS=VRD(1) 2477.
2686 SRUVIS=VRU(1) 2478.
2687 ALBVIS=SRUVIS/(SRDVIS+1.E-10) 2479.
2688 TAU1=0. 2480.
2689 SRIVIS=VRD(NLP) 2481.
2690 SROVIS=VRU(NLP) 2482.
2691 PLAVIS=SROVIS/SRIVIS 2483.
2692 C 2484.
2693 TAU2=0. 2485.
2694 TAU3=0. 2486.
2695 TRN1=0. 2487.
2696 TRN2=0. 2488.
2697 TRN3=0. 2489.
2698 N=NLP 2490.
2699 C 2491.
2700 C THE FOLLOWING IS CONSIDERED PART OF THE NEAR-IR SPECTRUM 2492.
2701 C -------------------------------------------------------- 2493.
2702 DO 330 M=1,NL 2494.
2703 N=N-1 2495.
2704 PLN=PL(N) 2496.
2705 ULN=ULGAS(N,2)*SECZ 2497.
2706 ULX=ULN 2498.
2707 IF(ULN.GT.7.0) ULN=7.0 2499.
2708 C--------K=5-------CO2 DS0=.002 2500.
2709 TERMA=.003488*PLN*(1.+39.59*EXP(-8.769*ULN/(1.+4.419*ULN))) 2501.
2710 + *(1.+ULN*(.001938*PLN-.00503*ULN)) 2502.
2711 TERMB=(1.+.04712*PLN*(1.+.4877*ULN)) 2503.
2712 TAU=TERMA/TERMB 2504.
2713 IF(TAU.LT.1.E-06) TAU=1.E-06 2505.
2714 TAU1=TAU1+TAU*ULX 2506.
2715 ULN=ULGAS(N,1)*SECZ 2507.
2716 C--------K=7-------H2O DS0=.01(DS0=.008 + DS0=.002 CO2 OVERLAP) 2508.
2717 TERMA=.001582*PLN*(1.+6.769*EXP(-9.59*ULN/(1.+5.026*ULN))) 2509.
2718 + *(1.+ULN*(.2757E-03*PLN+.001429*ULN)) 2510.
2719 TERMB=(1.+.003683*PLN*(1.+1.187*ULN)) 2511.
2720 TAU2=TAU2+(TERMA/TERMB)*ULN 2512.
2721 ULN=ULGAS(N,4)*SECZ 2513.
2722 C--------K=5-------O2 DS0=.001 2514.
2723 TERMA=(.1366E-03-.2203E-07*TLN)*(1.+PLN*(.1497E-06*ULN+.001261)) 2515.
2724 TERMB=(1.+.3867E-03*ULN)/(1.+.2075E-04*ULN) 2516.
2725 TAU3=TAU3+(TERMA/TERMB)*ULN 2517.
2726 IF(TAU1.LT.10.0) TRN1=EXP(-TAU1) 2518.
2727 IF(TAU2.LT.10.0) TRN2=EXP(-TAU2) 2519.
2728 IF(TAU3.LT.10.0) TRN3=EXP(-TAU3) 2520.
2729 FAC(N)=.004358*TRN1+.01743*TRN2+.00218*TRN3 2521.
2730 330 SRDFLB(N)=SRDFLB(N)+SRDFLB(N)*FAC(N) 2522.
2731 FAC(NLP)=.023968 2523.
2732 SRDFLB(NLP)=SRDFLB(NLP)+SRDFLB(NLP)*FAC(NLP) 2524.
2733 DO 340 N=1,NLP 2525.
2734 340 SRUFLB(N)=SRUFLB(N)+SRUFLB(N)*FAC(1) 2526.
2735 SRINIR=SRDFLB(NLP) 2527.
2736 SRONIR=SRUFLB(NLP) 2528.
2737 PLANIR=SRONIR/SRINIR 2529.
2738 SRDNIR=SRDFLB(1) 2530.
2739 SRUNIR=SRUFLB(1) 2531.
2740 ALBNIR=SRUNIR/(SRDNIR+1.E-10) 2532.
2741 DO 350 N=1,NLP 2533.
2742 SRDFLB(N)=SRDFLB(N)+VRD(N) 2534.
2743 SRUFLB(N)=SRUFLB(N)+VRU(N) 2535.
2744 350 SRNFLB(N)=SRDFLB(N)-SRUFLB(N) 2536.
2745 DO 360 N=1,NL 2537.
2746 360 SRFHRL(N)=SRNFLB(N+1)-SRNFLB(N) 2538.
2747 SRSLHR=FRACSL*SRFHRL(1) 2539.
2748 C 2540.
2749 C--------------------------------- 2541.
2750 CALL O2HEAT(FAC,COSZ,S0COSZ) 2542.
2751 C--------------------------------- 2543.
2752 C 2544.
2753 DO 500 L=1,NL 2545.
2754 500 SRFHRL(L)=SRFHRL(L)+FAC(L) 2546.
2755 L=NLP 2547.
2756 DO 510 N=1,NL 2548.
2757 L=L-1 2549.
2758 IF(PLB(L).GT.0.09) GO TO 520 2550.
2759 510 SRFHRL(L)=FAC(L)+O3A(L) 2551.
2760 520 CONTINUE 2552.
2761 C I=NLP+1-II 2553.
2762 C 2554.
2763 C-----------------------------------------------------------------------2555.
2764 C SOLAR NET FLUX (SRNFLB(1)) DISTRIBUTION ACCORDING TO SURFACE TYPE 2556.
2765 CR NOT USED AND NOT SAFE (CAUSES DIVIDE CHECKS) 2556.1
2766 C-----------------------------------------------------------------------2557.
2767 CR FSRVIS=0.53 2558.
2768 CR FSRNIR=0.47 2559.
2769 C 2560.
2770 CR RASVIS=0. 2561.
2771 CR IF(SRUVIS.GT.1.E-03) RASVIS=(SRDVIS-SRTVIS*SRIVIS)/SRUVIS 2562.
2772 CR XXAVIS=0. 2563.
2773 CR DENOM=SRIVIS*(SRXALB(6)-SRBALB(6)) 2564.
2774 CR IF(ABS(DENOM).GT.1.E-03) XXAVIS=(SRUVIS-SRDVIS*SRBALB(6))/DENOM 2565.
2775 C$ PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.
2776 CR IF(SRIVIS.GT.1.E-03) PNFVIS=(SRDVIS-SRUVIS)/SRIVIS 2566.11
2777 CR RASNIR=0. 2567.
2778 CR IF(PNFVIS.LT.1.E-03) RETURN 2568.
2779 CR IF(SRUNIR.GT.1.E-03) RASNIR=(SRDNIR-SRTNIR*SRINIR)/SRUNIR 2569.
2780 CR XXANIR=0. 2570.
2781 CR DENOM=SRINIR*(SRXALB(5)-SRBALB(5)) 2571.
2782 CR IF(ABS(DENOM).GT.1.E-03) XXANIR=(SRUNIR-SRDNIR*SRBALB(5))/DENOM 2572.
2783 C$ PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.
2784 CR IF(SRINIR.GT.1.E-03) PNFNIR=(SRDNIR-SRUNIR)/SRINIR 2573.11
2785 CR IF(PNFNIR.LT.1.E-03) RETURN 2574.
2786 C 2575.
2787 CR FNSROC=0. 2576.
2788 CR IF(POCEAN.LT.1.E-04) GO TO 601 2577.
2789 CR POCVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOCVIS,BOCVIS) 2578.
2790 CR POCNIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOCVIS,BOCVIS) 2579.
2791 CR FNSROC=(FSRVIS*POCVIS/PNFVIS+FSRNIR*POCNIR/PNFNIR) 2580.
2792 C 2581.
2793 CR601 FNSREA=0. 2582.
2794 CR IF(PEARTH.LT.1.E-04) GO TO 602 2583.
2795 CR PEAVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XEAVIS,BEAVIS) 2584.
2796 CR PEANIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XEANIR,BEANIR) 2585.
2797 CR FNSREA=(FSRVIS*PEAVIS/PNFVIS+FSRNIR*PEANIR/PNFNIR) 2586.
2798 C 2587.
2799 CR602 FNSROI=0. 2588.
2800 CR IF(POICE .LT.1.E-04) GO TO 603 2589.
2801 CR POIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XOIVIS,BOIVIS) 2590.
2802 CR POINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XOINIR,BOINIR) 2591.
2803 CR FNSROI=(FSRVIS*POIVIS/PNFVIS+FSRNIR*POINIR/PNFNIR) 2592.
2804 C 2593.
2805 CR603 FNSRLI=0. 2594.
2806 CR IF(PLICE .LT.1.E-04) GO TO 604 2595.
2807 CR PLIVIS=PFNFG(SRTVIS,SRXVIS,RASVIS,XLIVIS,BLIVIS) 2596.
2808 CR PLINIR=PFNFG(SRTNIR,SRXNIR,RASNIR,XLINIR,BLINIR) 2597.
2809 CR FNSRLI=(FSRVIS*PLIVIS/PNFVIS+FSRNIR*PLINIR/PNFNIR) 2598.
2810 C 2599.
2811 CR604 FNORM=FNSROC*POCEAN+FNSREA*PEARTH+FNSROI*POICE+FNSRLI*PLICE 2600.
2812 C 2601.
2813 CR FSRNFG(1)=FNSROC/FNORM 2602.
2814 CR FSRNFG(2)=FNSREA/FNORM 2603.
2815 CR FSRNFG(3)=FNSROI/FNORM 2604.
2816 CR FSRNFG(4)=FNSRLI/FNORM 2605.
2817 C 2606.
2818 RETURN 2607.
2819 END 2608.
2820 SUBROUTINE SETAO2(O2CMA,NL) 2609.
2821 DIMENSION O2CMA(40),O2FHRL(40) 2610.
2822 DIMENSION SFWM2(18),SIGMA(18,6) 2611.
2823 DATA SFWM2/ 2612.
2824 A 2.196E-03, 0.817E-03, 1.163E-03, 1.331E-03, 1.735E-03, 1.310E-03,2613.
2825 B 1.311E-03, 2.584E-03, 2.864E-03, 4.162E-03, 5.044E-03, 6.922E-03,2614.
2826 C 6.906E-03,10.454E-03, 5.710E-03, 6.910E-03,14.130E-03,18.080E-03/2615.
2827 DATA SIGMA/ 2616.
2828 A 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2.74E-19, 2617.
2829 B 4.33E-21, 4.89E-21, 6.63E-21, 1.60E-20, 7.20E-20, 1.59E-18, 2618.
2830 C 2.10E-21, 2.32E-21, 3.02E-21, 6.30E-21, 3.46E-20, 7.52E-19, 2619.
2831 D 5.95E-22, 9.72E-22, 2.53E-21, 7.57E-21, 7.38E-20, 7.44E-19, 2620.
2832 E 3.33E-22, 1.02E-22, 4.09E-21, 1.63E-20, 8.79E-20, 3.81E-19, 2621.
2833 F 1.09E-21, 1.16E-21, 1.45E-21, 3.32E-21, 2.00E-20, 4.04E-19, 2622.
2834 G 1.15E-21, 1.30E-21, 1.90E-21, 4.89E-21, 2.62E-20, 4.08E-19, 2623.
2835 H 3.90E-22, 4.90E-22, 9.49E-22, 3.33E-21, 2.14E-20, 2.39E-19, 2624.
2836 I 1.29E-22, 2.18E-22, 8.28E-22, 3.46E-21, 1.94E-20, 1.06E-19, 2625.
2837 J 6.26E-23, 7.80E-23, 2.62E-22, 1.83E-21, 1.25E-20, 3.95E-20, 2626.
2838 K 2.74E-23, 3.58E-23, 8.64E-23, 4.03E-22, 2.13E-21, 1.95E-20, 2627.
2839 L 1.95E-23, 2.44E-23, 4.89E-23, 2.87E-22, 1.95E-21, 1.36E-20, 2628.
2840 M 1.84E-23, 1.96E-23, 2.71E-23, 8.52E-23, 6.48E-22, 3.89E-21, 2629.
2841 N 1.80E-23, 1.81E-23, 1.87E-23, 2.69E-23, 1.34E-22, 1.52E-21, 2630.
2842 O 1.80E-23, 1.80E-23, 1.82E-23, 2.40E-23, 5.71E-23, 5.70E-22, 2631.
2843 P 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 1.76E-23, 3.50E-23, 2632.
2844 Q 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 1.71E-23, 2.68E-23, 2633.
2845 R 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23, 1.00E-23/ 2634.
2846 REAL WTKO2(6)/0.05,0.20,0.25,0.25,0.20,0.05/ 2635.
2847 C 2636.
2848 DATA STPMOL/2.68714E+19/,S00/1367.0/ 2637.
2849 DATA NW/18/,NZ/11/,NKO2/6/ 2638.
2850 DIMENSION ZTABLE(40,11) 2639.
2851 DIMENSION ZCOSJ(11) 2640.
2852 NLP=NL+1 2641.
2853 FSUM=0.0 2642.
2854 DO 100 I=1,NW 2643.
2855 100 FSUM=FSUM+SFWM2(I) 2644.
2856 DO 110 J=1,NZ 2645.
2857 110 ZTABLE(NLP,J)=FSUM 2646.
2858 SUMMOL=0.0 2647.
2859 DO 150 N=1,NL 2648.
2860 L=NLP-N 2649.
2861 SUMMOL=SUMMOL+O2CMA(L)*STPMOL 2650.
2862 DO 140 J=1,NZ 2651.
2863 ZCOS=0.01*(1/J)+0.1*(J-1) 2652.
2864 ZCOSJ(J)=ZCOS 2653.
2865 FSUM=0.0 2654.
2866 DO 130 I=1,NW 2655.
2867 WSUM=0.0 2656.
2868 DO 120 K=1,NKO2 2657.
2869 TAU=SIGMA(I,K)*SUMMOL/ZCOS 2658.
2870 IF(TAU.GT.30.0) TAU=30.0 2659.
2871 120 WSUM=WSUM+WTKO2(K)*EXP(-TAU) 2660.
2872 130 FSUM=FSUM+WSUM*SFWM2(I) 2661.
2873 140 ZTABLE(L,J)=FSUM 2662.
2874 150 CONTINUE 2663.
2875 DO 170 J=1,NZ 2664.
2876 DO 160 L=1,NL 2665.
2877 160 ZTABLE(L,J)=ZTABLE(L+1,J)-ZTABLE(L,J) 2666.
2878 170 CONTINUE 2667.
2879 RETURN 2668.
2880 C 2669.
2881 C--------------------------------- 2670.
2882 ENTRY O2HEAT(O2FHRL,COSZ,S0) 2671.
2883 C--------------------------------- 2672.
2884 C 2673.
2885 ZCOS=1.0+10.0*COSZ 2674.
2886 JI=ZCOS 2675.
2887 IF(JI.GT.10) JI=10 2676.
2888 JJ=JI+1 2677.
2889 WTJ=ZCOS-JI 2678.
2890 WTI=1.0-WTJ 2679.
2891 DO 200 L=1,NLP-1 2680.
2892 200 O2FHRL(L)=(WTI*ZTABLE(L,JI)+WTJ*ZTABLE(L,JJ))*S0/S00 2681.
2893 RETURN 2682.
2894 END 2683.
2895 FUNCTION O3ABS(OCM) 2684.
2896 c DOUBLE PRECISION O3UVAB 2684.1
2897 DIMENSION AO3(460) 2685.
2898 C 2686.
2899 IP=0 2687.
2900 XX=OCM*1.E+04 2688.
2901 IX=XX 2689.
2902 IF(IX.GT.99) GO TO 110 2690.
2903 IF(IX.LT.1 ) GO TO 130 2691.
2904 GO TO 120 2692.
2905 110 IP=IP+90 2693.
2906 XX=XX*0.1 2694.
2907 IX=XX 2695.
2908 IF(IX.GT.99) GO TO 110 2696.
2909 120 DX=XX-IX 2697.
2910 IX=IX+IP 2698.
2911 O3ABS=AO3(IX)+DX*(AO3(IX+1)-AO3(IX)) 2699.
2912 RETURN 2700.
2913 130 O3ABS=XX*AO3(1) 2701.
2914 RETURN 2702.
2915 C 2703.
2916 C---------------------- 2704.
2917 ENTRY SETAO3(OCM) 2705.
2918 C---------------------- 2706.
2919 C 2707.
2920 ! print *,'After 2707'
2921 DO 140 I=1,460 2708.
2922 II=(I-10)/90-4 2709.
2923 XX=I-((I-10)/90)*90 2710.
2924 ! print *,i,ii,xx
2925 ! OCM=XX*10.**II 2711.
2926 ! 05/14/2006
2927 OCM=XX*10.**float(II)
2928 ! print *,ocm
2929 ! 05/14/2006
2930 140 AO3(I)=O3UVAB(OCM) 2712.
2931 ! print *,'After 2712'
2932 O3ABS=1. 2713.
2933 RETURN 2714.
2934 END 2715.
2935 FUNCTION O3UVAB(OCM) 2716.
2936 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 2717.
2937 c REAL OCM 2718.
2938 C-----------------------------------------------------------------------2719.
2939 C**** OZONE ABSORPTION COEFFICIENT DATA FROM HANDBOOK OF GEOPHYSICS 19612720.
2940 C**** T = -44 DEG CENTR. 2721.
2941 C-----------------------------------------------------------------------2722.
2942 DIMENSION X(226),F(226) 2723.
2943 DIMENSION OWMUV2(115),OWMUV3(111),OKEUV2(115),OKEUV3(111) 2724.
2944 EQUIVALENCE (X(1),OWMUV2(1)),(X(116),OWMUV3(1)), 2725.
2945 *(F(1),OKEUV2(1)),(F(116),OKEUV3(1)) 2726.
2946 DATA OWMUV2/.2002,.2012,.2022,.2032,.2042,.2052,.2062,.2072,.2082,2727.
2947 $.2092,.2102,.2112,.2122,.2132,.2142,.2152,.2162,.2172,.2182,.2192,2728.
2948 $.2202,.2212,.2222,.2232,.2242,.2252,.2262,.2272,.2282,.2292,.2302,2729.
2949 $.2312,.2322,.2332,.2342,.2352,.2362,.2372,.2382,.2392,.2400,.2402,2730.
2950 $.2412,.2422,.2432,.2438,.2444,.2452,.2458,.2463,.2472,.2478,.2482,2731.
2951 $.2490,.2492,.2500,.2508,.2519,.2527,.2539,.2543,.2553,.2562,.2566,2732.
2952 $.2571,.2575,.2579,.2587,.2597,.2604,.2617,.2624,.2635,.2643,.2650,2733.
2953 $.2654,.2662,.2669,.2675,.2682,.2692,.2695,.2702,.2712,.2718,.2722,2734.
2954 $.2732,.2742,.2746,.2752,.2762,.2772,.2782,.2792,.2802,.2812,.2822,2735.
2955 $.2830,.2842,.2852,.2862,.2872,.2882,.2892,.2902,.2912,.2922,.2932,2736.
2956 $.2942,.2952,.2962,.2972,.2982,.2992,.2998/ 2737.
2957 DATA OWMUV3/.3004,.3016,.3021,.3029,.3036,.3037,.3051,.3053,.3059,2738.
2958 $.3061,.3066,.3075,.3077,.3083,.3085,.3092,.3098,.3100,.3104,.3106,2739.
2959 $.3109,.3112,.3130,.3135,.3146,.3148,.3151,.3154,.3167,.3170,.3173,2740.
2960 $.3176,.3190,.3194,.3199,.3200,.3209,.3210,.3216,.3220,.3223,.3226,2741.
2961 $.3239,.3242,.3245,.3248,.3253,.3255,.3269,.3272,.3275,.3279,.3292,2742.
2962 $.3295,.3299,.3303,.3309,.3312,.3328,.3332,.3334,.3338,.3357,.3365,2743.
2963 $.3369,.3372,.3391,.3395,.3398,.3401,.3417,.3421,.3426,.3430,.3437,2744.
2964 $.3439,.3451,.3455,.3460,.3463,.3466,.3472,.3481,.3485,.3489,.3493,2745.
2965 $.3499,.3501,.3506,.3514,.3521,.3523,.3546,.3550,.3554,.3556,.3561,2746.
2966 $.3567,.3572,.3573,.3588,.3594,.3599,.3600,.3604,.3606,.3639,.3647,2747.
2967 $.3650,.3654,.3660/ 2748.
2968 DATA OKEUV2/ 8.3, 8.3, 8.1, 8.3, 8.6, 9.0, 9.7, 10.8, 11.7,2749.
2969 $ 13.0, 14.3, 16.0, 18.0, 20.6, 23.0, 26.1, 29.3, 32.6, 36.9, 40.8,2750.
2970 $ 46.9, 51.4, 56.7, 63.4, 69.1, 76.6, 84.0, 91.4, 99.9,110.0,118.0,2751.
2971 $126.0,136.0,145.0,154.0,164.0,175.0,186.0,192.0,201.0,210.0,212.0,2752.
2972 $221.0,230.0,239.0,248.0,250.0,259.0,264.0,264.0,273.0,277.0,275.0,2753.
2973 $283.0,283.0,290.0,283.0,297.0,290.0,300.0,290.0,302.0,295.0,283.0,2754.
2974 $293.0,290.0,286.0,297.0,281.0,280.0,271.0,275.0,254.0,264.0,250.0,2755.
2975 $248.0,242.0,228.0,230.0,216.0,213.0,211.0,199.0,188.0,188.0,178.0,2756.
2976 $169.0,153.0,155.0,148.0,136.0,127.0,117.0,108.0, 97.0, 88.7, 81.3,2757.
2977 $ 78.7, 67.9, 61.4, 54.3, 49.6, 43.1, 38.9, 34.6, 30.2, 27.5, 23.9,2758.
2978 $ 21.0, 18.6, 16.2, 14.2, 12.3, 10.7, 9.5/ 2759.
2979 DATA OKEUV3/8.880,7.520,6.960,6.160,5.810,5.910,4.310,4.430,4.130,2760.
2980 $4.310,4.020,3.330,3.390,3.060,3.100,2.830,2.400,2.490,2.330,2.320,2761.
2981 $2.120,2.200,1.436,1.595,1.074,1.138,1.068,1.262,0.818,0.948,0.860,2762.
2982 $1.001,0.543,0.763,0.665,0.781,0.382,0.406,0.373,0.608,0.484,0.601,2763.
2983 $0.209,0.276,0.259,0.470,0.319,0.354,0.131,0.223,0.185,0.339,0.080,2764.
2984 $0.093,0.079,0.184,0.139,0.214,0.053,0.074,0.068,0.152,0.038,0.070,2765.
2985 $.0540000,.1030000,.0240000,.0382500,.0292500,.0550000,.0135000, 2766.
2986 $.0155250,.0127500,.0188250,.0167250,.0262500,.0115500,.0140250, 2767.
2987 $.0099750,.0115500,.0081000,.0104250,.0050100,.0057000,.0046650, 2768.
2988 $.0073425,.0051825,.0055275,.0040575,.0077700,.0048900,.0054600, 2769.
2989 $.0015375,.0017775,.0013275,.0014100,.0011550,.0023325,.0018825, 2770.
2990 $.0019650,.0009600,.0013650,.0011925,.0013200,.0008925,.0009825, 2771.
2991 $.0001350,.0006300,.0004500,.0006225,0.0/ 2772.
2992 C 2773.
2993 C THEKAERAKA SOLAR FLUX 2774.
2994 C 2775.
2995 DIMENSION Y(190),H(190) 2776.
2996 DATA H/.007,.900,.007,.007,.030,.070,.230,.630,1.25,2.71,10.7,2777.
2997 1 22.9,57.5,64.9,66.7,59.3,63.0,72.3,70.4,104.,130.,185.,232.,204.,2778.
2998 2 222.,315.,482.,584.,514.,603.,689.,764.,830.,975.,1059.,1081.,2779.
2999 31074.,1069.,1093.,1083.,1068.,1132.,1181.,1157.,1120.,1098.,1098.,2780.
3000 41189.,1429.,1644.,1751.,1774.,1747.,1693.,1639.,1663.,1810.,1922.,2781.
3001 52006.,2057.,2066.,2048.,2033.,2044.,2074.,1976.,1950.,1960.,1942.,2782.
3002 61920.,1882.,1833.,1833.,1852.,1842.,1818.,1783.,1754.,1725.,1720.,2783.
3003 71695.,1705.,1712.,1719.,1715.,1712.,1700.,1682.,1666.,1647.,1635.,2784.
3004 81602.,1570.,1544.,1511.,1486.,1456.,1427.,1402.,1389.,1344.,1314.,2785.
3005 91290.,1260.,1235.,1211.,1185.,1159.,1134.,1109.,1085.,1060.,1036.,2786.
3006 A1013.,990.,968.,947.,926.,908.,891.,880.,869.,858.,847.,837.,820.,2787.
3007 B 803.,785.,767.,748.,668.,593.,535.,485.,438.,397.,358.,337.,312.,2788.
3008 C 288.,267.,245.,223.,202.,180.,159.,142.,126.,114.,103., 90., 79.,2789.
3009 D 69.0,62.0,55.0,48.0,43.0,39.0,35.0,31.0,26.0,22.6,19.2,16.6,14.6,2790.
3010 E 13.5,12.3,11.1,10.3, 9.5,8.70,7.80,7.10,6.50,5.92,5.35,4.86,4.47,2791.
3011 F 4.11,3.79,1.82,0.99,.585,.367,.241,.165,.117,.0851,.0634,.0481/2792.
3012 DATA Y/.115,.120,.125,.130,.140,.150,.160,.170,.180,.190,.200,2793.
3013 1 .210,.220,.225,.230,.235,.240,.245,.250,.255,.260,.265,.270,.275,2794.
3014 2 .280,.285,.290,.295,.300,.305,.310,.315,.320,.325,.330,.335,2795.
3015 3 .340,.345,.350,.355,.360,.365,.370,.375,.380,.385,.390,2796.
3016 4 .395,.400,.405,.410,.415,.420,.425,.430,.435,.440,.445,2797.
3017 5 .450,.455,.460,.465,.470,.475,.480,.485,.490,.495,.500,2798.
3018 6 .505,.510,.515,.520,.525,.530,.535,.540,.545,.550,.555,2799.
3019 7 .560,.565,.570,.575,.580,.585,.590,.595,.600,.605,.610,2800.
3020 8 .620,.630,.640,.650,.660,.670,.680,.690,.700,.710,.720,2801.
3021 9 .730,.740,.750,.760,.770,.780,.790,.800,.810,.820,.830,2802.
3022 A .840,.850,.860,.870,.880,.890,.900,.910,.920,.930,.940,.950,.960,2803.
3023 B 0.97,0.98,0.99,1.00,1.05,1.10,1.15,1.20,1.25,1.30,1.35,1.40,1.45,2804.
3024 C 1.50,1.55,1.60,1.65,1.70,1.75,1.80,1.85,1.90,1.95,2.00,2.10,2.20,2805.
3025 D 2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.10,3.20,3.30,3.40,3.50,2806.
3026 E 3.60,3.70,3.80,3.90,4.00,4.10,4.20,4.30,4.40,4.50,4.60,4.70,4.80,2807.
3027 F 4.9, 5.0, 6.0, 7.0, 8.0, 9.0,10.0,11.0,12.0,13.0,14.0,15.00/2808.
3028 NH=190 2809.
3029 NG=226 2810.
3030 XA=X(1) 2811.
3031 XB=X(NG) 2812.
3032 SOLCON=0.1353D0 2813.
3033 ABINT=0.D0 2814.
3034 X2=DMIN1(X(NG),Y(NH)) 2815.
3035 IF(XA.GE.X2) GO TO 160 2816.
3036 X1=DMAX1(X(1),Y(1)) 2817.
3037 IF(XB.LE.X1) GO TO 160 2818.
3038 YA=XA 2819.
3039 IF(XA.LT.X1) YA=X1 2820.
3040 YB=XB 2821.
3041 IF(YB.GT.X2) YB=X2 2822.
3042 DO 100 JG=2,NG 2823.
3043 XJ=X(JG) 2824.
3044 IF(XJ.GT.YA) GO TO 110 2825.
3045 100 CONTINUE 2825.1
3046 JG=NG+1 2825.2
3047 110 IG=JG-1 2826.
3048 XI=X(IG) 2827.
3049 TAU=F(IG)*OCM 2828.
3050 IF(TAU.GT.35.D0) TAU=35.D0 2829.
3051 GI=1.D0-DEXP(-TAU) 2830.
3052 TAU=F(JG)*OCM 2831.
3053 IF(TAU.GT.35.D0) TAU=35.D0 2832.
3054 GJ=1.D0-DEXP(-TAU) 2833.
3055 B=(GJ-GI)/(XJ-XI) 2834.
3056 A=GJ-B*XJ 2835.
3057 DO 120 JH=2,NH 2836.
3058 YJ=Y(JH) 2837.
3059 IF(YJ.GT.YA) GO TO 130 2838.
3060 120 CONTINUE 2838.1
3061 JH=NH+1 2838.2
3062 130 IH=JH-1 2839.
3063 YI=Y(IH) 2840.
3064 HI=H(IH)/10000.D0 2841.
3065 HJ=H(JH)/10000.D0 2842.
3066 D=(HJ-HI)/(YJ-YI) 2843.
3067 C=HJ-D*YJ 2844.
3068 X2=YA 2845.
3069 140 X1=X2 2846.
3070 X2=DMIN1(XJ,YJ) 2847.
3071 DELTA=(XJ-YJ)/(XJ+YJ) 2848.
3072 IF(X2.GT.YB) X2=YB 2849.
3073 DINT=(X2-X1)*(A*C+0.5D0*(B*C+A*D)*(X2+X1)+B*D*(X2*(X2+X1)+X1*X1)/ 2850.
3074 $3.D0) 2851.
3075 ABINT=ABINT+DINT 2852.
3076 IF(X2.GE.YB) GO TO 160 2853.
3077 IF(DELTA.GT.1.D-14) GO TO 150 2854.
3078 XI=XJ 2855.
3079 GI=GJ 2856.
3080 JG=JG+1 2857.
3081 XJ=X(JG) 2858.
3082 TAU=F(JG)*OCM 2859.
3083 IF(TAU.GT.35.D0) TAU=35.D0 2860.
3084 GJ=1.D0-DEXP(-TAU) 2861.
3085 B=(GJ-GI)/(XJ-XI) 2862.
3086 A=GJ-B*XJ 2863.
3087 IF(DABS(DELTA).LE.1.D-14) GO TO 150 2864.
3088 GO TO 140 2865.
3089 150 YI=YJ 2866.
3090 HI=HJ 2867.
3091 JH=JH+1 2868.
3092 YJ=Y(JH) 2869.
3093 HJ=H(JH)/10000.D0 2870.
3094 D=(HJ-HI)/(YJ-YI) 2871.
3095 C=HJ-D*YJ 2872.
3096 GO TO 140 2873.
3097 160 O3UVAB=ABINT/SOLCON 2874.
3098 RETURN 2875.
3099 END 2876.
3100 SUBROUTINE SETO3D 2877.
3101
3102 #include "B83XX.COM"
3103
3104 C-----------------------------------------------------------------------2915.
3105 C 2916.
3106 C LONDON ET AL (1976) JUL,1957-DEC,1970 NCAR ATLAS OF TOTAL OZONE2917.
3107 C 2918.
3108 C AVERAGE GLOBAL COLUMN AMOUNT -- O3AVE(MONTH,LATITUDE,LONGITUDE)2919.
3109 C 2920.
3110 C MONTH=1-12 JAN,FEB,...,DEC 2921.
3111 C LAT =1-18 -85,-75,..., 85 2922.
3112 C 2923.
3113 C-----------------------------------------------------------------------2924.
3114 REAL O3AVEA(216),O3AVEB(216),O3AVEC(216),O3AVED(216),O3AVEE(216) 2925.
3115 REAL O3AVEF(216),O3AVEG(216),O3AVEH(216),O3AVEI(216),O3AVEJ(216) 2926.
3116 REAL O3AVEK(216),O3AVEL(216),O3AVEM(216),O3AVEN(216),O3AVEO(216) 2927.
3117 REAL O3AVEP(216),O3AVEQ(216),O3AVER(216),O3AVE(12,18,18) 2928.
3118 EQUIVALENCE (O3AVE(1,1,10),O3AVEA(1)),(O3AVE(1,1,11),O3AVEB(1)) 2929.
3119 1 ,(O3AVE(1,1,12),O3AVEC(1)),(O3AVE(1,1,13),O3AVED(1)) 2930.
3120 2 ,(O3AVE(1,1,14),O3AVEE(1)),(O3AVE(1,1,15),O3AVEF(1)) 2931.
3121 3 ,(O3AVE(1,1,16),O3AVEG(1)),(O3AVE(1,1,17),O3AVEH(1)) 2932.
3122 4 ,(O3AVE(1,1,18),O3AVEI(1)),(O3AVE(1,1,01),O3AVEJ(1)) 2933.
3123 5 ,(O3AVE(1,1,02),O3AVEK(1)),(O3AVE(1,1,03),O3AVEL(1)) 2934.
3124 6 ,(O3AVE(1,1,04),O3AVEM(1)),(O3AVE(1,1,05),O3AVEN(1)) 2935.
3125 7 ,(O3AVE(1,1,06),O3AVEO(1)),(O3AVE(1,1,07),O3AVEP(1)) 2936.
3126 8 ,(O3AVE(1,1,08),O3AVEQ(1)),(O3AVE(1,1,09),O3AVER(1)) 2937.
3127 DATA O3AVEA/ 2938.
3128 A .317,.295,.291,.292,.293,.298,.300,.305,.313,.324,.369,.355, 2939.
3129 B .319,.300,.296,.292,.291,.300,.301,.304,.314,.322,.358,.350, 2940.
3130 C .312,.301,.295,.287,.286,.298,.302,.305,.316,.322,.343,.335, 2941.
3131 D .299,.291,.285,.280,.279,.290,.295,.300,.307,.319,.327,.316, 2942.
3132 E .281,.275,.279,.268,.266,.278,.282,.290,.295,.306,.306,.296, 2943.
3133 F .266,.261,.259,.256,.252,.261,.267,.277,.280,.289,.285,.277, 2944.
3134 G .252,.249,.248,.246,.240,.249,.252,.262,.264,.273,.265,.258, 2945.
3135 H .240,.238,.240,.242,.237,.242,.240,.249,.252,.258,.251,.245, 2946.
3136 I .232,.230,.238,.241,.240,.238,.234,.241,.241,.245,.239,.236, 2947.
3137 J .235,.235,.244,.252,.253,.244,.236,.237,.232,.230,.230,.232, 2948.
3138 K .249,.256,.264,.269,.267,.261,.245,.245,.238,.234,.233,.237, 2949.
3139 L .278,.289,.294,.300,.294,.284,.265,.265,.256,.249,.248,.261, 2950.
3140 M .318,.338,.343,.351,.342,.324,.300,.296,.287,.275,.279,.299, 2951.
3141 N .347,.368,.383,.383,.370,.351,.335,.319,.304,.288,.296,.321, 2952.
3142 O .364,.394,.418,.410,.402,.371,.358,.340,.312,.298,.302,.325, 2953.
3143 P .356,.388,.421,.414,.394,.360,.337,.319,.299,.285,.292,.313, 2954.
3144 Q .364,.403,.431,.426,.398,.358,.328,.303,.292,.287,.297,.324, 2955.
3145 R .373,.421,.447,.440,.408,.355,.323,.295,.289,.291,.305,.329/ 2956.
3146 DATA O3AVEB/ 2957.
3147 A .318,.295,.291,.293,.293,.299,.301,.305,.314,.326,.372,.358, 2958.
3148 B .321,.300,.295,.293,.291,.301,.301,.306,.314,.326,.361,.353, 2959.
3149 C .315,.302,.296,.291,.288,.300,.303,.306,.318,.328,.348,.340, 2960.
3150 D .307,.296,.291,.284,.278,.298,.299,.305,.314,.326,.335,.324, 2961.
3151 E .294,.285,.286,.272,.270,.286,.288,.296,.302,.315,.315,.304, 2962.
3152 F .278,.271,.265,.260,.258,.270,.273,.283,.287,.298,.293,.284, 2963.
3153 G .262,.259,.254,.250,.247,.255,.259,.268,.270,.282,.274,.266, 2964.
3154 H .247,.246,.244,.245,.239,.245,.247,.255,.255,.266,.257,.250, 2965.
3155 I .235,.235,.239,.244,.240,.238,.236,.244,.244,.249,.244,.239, 2966.
3156 J .233,.234,.243,.251,.249,.240,.234,.235,.232,.231,.231,.231, 2967.
3157 K .247,.254,.263,.267,.262,.253,.242,.240,.237,.232,.232,.237, 2968.
3158 L .279,.287,.296,.282,.286,.275,.260,.257,.253,.246,.246,.258, 2969.
3159 M .320,.336,.345,.348,.325,.309,.293,.282,.279,.267,.272,.294, 2970.
3160 N .346,.369,.379,.377,.348,.330,.317,.299,.286,.280,.288,.312, 2971.
3161 O .368,.406,.412,.401,.373,.345,.332,.312,.293,.284,.293,.316, 2972.
3162 P .366,.409,.423,.418,.386,.349,.326,.307,.290,.278,.295,.312, 2973.
3163 Q .366,.407,.428,.429,.396,.352,.323,.296,.287,.282,.298,.318, 2974.
3164 R .372,.420,.446,.441,.407,.352,.320,.292,.286,.290,.305,.327/ 2975.
3165 DATA O3AVEC/ 2976.
3166 A .319,.296,.292,.294,.294,.299,.302,.306,.316,.328,.372,.359, 2977.
3167 B .321,.300,.295,.297,.293,.303,.305,.309,.319,.332,.367,.359, 2978.
3168 C .322,.309,.302,.297,.293,.309,.309,.314,.326,.338,.362,.353, 2979.
3169 D .324,.313,.303,.294,.295,.314,.311,.318,.330,.342,.353,.343, 2980.
3170 E .315,.308,.296,.286,.287,.305,.306,.314,.326,.335,.338,.326, 2981.
3171 F .294,.290,.281,.271,.273,.287,.290,.299,.307,.319,.312,.303, 2982.
3172 G .274,.272,.264,.258,.258,.268,.272,.281,.286,.297,.290,.281, 2983.
3173 H .254,.254,.251,.248,.248,.254,.257,.263,.267,.276,.271,.262, 2984.
3174 I .240,.239,.241,.245,.241,.243,.244,.250,.251,.256,.250,.246, 2985.
3175 J .230,.231,.238,.249,.246,.237,.234,.233,.234,.233,.230,.228, 2986.
3176 K .238,.244,.251,.258,.253,.244,.236,.235,.233,.228,.228,.230, 2987.
3177 L .259,.269,.276,.279,.268,.254,.246,.241,.238,.235,.237,.246, 2988.
3178 M .289,.305,.312,.306,.289,.270,.261,.255,.249,.246,.252,.268, 2989.
3179 N .321,.347,.354,.343,.315,.291,.281,.273,.262,.259,.268,.285, 2990.
3180 O .351,.394,.396,.384,.353,.315,.300,.288,.275,.271,.282,.296, 2991.
3181 P .363,.414,.422,.415,.382,.333,.313,.292,.281,.276,.292,.306, 2992.
3182 Q .366,.415,.430,.433,.398,.346,.313,.288,.282,.280,.299,.317, 2993.
3183 R .372,.421,.445,.441,.406,.348,.316,.289,.285,.289,.306,.327/ 2994.
3184 DATA O3AVED/ 2995.
3185 A .320,.296,.293,.294,.295,.300,.303,.308,.317,.330,.374,.361, 2996.
3186 B .322,.300,.297,.299,.296,.307,.310,.314,.323,.339,.373,.366, 2997.
3187 C .329,.313,.310,.304,.302,.320,.318,.326,.338,.352,.373,.367, 2998.
3188 D .343,.330,.318,.306,.315,.333,.329,.337,.354,.366,.370,.366, 2999.
3189 E .334,.324,.311,.299,.312,.326,.329,.333,.352,.357,.354,.342, 3000.
3190 F .304,.300,.291,.279,.285,.302,.308,.315,.324,.328,.325,.312, 3001.
3191 G .277,.276,.268,.262,.266,.279,.283,.289,.296,.303,.299,.283, 3002.
3192 H .256,.257,.253,.249,.252,.259,.266,.269,.274,.278,.273,.263, 3003.
3193 I .242,.243,.243,.248,.247,.251,.255,.256,.258,.260,.253,.249, 3004.
3194 J .231,.234,.238,.250,.255,.251,.250,.246,.248,.244,.237,.229, 3005.
3195 K .235,.241,.248,.257,.259,.257,.248,.246,.245,.244,.233,.230, 3006.
3196 L .256,.261,.267,.270,.269,.262,.251,.247,.247,.248,.239,.248, 3007.
3197 M .293,.304,.306,.302,.288,.272,.259,.256,.256,.256,.254,.269, 3008.
3198 N .327,.344,.356,.346,.319,.291,.272,.270,.264,.267,.270,.285, 3009.
3199 O .356,.392,.402,.388,.359,.312,.289,.281,.276,.281,.285,.297, 3010.
3200 P .368,.416,.424,.415,.388,.328,.304,.285,.279,.284,.295,.309, 3011.
3201 Q .370,.418,.436,.436,.402,.338,.306,.283,.278,.284,.301,.320, 3012.
3202 R .373,.422,.446,.441,.407,.345,.312,.286,.275,.291,.307,.328/ 3013.
3203 DATA O3AVEE/ 3014.
3204 A .319,.295,.293,.295,.296,.300,.304,.309,.318,.332,.375,.362, 3015.
3205 B .325,.301,.300,.302,.300,.309,.313,.319,.328,.345,.378,.370, 3016.
3206 C .332,.314,.312,.310,.310,.327,.329,.335,.347,.362,.381,.375, 3017.
3207 D .348,.334,.324,.312,.328,.346,.366,.352,.372,.381,.377,.373, 3018.
3208 E .337,.327,.318,.303,.322,.335,.342,.347,.363,.366,.358,.344, 3019.
3209 F .301,.297,.292,.282,.291,.307,.314,.321,.331,.332,.324,.309, 3020.
3210 G .275,.271,.269,.264,.270,.279,.286,.292,.299,.301,.293,.281, 3021.
3211 H .255,.253,.252,.251,.253,.258,.265,.269,.275,.277,.268,.262, 3022.
3212 I .245,.244,.246,.250,.249,.253,.254,.257,.259,.260,.252,.249, 3023.
3213 J .240,.239,.245,.255,.256,.260,.256,.253,.253,.251,.243,.237, 3024.
3214 K .247,.248,.252,.263,.270,.268,.258,.256,.256,.252,.244,.238, 3025.
3215 L .263,.263,.268,.277,.282,.276,.261,.259,.259,.258,.251,.251, 3026.
3216 M .299,.304,.309,.309,.302,.291,.269,.266,.268,.269,.269,.275, 3027.
3217 N .346,.358,.365,.353,.335,.307,.276,.272,.276,.283,.289,.300, 3028.
3218 O .379,.400,.414,.401,.373,.319,.286,.280,.283,.293,.303,.314, 3029.
3219 P .382,.421,.437,.427,.398,.323,.293,.280,.280,.293,.308,.321, 3030.
3220 Q .375,.424,.444,.440,.405,.334,.298,.278,.276,.290,.306,.326, 3031.
3221 R .374,.424,.448,.443,.406,.345,.310,.284,.281,.292,.309,.328/ 3032.
3222 DATA O3AVEF/ 3033.
3223 A .318,.294,.294,.295,.298,.301,.304,.311,.320,.333,.377,.361, 3034.
3224 B .324,.298,.300,.304,.305,.310,.315,.323,.331,.348,.383,.371, 3035.
3225 C .337,.311,.314,.313,.317,.330,.333,.344,.354,.369,.386,.377, 3036.
3226 D .350,.330,.324,.317,.332,.349,.351,.362,.378,.390,.380,.372, 3037.
3227 E .333,.322,.314,.307,.323,.339,.345,.358,.369,.372,.357,.340, 3038.
3228 F .300,.292,.286,.284,.294,.307,.316,.327,.335,.334,.323,.307, 3039.
3229 G .275,.269,.264,.263,.269,.277,.285,.292,.300,.303,.290,.279, 3040.
3230 H .254,.251,.250,.251,.254,.256,.261,.267,.271,.276,.266,.261, 3041.
3231 I .243,.242,.242,.247,.248,.250,.247,.251,.252,.258,.253,.247, 3042.
3232 J .237,.239,.243,.253,.255,.255,.246,.243,.244,.245,.239,.236, 3043.
3233 K .246,.247,.253,.263,.265,.265,.253,.245,.247,.247,.239,.238, 3044.
3234 L .265,.265,.276,.283,.284,.280,.261,.254,.253,.258,.250,.250, 3045.
3235 M .306,.309,.321,.316,.318,.292,.273,.259,.265,.271,.273,.277, 3046.
3236 N .365,.369,.381,.363,.347,.313,.278,.264,.275,.290,.302,.307, 3047.
3237 O .396,.416,.431,.415,.405,.322,.282,.271,.288,.303,.321,.328, 3048.
3238 P .397,.433,.455,.436,.404,.322,.287,.273,.276,.302,.320,.333, 3049.
3239 Q .382,.429,.451,.442,.408,.331,.297,.274,.273,.295,.311,.333, 3050.
3240 R .375,.427,.450,.445,.407,.343,.309,.283,.280,.295,.311,.330/ 3051.
3241 DATA O3AVEG/ 3052.
3242 A .317,.293,.293,.295,.299,.299,.305,.311,.320,.335,.378,.360, 3053.
3243 B .323,.296,.300,.304,.306,.310,.317,.325,.334,.353,.385,.367, 3054.
3244 C .335,.307,.310,.312,.318,.328,.335,.347,.357,.376,.390,.372, 3055.
3245 D .346,.324,.320,.317,.332,.349,.354,.367,.384,.393,.384,.368, 3056.
3246 E .331,.318,.311,.305,.324,.339,.349,.365,.378,.377,.360,.339, 3057.
3247 F .301,.293,.286,.285,.296,.309,.321,.334,.344,.339,.325,.309, 3058.
3248 G .276,.270,.266,.267,.271,.280,.287,.295,.303,.308,.294,.282, 3059.
3249 H .257,.253,.250,.252,.254,.257,.261,.266,.271,.279,.268,.261, 3060.
3250 I .240,.241,.241,.246,.246,.250,.246,.249,.253,.259,.254,.248, 3061.
3251 J .234,.238,.245,.256,.258,.259,.244,.243,.241,.243,.237,.235, 3062.
3252 K .244,.249,.259,.271,.274,.274,.257,.251,.248,.248,.238,.237, 3063.
3253 L .270,.272,.289,.297,.298,.294,.277,.267,.260,.262,.251,.254, 3064.
3254 M .329,.338,.353,.338,.333,.313,.296,.275,.273,.282,.281,.296, 3065.
3255 N .401,.414,.424,.392,.369,.329,.298,.272,.282,.303,.321,.341, 3066.
3256 O .420,.451,.461,.432,.389,.331,.291,.272,.279,.313,.343,.358, 3067.
3257 P .411,.451,.468,.447,.403,.320,.289,.271,.277,.308,.334,.349, 3068.
3258 Q .386,.434,.456,.443,.404,.332,.297,.273,.273,.300,.317,.339, 3069.
3259 R .378,.430,.453,.446,.407,.342,.310,.282,.279,.296,.314,.332/ 3070.
3260 DATA O3AVEH/ 3071.
3261 A .315,.292,.293,.295,.299,.297,.303,.311,.320,.334,.378,.358, 3072.
3262 B .320,.294,.298,.303,.306,.308,.316,.325,.337,.355,.387,.362, 3073.
3263 C .330,.304,.307,.311,.315,.323,.334,.345,.360,.381,.389,.366, 3074.
3264 D .339,.318,.312,.314,.328,.344,.355,.368,.388,.401,.384,.360, 3075.
3265 E .325,.313,.302,.300,.318,.339,.354,.369,.381,.380,.360,.337, 3076.
3266 F .299,.291,.285,.284,.296,.313,.326,.340,.350,.343,.328,.312, 3077.
3267 G .277,.271,.269,.269,.272,.281,.288,.296,.308,.311,.298,.289, 3078.
3268 H .257,.253,.252,.254,.253,.257,.262,.267,.272,.281,.272,.265, 3079.
3269 I .241,.241,.241,.246,.245,.248,.246,.248,.253,.260,.255,.250, 3080.
3270 J .234,.236,.242,.256,.260,.260,.246,.244,.240,.241,.237,.237, 3081.
3271 K .243,.246,.257,.273,.279,.276,.261,.258,.251,.246,.238,.238, 3082.
3272 L .270,.269,.288,.299,.308,.299,.283,.276,.269,.263,.252,.257, 3083.
3273 M .327,.339,.358,.349,.351,.337,.313,.292,.288,.280,.284,.302, 3084.
3274 N .407,.419,.432,.407,.390,.356,.324,.298,.300,.304,.327,.368, 3085.
3275 O .421,.455,.459,.439,.393,.333,.306,.287,.289,.311,.345,.377, 3086.
3276 P .408,.452,.465,.443,.399,.323,.296,.276,.279,.309,.338,.362, 3087.
3277 Q .387,.437,.459,.444,.404,.334,.301,.276,.277,.302,.320,.345, 3088.
3278 R .379,.433,.455,.447,.408,.343,.313,.282,.279,.298,.315,.336/ 3089.
3279 DATA O3AVEI/ 3090.
3280 A .313,.291,.291,.293,.299,.296,.302,.310,.319,.333,.379,.354, 3091.
3281 B .316,.292,.295,.300,.307,.306,.315,.322,.333,.354,.384,.354, 3092.
3282 C .322,.302,.301,.307,.309,.319,.331,.340,.357,.379,.385,.356, 3093.
3283 D .328,.310,.301,.306,.316,.332,.347,.359,.380,.397,.379,.348, 3094.
3284 E .315,.304,.293,.296,.308,.328,.345,.360,.374,.376,.356,.329, 3095.
3285 F .292,.285,.277,.278,.288,.304,.318,.330,.340,.340,.324,.306, 3096.
3286 G .271,.266,.262,.263,.266,.277,.283,.291,.301,.307,.293,.284, 3097.
3287 H .253,.249,.249,.252,.250,.256,.261,.267,.271,.278,.267,.263, 3098.
3288 I .240,.238,.240,.247,.244,.248,.247,.250,.254,.258,.251,.249, 3099.
3289 J .233,.236,.243,.254,.259,.258,.248,.246,.241,.243,.238,.238, 3100.
3290 K .242,.246,.256,.268,.273,.271,.260,.255,.250,.244,.240,.239, 3101.
3291 L .258,.266,.278,.290,.295,.288,.277,.269,.265,.257,.253,.256, 3102.
3292 M .294,.308,.325,.326,.322,.308,.297,.284,.278,.271,.277,.287, 3103.
3293 N .338,.368,.383,.371,.357,.329,.316,.294,.287,.288,.303,.324, 3104.
3294 O .375,.420,.429,.411,.382,.328,.312,.293,.287,.299,.322,.354, 3105.
3295 P .388,.440,.454,.437,.396,.328,.307,.285,.282,.305,.330,.359, 3106.
3296 Q .386,.439,.457,.444,.404,.338,.309,.283,.280,.304,.321,.349, 3107.
3297 R .379,.435,.456,.448,.408,.345,.316,.286,.281,.300,.317,.337/ 3108.
3298 DATA O3AVEJ/ 3109.
3299 A .313,.290,.290,.291,.298,.294,.301,.309,.318,.331,.378,.353, 3110.
3300 B .313,.291,.291,.296,.304,.302,.311,.318,.330,.348,.382,.350, 3111.
3301 C .315,.297,.294,.300,.306,.310,.325,.334,.348,.364,.378,.346, 3112.
3302 D .316,.301,.292,.297,.305,.317,.334,.346,.360,.371,.366,.335, 3113.
3303 E .304,.293,.283,.286,.295,.313,.330,.344,.356,.359,.346,.316, 3114.
3304 F .284,.276,.268,.271,.279,.297,.309,.320,.325,.330,.317,.296, 3115.
3305 G .265,.258,.254,.257,.261,.273,.280,.288,.289,.296,.287,.274, 3116.
3306 H .250,.245,.244,.249,.247,.255,.260,.265,.268,.273,.263,.257, 3117.
3307 I .237,.235,.238,.246,.246,.249,.247,.249,.251,.257,.249,.247, 3118.
3308 J .234,.236,.245,.256,.259,.255,.248,.249,.244,.245,.242,.238, 3119.
3309 K .244,.249,.259,.271,.273,.270,.258,.256,.253,.247,.243,.242, 3120.
3310 L .261,.273,.283,.291,.292,.284,.271,.269,.263,.257,.254,.257, 3121.
3311 M .289,.305,.319,.321,.315,.301,.287,.281,.273,.268,.272,.282, 3122.
3312 N .321,.347,.364,.358,.344,.319,.305,.293,.282,.281,.291,.313, 3123.
3313 O .357,.400,.409,.397,.373,.332,.314,.295,.286,.293,.309,.333, 3124.
3314 P .377,.429,.442,.429,.396,.338,.317,.294,.287,.302,.321,.351, 3125.
3315 Q .385,.439,.458,.443,.407,.345,.318,.292,.284,.304,.322,.349, 3126.
3316 R .380,.437,.458,.449,.408,.348,.319,.289,.283,.301,.319,.340/ 3127.
3317 DATA O3AVEK/ 3128.
3318 A .311,.289,.289,.290,.298,.293,.300,.308,.317,.329,.377,.352, 3129.
3319 B .308,.290,.288,.291,.301,.296,.307,.315,.326,.340,.377,.344, 3130.
3320 C .305,.291,.287,.293,.297,.302,.315,.325,.335,.346,.369,.333, 3131.
3321 D .299,.289,.281,.287,.293,.302,.317,.327,.335,.344,.353,.318, 3132.
3322 E .287,.279,.272,.277,.281,.295,.309,.320,.325,.332,.331,.301, 3133.
3323 F .272,.264,.259,.262,.268,.281,.292,.300,.300,.309,.305,.282, 3134.
3324 G .257,.249,.246,.250,.254,.264,.271,.278,.279,.285,.278,.263, 3135.
3325 H .246,.239,.239,.245,.245,.252,.255,.261,.262,.267,.259,.250, 3136.
3326 I .234,.231,.239,.245,.245,.248,.245,.249,.248,.254,.246,.243, 3137.
3327 J .235,.237,.247,.258,.260,.257,.250,.250,.245,.246,.241,.240, 3138.
3328 K .248,.254,.264,.276,.276,.272,.262,.258,.255,.250,.248,.246, 3139.
3329 L .267,.278,.289,.300,.296,.286,.272,.270,.263,.258,.258,.262, 3140.
3330 M .292,.310,.325,.329,.319,.302,.288,.280,.273,.268,.274,.281, 3141.
3331 N .323,.346,.365,.365,.347,.320,.305,.291,.282,.281,.292,.305, 3142.
3332 O .352,.390,.405,.398,.378,.338,.316,.300,.290,.294,.309,.330, 3143.
3333 P .376,.424,.440,.431,.404,.350,.323,.303,.293,.303,.321,.349, 3144.
3334 Q .386,.442,.462,.448,.411,.354,.324,.298,.289,.306,.325,.349, 3145.
3335 R .381,.441,.459,.452,.410,.352,.322,.293,.286,.301,.320,.342/ 3146.
3336 DATA O3AVEL/ 3147.
3337 A .309,.290,.288,.288,.295,.292,.299,.307,.315,.327,.375,.350, 3148.
3338 B .306,.289,.287,.288,.298,.293,.304,.311,.320,.333,.372,.340, 3149.
3339 C .298,.286,.282,.288,.290,.294,.308,.316,.322,.332,.362,.325, 3150.
3340 D .289,.280,.274,.281,.282,.290,.304,.312,.317,.325,.342,.309, 3151.
3341 E .276,.269,.264,.268,.271,.281,.293,.300,.304,.313,.318,.290, 3152.
3342 F .262,.256,.253,.255,.258,.267,.278,.283,.283,.293,.294,.272, 3153.
3343 G .250,.245,.241,.245,.246,.255,.261,.267,.265,.282,.272,.256, 3154.
3344 H .240,.235,.236,.243,.240,.245,.249,.254,.253,.260,.254,.247, 3155.
3345 I .232,.229,.239,.245,.244,.247,.241,.245,.241,.246,.243,.241, 3156.
3346 J .235,.236,.247,.258,.258,.254,.246,.246,.239,.240,.238,.240, 3157.
3347 K .248,.253,.263,.273,.271,.267,.256,.253,.245,.243,.243,.244, 3158.
3348 L .265,.274,.287,.293,.290,.281,.267,.262,.256,.251,.253,.258, 3159.
3349 M .293,.307,.324,.323,.315,.298,.284,.275,.268,.263,.271,.278, 3160.
3350 N .326,.348,.370,.363,.347,.320,.304,.290,.281,.278,.291,.306, 3161.
3351 O .357,.391,.412,.404,.380,.347,.322,.303,.296,.296,.313,.334, 3162.
3352 P .381,.431,.447,.439,.412,.363,.331,.311,.301,.308,.331,.353, 3163.
3353 Q .389,.449,.470,.456,.417,.363,.329,.306,.296,.308,.331,.354, 3164.
3354 R .382,.441,.462,.454,.413,.354,.325,.296,.289,.301,.319,.343/ 3165.
3355 DATA O3AVEM/ 3166.
3356 A .309,.290,.288,.289,.293,.292,.299,.306,.313,.325,.374,.350, 3167.
3357 B .306,.289,.286,.285,.296,.291,.300,.308,.316,.326,.369,.339, 3168.
3358 C .297,.284,.281,.285,.288,.290,.302,.308,.315,.324,.355,.323, 3169.
3359 D .287,.278,.272,.275,.277,.284,.295,.300,.306,.316,.333,.304, 3170.
3360 E .273,.266,.261,.263,.267,.274,.284,.288,.292,.302,.311,.286, 3171.
3361 F .260,.253,.250,.252,.253,.261,.268,.273,.275,.284,.288,.269, 3172.
3362 G .247,.244,.241,.245,.243,.250,.254,.260,.260,.270,.268,.254, 3173.
3363 H .238,.234,.235,.242,.239,.243,.244,.250,.249,.255,.253,.245, 3174.
3364 I .231,.231,.238,.244,.242,.246,.238,.242,.239,.243,.242,.239, 3175.
3365 J .236,.238,.247,.257,.254,.253,.245,.244,.237,.235,.235,.236, 3176.
3366 K .250,.254,.263,.270,.266,.264,.254,.250,.244,.239,.237,.243, 3177.
3367 L .270,.279,.289,.290,.285,.279,.267,.261,.256,.250,.251,.258, 3178.
3368 M .301,.317,.329,.322,.314,.298,.285,.277,.270,.263,.270,.282, 3179.
3369 N .342,.367,.380,.369,.351,.326,.309,.294,.286,.284,.295,.314, 3180.
3370 O .380,.412,.424,.411,.388,.357,.331,.311,.303,.302,.325,.347, 3181.
3371 P .398,.448,.457,.449,.419,.373,.343,.318,.309,.314,.341,.366, 3182.
3372 Q .396,.456,.480,.466,.424,.370,.338,.311,.303,.311,.336,.363, 3183.
3373 R .384,.442,.464,.456,.414,.358,.327,.297,.290,.302,.322,.344/ 3184.
3374 DATA O3AVEN/ 3185.
3375 A .311,.291,.287,.288,.293,.292,.297,.305,.312,.325,.373,.350, 3186.
3376 B .307,.290,.286,.285,.293,.292,.300,.305,.315,.326,.366,.341, 3187.
3377 C .300,.287,.283,.282,.288,.292,.300,.306,.313,.324,.351,.323, 3188.
3378 D .290,.281,.274,.276,.279,.285,.293,.298,.303,.315,.330,.308, 3189.
3379 E .276,.272,.265,.264,.267,.274,.281,.287,.288,.302,.309,.289, 3190.
3380 F .263,.259,.254,.253,.257,.262,.267,.272,.274,.285,.287,.273, 3191.
3381 G .252,.247,.244,.248,.247,.252,.254,.260,.262,.270,.268,.259, 3192.
3382 H .243,.238,.239,.244,.241,.245,.245,.251,.251,.257,.253,.249, 3193.
3383 I .236,.233,.238,.244,.244,.246,.238,.243,.242,.245,.243,.242, 3194.
3384 J .237,.241,.247,.256,.255,.254,.245,.245,.242,.234,.234,.236, 3195.
3385 K .252,.259,.266,.271,.269,.269,.257,.256,.251,.242,.240,.245, 3196.
3386 L .277,.286,.296,.298,.292,.290,.276,.275,.267,.259,.259,.267, 3197.
3387 M .323,.342,.352,.339,.333,.319,.303,.298,.288,.280,.285,.296, 3198.
3388 N .374,.403,.413,.392,.376,.351,.332,.319,.306,.303,.317,.340, 3199.
3389 O .408,.448,.448,.433,.410,.375,.351,.330,.317,.318,.343,.368, 3200.
3390 P .418,.467,.473,.464,.426,.383,.347,.328,.316,.319,.347,.376, 3201.
3391 Q .402,.459,.482,.474,.426,.374,.343,.313,.306,.313,.338,.368, 3202.
3392 R .384,.440,.463,.458,.415,.360,.328,.299,.291,.301,.319,.344/ 3203.
3393 DATA O3AVEO/ 3204.
3394 A .313,.291,.288,.288,.292,.292,.298,.305,.312,.324,.364,.351, 3205.
3395 B .311,.294,.289,.286,.294,.293,.302,.306,.316,.326,.358,.345, 3206.
3396 C .308,.296,.291,.286,.294,.297,.303,.310,.316,.330,.354,.331, 3207.
3397 D .301,.292,.284,.282,.286,.295,.301,.307,.310,.326,.334,.318, 3208.
3398 E .290,.283,.274,.273,.276,.286,.291,.297,.299,.314,.314,.302, 3209.
3399 F .280,.272,.266,.263,.264,.272,.277,.283,.286,.297,.295,.286, 3210.
3400 G .267,.261,.256,.254,.255,.260,.263,.268,.272,.280,.276,.271, 3211.
3401 H .254,.250,.249,.249,.247,.251,.251,.256,.259,.264,.261,.258, 3212.
3402 I .242,.242,.243,.245,.244,.248,.242,.247,.248,.252,.248,.248, 3213.
3403 J .237,.242,.249,.256,.255,.255,.245,.244,.243,.237,.236,.236, 3214.
3404 K .253,.256,.267,.271,.270,.270,.259,.258,.252,.245,.242,.248, 3215.
3405 L .279,.283,.296,.296,.294,.292,.280,.279,.269,.260,.260,.268, 3216.
3406 M .327,.339,.357,.345,.338,.328,.319,.309,.293,.284,.285,.302, 3217.
3407 N .386,.409,.421,.405,.388,.363,.346,.332,.314,.311,.319,.348, 3218.
3408 O .419,.450,.459,.445,.418,.384,.361,.338,.322,.320,.340,.373, 3219.
3409 P .419,.461,.473,.468,.423,.358,.358,.331,.316,.319,.343,.376, 3220.
3410 Q .401,.453,.477,.469,.423,.375,.345,.314,.307,.312,.333,.361, 3221.
3411 R .382,.437,.461,.455,.415,.361,.329,.299,.291,.301,.316,.341/ 3222.
3412 DATA O3AVEP/ 3223.
3413 A .314,.293,.289,.290,.292,.294,.299,.305,.312,.323,.363,.352, 3224.
3414 B .315,.298,.293,.290,.294,.299,.303,.307,.316,.324,.365,.350, 3225.
3415 C .315,.303,.296,.291,.300,.306,.311,.316,.323,.336,.360,.341, 3226.
3416 D .308,.301,.293,.291,.297,.308,.312,.318,.324,.337,.345,.329, 3227.
3417 E .299,.292,.284,.283,.285,.299,.306,.311,.317,.326,.327,.314, 3228.
3418 F .285,.280,.272,.272,.274,.284,.293,.296,.301,.308,.306,.297, 3229.
3419 G .272,.266,.262,.261,.262,.269,.275,.280,.283,.289,.284,.280, 3230.
3420 H .256,.253,.251,.251,.251,.255,.256,.264,.266,.271,.267,.263, 3231.
3421 I .241,.242,.244,.245,.245,.248,.245,.251,.251,.255,.252,.251, 3232.
3422 J .236,.239,.247,.253,.253,.251,.242,.244,.239,.237,.235,.236, 3233.
3423 K .248,.250,.262,.267,.264,.262,.254,.250,.244,.240,.235,.239, 3234.
3424 L .268,.270,.286,.287,.284,.278,.267,.264,.256,.250,.245,.256, 3235.
3425 M .301,.308,.329,.322,.317,.300,.297,.281,.272,.264,.263,.279, 3236.
3426 N .351,.362,.380,.372,.360,.337,.320,.305,.295,.285,.287,.316, 3237.
3427 O .383,.406,.427,.415,.391,.365,.345,.324,.310,.304,.310,.342, 3238.
3428 P .393,.428,.450,.441,.404,.373,.353,.324,.310,.310,.321,.356, 3239.
3429 Q .387,.435,.461,.456,.412,.370,.341,.313,.303,.306,.321,.353, 3240.
3430 R .381,.432,.457,.452,.413,.361,.328,.299,.291,.298,.314,.338/ 3241.
3431 DATA O3AVEQ/ 3242.
3432 A .315,.293,.289,.291,.293,.295,.298,.305,.312,.323,.362,.354, 3243.
3433 B .316,.301,.295,.291,.294,.300,.303,.307,.316,.322,.361,.350, 3244.
3434 C .318,.305,.297,.292,.298,.306,.311,.314,.324,.334,.354,.340, 3245.
3435 D .309,.301,.292,.289,.295,.305,.312,.317,.326,.335,.343,.326, 3246.
3436 E .295,.288,.279,.279,.284,.297,.305,.305,.316,.321,.324,.310, 3247.
3437 F .279,.272,.266,.269,.272,.281,.289,.291,.299,.303,.305,.293, 3248.
3438 G .263,.259,.254,.257,.259,.266,.273,.276,.281,.285,.284,.277, 3249.
3439 H .247,.246,.244,.248,.247,.252,.253,.261,.265,.269,.267,.259, 3250.
3440 I .235,.236,.239,.244,.243,.246,.243,.247,.251,.253,.249,.246, 3251.
3441 J .231,.234,.243,.250,.251,.247,.240,.238,.233,.234,.232,.233, 3252.
3442 K .242,.244,.257,.262,.260,.255,.247,.243,.235,.235,.228,.233, 3253.
3443 L .257,.263,.278,.280,.275,.269,.258,.252,.242,.239,.235,.243, 3254.
3444 M .280,.288,.308,.307,.299,.287,.274,.267,.255,.250,.246,.259, 3255.
3445 N .309,.319,.348,.340,.332,.309,.293,.286,.273,.264,.261,.282, 3256.
3446 O .339,.357,.388,.376,.360,.334,.320,.305,.289,.282,.279,.306, 3257.
3447 P .365,.393,.424,.411,.386,.355,.340,.316,.300,.303,.297,.329, 3258.
3448 Q .375,.415,.445,.439,.404,.365,.336,.310,.298,.299,.306,.338, 3259.
3449 R .379,.428,.453,.447,.412,.360,.326,.298,.291,.296,.310,.335/ 3260.
3450 DATA O3AVER/ 3261.
3451 A .316,.295,.291,.292,.292,.296,.299,.305,.313,.323,.361,.355, 3262.
3452 B .317,.301,.296,.292,.292,.300,.302,.305,.314,.319,.358,.348, 3263.
3453 C .316,.303,.295,.289,.291,.301,.306,.307,.317,.324,.348,.336, 3264.
3454 D .303,.294,.286,.283,.285,.296,.304,.304,.313,.322,.333,.318, 3265.
3455 E .283,.277,.272,.272,.273,.284,.290,.296,.302,.309,.314,.299, 3266.
3456 F .265,.262,.259,.259,.259,.268,.274,.282,.286,.293,.293,.279, 3267.
3457 G .252,.249,.248,.249,.247,.253,.258,.265,.272,.277,.273,.265, 3268.
3458 H .241,.238,.240,.242,.241,.244,.246,.252,.257,.260,.256,.249, 3269.
3459 I .231,.229,.238,.241,.241,.242,.237,.242,.244,.247,.242,.239, 3270.
3460 J .231,.233,.242,.249,.251,.246,.237,.235,.230,.230,.229,.230, 3271.
3461 K .241,.250,.257,.265,.262,.257,.245,.243,.234,.230,.229,.231, 3272.
3462 L .260,.273,.281,.285,.280,.272,.257,.256,.245,.238,.237,.245, 3273.
3463 M .285,.302,.312,.314,.305,.294,.278,.277,.262,.252,.251,.262, 3274.
3464 N .310,.331,.347,.346,.336,.320,.303,.298,.281,.267,.267,.283, 3275.
3465 O .331,.354,.383,.378,.364,.342,.324,.315,.293,.278,.279,.297, 3276.
3466 P .350,.379,.414,.398,.381,.343,.335,.317,.299,.287,.285,.311, 3277.
3467 Q .367,.404,.436,.428,.399,.361,.332,.307,.295,.293,.298,.327, 3278.
3468 R .376,.424,.450,.442,.409,.358,.326,.296,.290,.294,.306,.332/ 3279.
3469 C 3280.
3470 DIMENSION AO3AVE(18,12),SO3JF(11,19),SO3SO(11,19) 3281.
3471 DATA AO3AVE/ .3148,.3160,.3171,.3159,.3027,.2824,.2645,3282.
3472 A.2493,.2376,.2344,.2455,.2667,.3038,.3467,.3753,.3842,.3817,.3780,3283.
3473 B.2926,.2959,.3008,.3035,.2943,.2763,.2600,.2463,.2366,.2366,.2500,3284.
3474 C.2735,.3166,.3661,.4076,.4270,.4310,.4309,.2904,.2937,.2974,.2959,3285.
3475 D.2869,.2704,.2561,.2454,.2403,.2443,.2590,.2844,.3293,.3803,.4210,3286.
3476 E.4439,.4534,.4539,.2918,.2943,.2965,.2940,.2834,.2687,.2561,.2476,3287.
3477 F.2450,.2538,.2676,.2888,.3259,.3692,.4077,.4325,.4454,.4476,.2951,3288.
3478 G.2979,.2994,.3001,.2904,.2731,.2575,.2467,.2441,.2548,.2675,.2873,3289.
3479 H.3181,.3517,.3828,.4002,.4080,.4096,.2960,.3012,.3084,.3132,.3044,3290.
3480 I.2852,.2660,.2515,.2465,.2521,.2641,.2802,.3023,.3257,.3417,.3457,3291.
3481 J.3521,.3517,.3008,.3070,.3153,.3211,.3127,.2934,.2714,.2545,.2437,3292.
3482 K.2440,.2528,.2665,.2875,.3064,.3191,.3222,.3210,.3201,.3074,.3126,3293.
3483 L.3221,.3276,.3211,.3015,.2783,.2603,.2478,.2431,.2499,.2624,.2784,3294.
3484 M.2928,.3024,.3017,.2954,.2914,.3156,.3224,.3326,.3391,.3300,.3071,3295.
3485 N.2827,.2632,.2489,.2399,.2455,.2566,.2720,.2854,.2939,.2931,.2889,3296.
3486 O.2854,.3282,.3354,.3456,.3504,.3368,.3124,.2899,.2692,.2532,.2389,3297.
3487 P.2415,.2521,.2672,.2844,.2967,.3003,.2986,.2966,.3723,.3713,.3661,3298.
3488 Q.3538,.3332,.3072,.2826,.2626,.2481,.2359,.2373,.2489,.2700,.2936,3299.
3489 R.3113,.3172,.3154,.3130,.3554,.3533,.3467,.3353,.3146,.2925,.2723,3300.
3490 S.2562,.2450,.2350,.2387,.2554,.2828,.3140,.3331,.3406,.3408,.3351/3301.
3491 C 3302.
3492 DATA SO3JF/ 3303.
3493 A 13.0,12.3,11.7,10.5,8.90,6.20,4.50,3.30,2.20,1.80,1.00, 3304.
3494 B 13.6,12.9,11.9,10.3,8.30,6.10,4.45,3.40,2.50,1.85,1.00, 3305.
3495 C 14.8,13.9,12.8,10.3,8.00,6.00,4.55,3.60,2.70,1.90,1.00, 3306.
3496 D 16.6,15.1,14.0,11.0,7.95,6.00,4.65,3.70,2.95,1.95,1.00, 3307.
3497 E 18.1,16.0,14.6,12.0,8.00,6.00,4.80,3.75,3.00,1.98,1.00, 3308.
3498 F 18.3,16.3,14.8,12.6,8.20,6.15,4.80,3.80,3.05,2.00,1.00, 3309.
3499 G 17.3,16.1,14.7,12.7,9.10,6.10,4.70,3.75,3.00,2.00,1.00, 3310.
3500 H 16.3,15.5,14.5,12.6,9.00,6.00,4.55,3.65,2.95,1.98,1.00, 3311.
3501 I 15.7,14.9,14.1,12.4,8.70,5.90,4.40,3.45,2.80,1.96,1.00, 3312.
3502 J 15.3,14.1,13.5,12.2,8.30,5.85,4.25,3.40,2.75,1.95,1.00, 3313.
3503 K 15.6,14.9,14.0,12.4,9.00,6.10,4.55,3.50,2.85,1.96,1.00, 3314.
3504 L 17.4,16.6,16.0,14.0,10.0,7.30,5.10,3.90,3.00,1.97,1.00, 3315.
3505 M 17.6,18.3,17.8,15.8,12.3,9.00,6.05,4.40,3.20,1.97,1.00, 3316.
3506 N 16.0,16.9,17.8,16.8,15.2,12.0,7.90,5.10,3.65,1.97,1.00, 3317.
3507 O 12.3,13.8,15.7,16.2,16.2,14.8,10.0,6.00,4.00,1.96,1.00, 3318.
3508 P 12.0,11.9,12.0,13.8,14.3,14.3,12.0,6.80,4.30,1.95,1.00, 3319.
3509 Q 11.9,11.8,11.7,11.6,11.8,12.0,10.3,7.20,4.50,1.90,1.00, 3320.
3510 R 11.6,11.5,11.4,11.2,11.0,10.4,9.00,7.20,4.15,1.85,1.00, 3321.
3511 S 11.2,10.9,10.7,10.5,10.0,9.75,8.60,7.00,3.80,1.80,1.00/ 3322.
3512 DATA SO3SO/ 3323.
3513 A 10.5,10.5,10.5,10.6,10.5,10.3,8.20,4.80,3.10,1.90,1.00, 3324.
3514 B 11.5,11.5,11.6,12.1,12.1,10.8,8.05,4.95,3.40,1.92,1.00, 3325.
3515 C 12.7,13.8,14.0,14.1,12.9,10.9,7.95,5.10,3.70,1.96,1.00, 3326.
3516 D 15.4,15.9,16.0,15.4,13.2,10.7,7.40,5.15,3.85,1.98,1.00, 3327.
3517 E 17.9,18.0,17.4,16.1,13.0,10.0,6.70,4.90,3.80,1.99,1.00, 3328.
3518 F 18.3,18.6,17.8,16.1,12.1,9.10,5.95,4.80,3.70,2.00,1.00, 3329.
3519 G 18.6,18.5,17.8,15.9,11.1,8.00,5.55,4.40,3.45,2.00,1.00, 3330.
3520 H 18.2,18.1,17.2,15.1,10.3,7.40,5.10,4.00,3.10,1.99,1.00, 3331.
3521 I 17.5,16.8,16.2,14.0,9.90,7.00,4.90,3.85,2.95,1.98,1.00, 3332.
3522 J 16.5,15.8,15.0,12.9,9.40,6.65,4.80,3.70,2.90,1.96,1.00, 3333.
3523 K 16.3,15.8,15.0,12.9,9.20,6.80,5.00,3.85,2.95,1.96,1.00, 3334.
3524 L 16.4,16.2,15.8,14.0,9.80,7.10,5.10,3.95,3.00,1.96,1.00, 3335.
3525 M 16.6,16.5,16.2,14.8,10.8,7.75,5.50,4.05,3.05,1.97,1.00, 3336.
3526 N 16.5,16.6,16.5,16.0,12.1,9.00,6.00,4.40,3.10,1.97,1.00, 3337.
3527 O 15.8,16.2,16.4,16.1,14.2,10.9,6.60,4.50,3.20,1.97,1.00, 3338.
3528 P 12.2,14.2,15.5,15.3,14.7,12.4,7.40,4.70,3.10,1.96,1.00, 3339.
3529 Q 11.6,11.9,12.1,14.0,13.9,12.3,8.00,4.40,2.95,1.90,1.00, 3340.
3530 R 11.2,11.2,11.4,11.6,11.8,10.9,8.00,3.95,2.60,1.87,1.00, 3341.
3531 S 11.0,10.8,10.5,10.3,10.1,9.70,7.00,3.65,2.20,1.80,1.00/ 3342.
3532 C 3343.
3533 DIMENSION XJDMO(14),HKMSPR(14),HKMAUT(14) 3344.
3534 DIMENSION CNCAUT(14),CNCSPR(14),DEGLAT(14) 3345.
3535 DATA DEGLAT/-85.0,-71.0,-59.0,-47.0,-35.0,-22.0,-9.0, 3346.
3536 + 9.0,22.0,35.0,47.0,59.0,71.0,85.0/ 3347.
3537 DATA XJDMO/-15.0,16.0,45.0,75.0,105.0,136.0,166.0,197.0,228.0 3348.
3538 + ,258.0,289.0,319.0,350.0,381.0/ 3349.
3539 DATA HKMSPR/18.5,18.5,19.0,23.5,24.0,24.5,26.5, 3350.
3540 + 26.5,25.0,22.5,21.0,20.0,18.5,16.5/ 3351.
3541 DATA HKMAUT/16.5,18.5,20.0,21.0,22.5,25.0,26.5, 3352.
3542 + 26.5,24.5,24.0,23.5,19.0,18.5,18.5/ 3353.
3543 DATA CNCSPR/0.0181,0.0212,0.0187,0.0167,0.0162,0.0183,0.0175, 3354.
3544 + 0.0187,0.0200,0.0196,0.0225,0.0291,0.0287,0.0300/ 3355.
3545 DATA CNCAUT/0.0300,0.0287,0.0291,0.0225,0.0196,0.0200,0.0187, 3356.
3546 + 0.0175,0.0183,0.0162,0.0167,0.0187,0.0212,0.0181/ 3357.
3547 C 3358.
3548 DIMENSION PLBSO3(11),SOJDAY(6),PMLAT(6) 3359.
3549 DATA PLBSO3/10.0,7.0,5.0,3.0,2.0,1.5,1.0,0.7,0.5,0.3,0.1/ 3360.
3550 DATA SOJDAY/-91.,31.,92.,213.,274.,396./ 3361.
3551 DATA PMLAT/1.,1.,-1.,-1.,1.,1./ 3362.
3552 DIMENSION AO3JIM(144),O3LB(40),PLB0(40) 3363.
3553 DIMENSION CONCS(144),CONCA(144),BHKMS(144),BHKMA(144) 3364.
3554 DIMENSION WTJLAT(144),WTJLON(144),ILATIJ(144),ILONIJ(144) 3365.
3555 DIMENSION WTLSEP(144),WTLJAN(144),LSEPJ(144),LJANJ(144) 3366.
3556 DATA ACMMGG/2.37251E-4/,ACMPKM/7.1509E-4/,H10MB/31.05467/ 3367.
3557 DATA A,B,C,D/0.331,23.0,4.553,5.23/ 3368.
3558 LOGICAL SKIPI 3369.
3559 C 3370.
3560 C-----------------------------------------------------------------------3371.
3561 C----SET O3 VERTICAL PROFILE PARAMETERS FOR LATITUDE GCM GRID POINTS 3372.
3562 C-----------------------------------------------------------------------3373.
3563 SKIPI =.FALSE. 3374.
3564 IF(ABS(FLONO3).LT.1.E-04) SKIPI =.TRUE. 3375.
3565 DO 100 L=1,NL 3376.
3566 100 PLB0(L)=PLB(L) 3377.
3567 DO 103 J=1,JMLAT 3378.
3568 DLATJ=DLAT(J) 3379.
3569 ILATI=(DLATJ+95.001)/10. 3380.
3570 IF(ILATI.LT. 1) ILATI= 1 3381.
3571 IF(ILATI.GT.17) ILATI=17 3382.
3572 ILATIJ(J)=ILATI 3383.
3573 LATD=ILATI*10-95 3384.
3574 WTJL=(DLATJ-LATD)*0.1 3385.
3575 WTJLAT(J)=WTJL 3386.
3576 DO 101 JJ=2,14 3387.
3577 II=JJ-1 3388.
3578 IF(DLATJ.LE.DEGLAT(JJ)) GO TO 102 3389.
3579 101 CONTINUE 3389.1
3580 JJ=14 3390.
3581 102 WTJJ=(DLATJ-DEGLAT(II))/(DEGLAT(JJ)-DEGLAT(II)) 3391.
3582 WTII=1.-WTJJ 3392.
3583 CONCS(J)=WTII*CNCSPR(II)+WTJJ*CNCSPR(JJ) 3393.
3584 CONCA(J)=WTII*CNCAUT(II)+WTJJ*CNCAUT(JJ) 3394.
3585 BHKMS(J)=WTII*HKMSPR(II)+WTJJ*HKMSPR(JJ) 3395.
3586 103 BHKMA(J)=WTII*HKMAUT(II)+WTJJ*HKMAUT(JJ) 3396.
3587 C 3397.
3588 DO 104 I=1,IMLON 3398.
3589 DLONI=DLON(I) 3399.
3590 ILONG=DLONI/20.0 3400.
3591 WTJLG=(DLONI-ILONG*20)/20.0 3401.
3592 WTJLON(I)=WTJLG 3402.
3593 WTILG=1.-WTJLG 3403.
3594 ILONG=ILONG+1 3404.
3595 JLONG=ILONG+1 3405.
3596 IF(ILONG.GT.18) ILONG=18 3406.
3597 IF(ILONG.GT.17) JLONG=1 3407.
3598 104 ILONIJ(I)=ILONG 3408.
3599 NLAY=LASTVC/100000 3409.
3600 NATM=(LASTVC-NLAY*100000)/10000 3410.
3601 IF(NATM.GT.0) GO TO 106 3411.
3602 C 3412.
3603 O3B=0.343 3413.
3604 DO 105 L=1,NL 3414.
3605 HLT=HLB(L+1) 3415.
3606 O3T=A*(1.0+EXP(-B/C))/(1.0+EXP((HLT-B)/C))+(0.343-A)*EXP(-HLT/D) 3416.
3607 U0GAS(L,3)=(O3B-O3T) 3417.
3608 105 O3B=O3T 3418.
3609 C 3419.
3610 106 AO3J=0.0 3420.
3611 RETURN 3421.
3612 C-----------------------------------------------------------------------3422.
3613 ENTRY O3DDAY 3423.
3614 C-----------------------------------------------------------------------3424.
3615 XJDAY=JDAY 3425.
3616 WTAUT=(XJDAY-91.)/213. 3426.
3617 IF(XJDAY.LT. 91.) WTAUT=( 91.-XJDAY)/152. 3427.
3618 IF(XJDAY.GT.304.) WTAUT=(456.-XJDAY)/152. 3428.
3619 WTSPR=1.-WTAUT 3429.
3620 DO 200 JMO=1,14 3430.
3621 XJDMJ=XJDMO(JMO) 3431.
3622 IF(XJDAY.LT.XJDMJ) GO TO 201 3432.
3623 200 XJDMI=XJDMJ 3433.
3624 XJDMI=XJDMO(13) 3434.
3625 201 DAYMO=XJDMJ-XJDMI 3435.
3626 WTJM=(XJDAY-XJDMI)/DAYMO 3436.
3627 WTIM=1.-WTJM 3437.
3628 JMO=JMO-1 3438.
3629 IMO=JMO-1 3439.
3630 IF(IMO.LT.1) IMO=12 3440.
3631 IF(JMO.GT.12) JMO=1 3441.
3632 JJDAY=1 3442.
3633 SJDAY=SOJDAY(JJDAY) 3443.
3634 202 JJDAY=JJDAY+1 3444.
3635 SIDAY=SJDAY 3445.
3636 SJDAY=SOJDAY(JJDAY) 3446.
3637 IF(XJDAY.GT.SJDAY) GO TO 202 3447.
3638 WTJAN=(XJDAY-SIDAY)/(SJDAY-SIDAY) 3448.
3639 IF(JJDAY.EQ.3.OR.JJDAY.EQ.5) WTJAN=1.-WTJAN 3449.
3640 WTSEP=1.0-WTJAN 3450.
3641 DO 203 J=1,JMLAT 3451.
3642 DLATJ=DLAT(J) 3452.
3643 DLSEP=10.0+0.099999*DLATJ*PMLAT(JJDAY) 3453.
3644 DLJAN=10.0+0.099999*DLATJ*PMLAT(JJDAY-1) 3454.
3645 LSEP=DLSEP 3455.
3646 LJAN=DLJAN 3456.
3647 LJANJ(J)=LJAN 3457.
3648 LSEPJ(J)=LSEP 3458.
3649 WTLSEP(J)=DLSEP-LSEP 3459.
3650 203 WTLJAN(J)=DLJAN-LJAN 3460.
3651 IF(AO3J.GT.1.E-10) GO TO 400 3461.
3652 C 3462.
3653 C-----------------------------------------------------------------------3463.
3654 ENTRY O3DLAT 3464.
3655 C-----------------------------------------------------------------------3465.
3656 ILATI=ILATIJ(JLAT) 3466.
3657 WTJL=WTJLAT(JLAT) 3467.
3658 WTIL=1.-WTJL 3468.
3659 JLATI=ILATI+1 3469.
3660 LSEP=LSEPJ(JLAT) 3470.
3661 LJAN=LJANJ(JLAT) 3471.
3662 WTLS=WTLSEP(JLAT) 3472.
3663 WTLJ=WTLJAN(JLAT) 3473.
3664 AO3J=WTIM*(WTIL*AO3AVE(ILATI,IMO)+WTJL*AO3AVE(JLATI,IMO)) 3474.
3665 + +WTJM*(WTIL*AO3AVE(ILATI,JMO)+WTJL*AO3AVE(JLATI,JMO)) 3475.
3666 BHKMJ=WTSPR*BHKMS(JLAT)+WTAUT*BHKMA(JLAT) 3476.
3667 CONCJ=WTSPR*CONCS(JLAT)+WTAUT*CONCA(JLAT) 3477.
3668 AO3JJ=AO3J 3478.
3669 IF(SKIPI) GO TO 400 3479.
3670 DO 300 I=1,IMLON 3480.
3671 ILONG=ILONIJ(I) 3481.
3672 JLONG=ILONG+1 3482.
3673 IF(JLONG.GT.18) JLONG=1 3483.
3674 WTJLG=WTJLON(I) 3484.
3675 WTILG=1.0-WTJLG 3485.
3676 AO3J=WTIM*(WTIL*(WTILG*O3AVE(IMO,ILATI,ILONG) 3486.
3677 + +WTJLG*O3AVE(IMO,ILATI,JLONG)) 3487.
3678 + +WTJL*(WTILG*O3AVE(IMO,JLATI,ILONG) 3488.
3679 + +WTJLG*O3AVE(IMO,JLATI,JLONG))) 3489.
3680 + +WTJM*(WTIL*(WTILG*O3AVE(JMO,ILATI,ILONG) 3490.
3681 + +WTJLG*O3AVE(JMO,ILATI,JLONG)) 3491.
3682 + +WTJL*(WTILG*O3AVE(JMO,JLATI,ILONG) 3492.
3683 + +WTJLG*O3AVE(JMO,JLATI,JLONG))) 3493.
3684 300 AO3JIM(I)=AO3J 3494.
3685 AO3J=AO3JJ 3495.
3686 C 3496.
3687 C-----------------------------------------------------------------------3497.
3688 ENTRY O3DLON 3498.
3689 C-----------------------------------------------------------------------3499.
3690 C 3500.
3691 IF(SKIPI) RETURN 3501.
3692 AO3J=AO3JJ+ABS((AO3JIM(ILON)-AO3JJ))*FLONO3 3502.
3693 C 3503.
3694 400 CKMJ=0.25*AO3J/CONCJ 3504.
3695 GTOP=0.0 3505.
3696 POI=0.0 3506.
3697 FI=0.0 3507.
3698 L=NL 3508.
3699 PLL=PLB0(L) 3509.
3700 J=12 3510.
3701 401 J=J-1 3511.
3702 IF(J.LT.1) GO TO 404 3512.
3703 POJ=PLBSO3(J) 3513.
3704 FJ=WTSEP*(WTLS*SO3SO(J,LSEP+1)+(1.-WTLS)*SO3SO(J,LSEP)) 3514.
3705 + +WTJAN*(WTLJ*SO3JF(J,LJAN+1)+(1.-WTLJ)*SO3JF(J,LJAN)) 3515.
3706 402 DP=POJ-POI 3516.
3707 IF(POJ.GT.PLL) GO TO 403 3517.
3708 GTOP=GTOP+(FI+FJ)*DP*ACMMGG 3518.
3709 POI=POJ 3519.
3710 FI=FJ 3520.
3711 GO TO 401 3521.
3712 403 FF=(FJ-FI)/DP 3522.
3713 DP=PLL-POI 3523.
3714 FF=FI+FF*DP 3524.
3715 GTOP=GTOP+(FI+FF)*DP*ACMMGG 3525.
3716 POI=PLL 3526.
3717 FI=FF 3527.
3718 O3LB(L)=GTOP 3528.
3719 L=L-1 3529.
3720 PLL=PLB0(L) 3530.
3721 GO TO 402 3531.
3722 404 FI=FJ*ACMPKM 3532.
3723 HI=H10MB 3533.
3724 HJ=BHKMJ+CKMJ 3534.
3725 XPBC=EXP(-BHKMJ/CKMJ) 3535.
3726 XPHC=EXP(HJ/CKMJ) 3536.
3727 DTERM=1.0+XPHC*XPBC 3537.
3728 ATERM=(1.0+XPBC)/DTERM 3538.
3729 FTERM=ATERM/DTERM*XPHC*XPBC/CKMJ 3539.
3730 TTERM=AO3J-GTOP-FI*(HI-HJ)*0.5 3540.
3731 AA=TTERM/(FTERM*(HI-HJ)*0.5+1.0-ATERM) 3541.
3732 FJ=AA*FTERM 3542.
3733 GTOPBC=GTOP+(FI+FJ)*(HI-HJ)*0.5-AA*ATERM 3543.
3734 TOP=AA*(1.0+XPBC) 3544.
3735 GO TO 406 3545.
3736 405 DH=HI-HJ 3546.
3737 FF=(FJ-FI)/DH 3547.
3738 DH=HI-H 3548.
3739 FF=FI+FF*DH 3549.
3740 GTOP=GTOP+(FI+FF)*DH*0.5 3550.
3741 HI=H 3551.
3742 FI=FF 3552.
3743 O3LB(L)=GTOP 3553.
3744 L=L-1 3554.
3745 406 CONTINUE 3555.
3746 H=HLB(L) 3556.
3747 IF(H.GT.HJ) GO TO 405 3557.
3748 O3LB(L)=TOP/(1.+XPBC*EXP(H/CKMJ))+GTOPBC 3558.
3749 L=L-1 3559.
3750 IF(L.GT.0) GO TO 406 3560.
3751 O3LB(NLP)=0. 3561.
3752 DO 407 L=1,NL 3562.
3753 407 U0GAS(L,3)=(O3LB(L)-O3LB(L+1)) 3563.
3754 RETURN 3564.
3755 END 3565.
3756 BLOCK DATA 3566.
3757
3758 #include "B83XX.COM"
3759
3760 C-----------------------------------------------------------------------3597.
3761 C SEASONAL ALBEDOS FOR 11 VEGETATION TYPES 3598.
3762 C-----------------------------------------------------------------------3599.
3763 C 3600.
3764 EQUIVALENCE 3601.
3765 + (VADATA(1,1,1),ALVISK(1,1)),(VADATA(1,1,2),ALNIRK(1,1)) 3602.
3766 +, (VADATA(1,1,3),FIELDC(1,1)),(VADATA(1,4,3),VTMASK(1)) 3603.
3767 C$$ + (VADATA(1,1,1),ALMEAN(1,1)),(VADATA(1,1,2),RATIRV(1,1)) 3604.
3768 C$$ +, (VADATA(1,1,3),VTMASK(1)),(VADATA(1,2,3),FIELDC(1,1)) 3605.
3769 C 3606.
3770 EQUIVALENCE 3607.
3771 + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 3608.
3772 +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 3609.
3773 +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 3610.
3774 +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 3611.
3775 +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 3612.
3776 +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 3613.
3777 C 3614.
3778 EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 3615.
3779 EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 3616.
3780 C 3617.
3781 EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 3618.
3782 EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 3619.
3783 C 3620.
3784 EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 3621.
3785 + ,(FRC(4), FCLO),(FRC(5), FCOV) 3622.
3786 C 3623.
3787 DIMENSION ALVISK(11,4),ALNIRK(11,4) 3624.
3788 C$$ DIMENSION ALMEAN(11,4),RATIRV(11,4) 3625.
3789 DIMENSION FIELDC(11,3),VTMASK(11) 3626.
3790 C 3627.
3791 C 1 2 3 4 3628.
3792 C WINTER SPRING SUMMER AUTUMN 3629.
3793 C 3630.
3794 DATA ALVISK/ 3631.
3795 C 1 2 3 4 5 6 7 8 9 10 11 3632.
3796 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3633.
3797 1 .350, .067, .089, .089, .078, .100, .067, .061, .100, .070, .001,3634.
3798 2 .350, .063, .100, .100, .073, .055, .067, .061, .100, .070, .001,3635.
3799 3 .350, .085, .091, .139, .085, .058, .083, .061, .100, .070, .001,3636.
3800 4 .350, .080, .090, .111, .064, .055, .061, .061, .100, .070, .001/3637.
3801 C 3638.
3802 DATA ALNIRK/ 3639.
3803 C 1 2 3 4 5 6 7 8 9 10 11 3640.
3804 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3641.
3805 1 .350, .200, .267, .267, .233, .300, .200, .183, .100, .070, .001,3642.
3806 2 .350, .206, .350, .300, .241, .218, .200, .183, .100, .070, .001,3643.
3807 3 .350, .298, .364, .417, .298, .288, .250, .183, .100, .070, .001,3644.
3808 4 .350, .255, .315, .333, .204, .218, .183, .183, .100, .070, .001/3645.
3809 C 3646.
3810 C$$ DATA ALMEAN/ 3647.
3811 C 1 2 3 4 5 6 7 8 9 10 11 3648.
3812 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3649.
3813 C$$ 1 .350, .120, .160, .160, .140, .180, .120, .110, .100, .070, .001,3650.
3814 C$$ 2 .350, .120, .200, .180, .140, .120, .120, .110, .100, .070, .001,3651.
3815 C$$ 3 .350, .170, .200, .250, .170, .150, .150, .110, .100, .070, .001,3652.
3816 C$$ 4 .350, .150, .180, .200, .120, .120, .110, .110, .100, .070, .001/3653.
3817 C 3654.
3818 C$$ DATA RATIRV/ 3655.
3819 C 1 2 3 4 5 6 7 8 9 10 11 3656.
3820 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3657.
3821 C$$ 1 1.00, 3.00, 3.00, 3.00, 3.00, 3.00, 3.00, 3.00, 1.00, 3.50, 1.50,3658.
3822 C$$ 2 1.00, 3.30, 3.50, 3.00, 3.30, 4.00, 3.00, 3.00, 1.00, 3.50, 1.50,3659.
3823 C$$ 3 1.00, 3.50, 4.00, 3.00, 3.50, 5.00, 3.00, 3.00, 1.00, 3.50, 1.50,3660.
3824 C$$ 4 1.00, 3.20, 3.50, 3.00, 3.20, 4.00, 3.00, 3.00, 1.00, 3.50, 1.50/3661.
3825 C 3662.
3826 DATA FIELDC/ 3663.
3827 C (KG/M**2) 3664.
3828 C 1 2 3 4 5 6 7 8 9 10 11 3665.
3829 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3666.
3830 1 10.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 200., 10.0, 30.0, 999.,3667.
3831 2 10.0, 200., 200., 300., 300., 450., 450., 450., 10.0, 200., 999.,3668.
3832 3 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0, 10.0/3669.
3833 C 3670.
3834 DATA VTMASK/ 3671.
3835 C (KG/M**2) 3672.
3836 C 1 2 3 4 5 6 7 8 9 10 11 3673.
3837 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF ROCKS CROPS ALGAE3674.
3838 4 10.0, 20.0, 20.0, 50.0, 200., 500.,1000.,2500., 10.0, 30.0, .001/3676.
3839 C 3677.
3840 C 3678.
3841 DATA DLAT/ 3679.
3842 +-90.000000,-82.173913,-74.347826,-66.521739,-58.695652,-50.869565,3680.
3843 +-43.043478,-35.217391,-27.391304,-19.565217,-11.739130,- 3.913043,3681.
3844 + 3.913043, 11.739130, 19.565217, 27.391304, 35.217391, 43.043478,3682.
3845 + 50.869565, 58.695652, 66.521739, 74.347826, 82.173913, 90.000000,3683.
3846 + 22*0.0000/ 3684.
3847 C 3685.
3848 DATA DLON/ 3686.
3849 + 0.0, 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 70.0, 80.0, 3687.
3850 + 90.0, 100.0, 110.0, 120.0, 130.0, 140.0, 150.0, 160.0, 170.0, 3688.
3851 + 180.0, 190.0, 200.0, 210.0, 220.0, 230.0, 240.0, 250.0, 260.0, 3689.
3852 + 270.0, 280.0, 290.0, 300.0, 310.0, 320.0, 330.0, 340.0, 350.0, 3690.
3853 +36*0.0/ 3691.
3854 C 3692.
3855 C-----------------------------------------------------------------------3693.
3856 C TRACE GAS REFERENCE AMOUNTS & DISTRIBUTIONS ARE DEFINED IN SETGAS3694.
3857 C-----------------------------------------------------------------------3695.
3858 C 3696.
3859 C 3697.
3860 C H2O CO2 O3 O2 NO2 N2O CH4 F11 F12 3698.
3861 C 1 2 3 4 5 6 7 8 9 3699.
3862 DATA FULGAS/ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 3700.
3863 + , 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0/ 3701.
3864 C 3702.
3865 C GLOBAL OCEAN LAND DESERT HAZE TR1 TR2 TR3 TR4 3703.
3866 C 1 2 3 4 5 6 7 8 9 3704.
3867 C 3705.
3868 DATA FGOLDH/ 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0 3706.
3869 + , 1.0, .68, .32, 1.E-20,1.E-20, 0.0, 0.0, 0.0, 0.0/ 3707.
3870 C 3708.
3871 DATA LASTVC/-123456/, KFORCE/-123456789/ 3709.
3872 C 3710.
3873 C 3711.
3874 DATA TAUMIN/1.0E-04/, TLGRAD/ 1.0/, EOCTRA/1.0/, ZOCSRA/1.0/ 3712.
3875 DATA FRACSL/1.0E-02/, TKCICE/258./, ESNTRA/1.0/, ZSNSRA/1.0/ 3713.
3876 DATA RATQSL/1.0 /, FLONO3/ 0.0/, EICTRA/1.0/, ZICSRA/1.0/ 3714.
3877 DATA FOGTSL/0.0 /, ECLTRA/1.00/, EDSTRA/1.0/, ZDSSRA/1.0/ 3715.
3878 DATA PTLISO/2.5E+00/, ZCLSRA/1.00/, EVGTRA/1.0/, ZVGSRA/1.0/ 3716.
3879 C 3717.
3880 DATA FMARCL/0.50/, FCLDTR/1.0/, NTRACE/0/, IDPROG/0/ 3718.
3881 DATA WETTRA/1.00/, FCLDSR/1.0/, ITR(1)/0/, ID2TRD/0/ 3719.
3882 DATA WETSRA/1.00/, FALGAE/1.0/, ITR(2)/0/, ID3SRD/0/ 3720.
3883 DATA DMOICE/10.0/, FRAYLE/1.0/, ITR(3)/0/, ID4VEG/0/ 3721.
3884 DATA DMLICE/10.0/, LICETK/ 0/, ITR(4)/0/, ID5FOR/0/ 3722.
3885 C 3723.
3886 DATA NV/ 8/ 3724.
3887 DATA IMGAS1/1/, KEEPRH/0/, KGASSR/0/, LAYRAD/ 3/ 3725.
3888 DATA IMGAS2/3/, KEEPAL/0/, KAERSR/0/, NL/12/ 3726.
3889 DATA ILGAS1/2/, ISOSCT/0/, KFRACC/0/, NLP/13/ 3727.
3890 DATA ILGAS2/9/, IHGSCT/0/, MARCLD/0/, JMLAT/24/ 3728.
3891 DATA KWVCON/1/, LAPGAS/1/, NORMS0/1/, IMLON/36/ 3729.
3892 C 3730.
3893 DATA JYEAR/1958/, JLAT/18/, S0/1367.0/ 3731.
3894 DATA JDAY/ 0/, ILON/18/, COSZ/0.5000/ 3732.
3895 C 3733.
3896 DATA POCEAN/0.700/, TGO/288.15/, AGESN/1.00/, WMAG/2.00/ 3734.
3897 DATA PEARTH/0.100/, TGE/288.15/, SNOWE/0.30/, WEARTH/0.00/ 3735.
3898 DATA POICE/0.100/, TGOI/288.15/, SNOWOI/0.10/, ZOICE/10.0/ 3736.
3899 DATA PLICE/0.100/, TGLI/288.15/, SNOWLI/0.20/, FRACCC/0.00/ 3737.
3900 DATA TSL/288.15/ 3738.
3901 C 3739.
3902 DATA PLB/ 3740.
3903 + 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 3741.
3904 + 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 3742.
3905 + 1.E-05, 27*0.00/ 3743.
3906 C 3744.
3907 DATA HLB/ 3745.
3908 + 1.E-10,1.0,2.0,3.0,6.0,11.0,20.0,32.0,47.0,51.0,71.0 3746.
3909 + ,84.852,99.99,27*99.999/ 3747.
3910 C 3748.
3911 DATA TLB/40*250./ 3749.
3912 DATA TLT/40*250./ 3750.
3913 DATA TLM/40*250./ 3751.
3914 C 3752.
3915 DATA U0GAS/360*0./ 3753.
3916 DATA ULGAS/360*0./ 3754.
3917 C 3755.
3918 DATA TRACER/160*0./ 3756.
3919 DATA CLDTAU/ 40*0./ 3757.
3920 C 3758.
3921 DATA SHL/40*0./ 3759.
3922 DATA RHL/40*0./ 3760.
3923 C 3761.
3924 DATA PVT/8*0.125,3*0.0/ 3762.
3925 C 3763.
3926 DATA SRBXAL/30*0./ 3764.
3927 DATA BXA/153*0./ 3765.
3928 C 3766.
3929 DATA LUXGAS/1/ 3767.
3930 DATA KALVIS/0/ 3768.
3931 DATA MEANAL/0/ 3769.
3932 C 3770.
3933 C-----------------------------------------------------------------------3771.
3934 C AEROSOL RADIATIVE PROPERTIES,COMPOSITION,TYPE & VERTICAL DISTRIBUTION3772.
3935 C-----------------------------------------------------------------------3773.
3936 C 3774.
3937 C BLOCKD INITIALIZED DEFAULT DATA 3775.
3938 C 3776.
3939 C 3785.
3940 DIMENSION QACID1(25),QACID2(25),QSLFT1(25),QSLFT2(25) 3786.
3941 T ,QBSLT1(25),QBSLT2(25),QSSALT(25),QDUST1(25) 3787.
3942 T ,QDUST2(25),QCARB1(25),QCARB2(25) 3788.
3943 T ,SACID1(25),SACID2(25),SSLFT1(25),SSLFT2(25) 3789.
3944 T ,SBSLT1(25),SBSLT2(25),SSSALT(25),SDUST1(25) 3790.
3945 T ,SDUST2(25),SCARB1(25),SCARB2(25) 3791.
3946 T ,CACID1(25),CACID2(25),CSLFT1(25),CSLFT2(25) 3792.
3947 T ,CBSLT1(25),CBSLT2(25),CSSALT(25),CDUST1(25) 3793.
3948 T ,CDUST2(25),CCARB1(25),CCARB2(25) 3794.
3949 T ,QWATER(25),QICE25(25),SWATER(25),SICE25(25) 3795.
3950 T ,CWATER(25),CICE25(25) 3796.
3951 C 3797.
3952 S ,XACID1(6),XACID2(6),XSLFT1(6),XSLFT2(6),XBSLT1(6),XBSLT2(6)3798.
3953 S ,XSSALT(6),XDUST1(6),XDUST2(6),XCARB1(6),XCARB2(6) 3799.
3954 S ,YACID1(6),YACID2(6),YSLFT1(6),YSLFT2(6),YBSLT1(6),YBSLT2(6)3800.
3955 S ,YSSALT(6),YDUST1(6),YDUST2(6),YCARB1(6),YCARB2(6) 3801.
3956 S ,ZACID1(6),ZACID2(6),ZSLFT1(6),ZSLFT2(6),ZBSLT1(6),ZBSLT2(6)3802.
3957 S ,ZSSALT(6),ZDUST1(6),ZDUST2(6),ZCARB1(6),ZCARB2(6) 3803.
3958 S ,XWATER(6),XICE25(6),YWATER(6),YICE25(6),ZWATER(6),ZICE25(6)3804.
3959 C 3805.
3960 EQUIVALENCE (TRAQEX(1, 1),QACID1(1)),(TRAQEX(1, 2),QACID2(1)) 3806.
3961 1 ,(TRAQEX(1, 3),QSLFT1(1)),(TRAQEX(1, 4),QSLFT2(1)) 3807.
3962 2 ,(TRAQEX(1, 5),QBSLT1(1)),(TRAQEX(1, 6),QBSLT2(1)) 3808.
3963 3 ,(TRAQEX(1, 7),QSSALT(1)),(TRAQEX(1, 8),QDUST1(1)) 3809.
3964 4 ,(TRAQEX(1, 9),QDUST2(1)),(TRAQEX(1,10),QCARB1(1)) 3810.
3965 5 ,(TRAQEX(1,11),QCARB2(1)) 3811.
3966 C 3812.
3967 EQUIVALENCE (TRAQSC(1, 1),SACID1(1)),(TRAQSC(1, 2),SACID2(1)) 3813.
3968 1 ,(TRAQSC(1, 3),SSLFT1(1)),(TRAQSC(1, 4),SSLFT2(1)) 3814.
3969 2 ,(TRAQSC(1, 5),SBSLT1(1)),(TRAQSC(1, 6),SBSLT2(1)) 3815.
3970 3 ,(TRAQSC(1, 7),SSSALT(1)),(TRAQSC(1, 8),SDUST1(1)) 3816.
3971 4 ,(TRAQSC(1, 9),SDUST2(1)),(TRAQSC(1,10),SCARB1(1)) 3817.
3972 5 ,(TRAQSC(1,11),SCARB2(1)) 3818.
3973 C 3819.
3974 EQUIVALENCE (TRACOS(1, 1),CACID1(1)),(TRACOS(1, 2),CACID2(1)) 3820.
3975 1 ,(TRACOS(1, 3),CSLFT1(1)),(TRACOS(1, 4),CSLFT2(1)) 3821.
3976 2 ,(TRACOS(1, 5),CBSLT1(1)),(TRACOS(1, 6),CBSLT2(1)) 3822.
3977 3 ,(TRACOS(1, 7),CSSALT(1)),(TRACOS(1, 8),CDUST1(1)) 3823.
3978 4 ,(TRACOS(1, 9),CDUST2(1)),(TRACOS(1,10),CCARB1(1)) 3824.
3979 5 ,(TRACOS(1,11),CCARB2(1)) 3825.
3980 C 3826.
3981 EQUIVALENCE (TRCQEX(1, 1),QWATER(1)),(TRCQEX(1, 2),QICE25(1)) 3827.
3982 EQUIVALENCE (TRCQSC(1, 1),SWATER(1)),(TRCQSC(1, 2),SICE25(1)) 3828.
3983 EQUIVALENCE (TRCCOS(1, 1),CWATER(1)),(TRCCOS(1, 2),CICE25(1)) 3829.
3984 3830.
3985 C 3831.
3986 EQUIVALENCE (SRAQEX(1, 1),XACID1(1)),(SRAQEX(1, 2),XACID2(1)) 3832.
3987 1 ,(SRAQEX(1, 3),XSLFT1(1)),(SRAQEX(1, 4),XSLFT2(1)) 3833.
3988 2 ,(SRAQEX(1, 5),XBSLT1(1)),(SRAQEX(1, 6),XBSLT2(1)) 3834.
3989 3 ,(SRAQEX(1, 7),XSSALT(1)),(SRAQEX(1, 8),XDUST1(1)) 3835.
3990 4 ,(SRAQEX(1, 9),XDUST2(1)),(SRAQEX(1,10),XCARB1(1)) 3836.
3991 5 ,(SRAQEX(1,11),XCARB2(1)) 3837.
3992 C 3838.
3993 EQUIVALENCE (SRAQSC(1, 1),YACID1(1)),(SRAQSC(1, 2),YACID2(1)) 3839.
3994 1 ,(SRAQSC(1, 3),YSLFT1(1)),(SRAQSC(1, 4),YSLFT2(1)) 3840.
3995 2 ,(SRAQSC(1, 5),YBSLT1(1)),(SRAQSC(1, 6),YBSLT2(1)) 3841.
3996 3 ,(SRAQSC(1, 7),YSSALT(1)),(SRAQSC(1, 8),YDUST1(1)) 3842.
3997 4 ,(SRAQSC(1, 9),YDUST2(1)),(SRAQSC(1,10),YCARB1(1)) 3843.
3998 5 ,(SRAQSC(1,11),YCARB2(1)) 3844.
3999 C 3845.
4000 EQUIVALENCE (SRACOS(1, 1),ZACID1(1)),(SRACOS(1, 2),ZACID2(1)) 3846.
4001 1 ,(SRACOS(1, 3),ZSLFT1(1)),(SRACOS(1, 4),ZSLFT2(1)) 3847.
4002 2 ,(SRACOS(1, 5),ZBSLT1(1)),(SRACOS(1, 6),ZBSLT2(1)) 3848.
4003 3 ,(SRACOS(1, 7),ZSSALT(1)),(SRACOS(1, 8),ZDUST1(1)) 3849.
4004 4 ,(SRACOS(1, 9),ZDUST2(1)),(SRACOS(1,10),ZCARB1(1)) 3850.
4005 5 ,(SRACOS(1,11),ZCARB2(1)) 3851.
4006 C 3852.
4007 EQUIVALENCE (SRCQEX(1, 1),XWATER(1)),(SRCQEX(1, 2),XICE25(1)) 3853.
4008 EQUIVALENCE (SRCQSC(1, 1),YWATER(1)),(SRCQSC(1, 2),YICE25(1)) 3854.
4009 EQUIVALENCE (SRCCOS(1, 1),ZWATER(1)),(SRCCOS(1, 2),ZICE25(1)) 3855.
4010 3856.
4011 C 3857.
4012 DATA NGOLDH/5/,NAERO/11/ 3858.
4013 C 3859.
4014 C-----------------------------------------------------------------------3860.
4015 C COMPOSITION & VERTICAL DISTRIBUTION FOR 5 SPECIFIED AEROSOL TYPES3861.
4016 C-----------------------------------------------------------------------3862.
4017 C TYPE 3863.
4018 C 1 STRATOSPHERIC GLOBAL AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3864.
4019 C 2 TROPOSPHERIC OCEAN AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3865.
4020 C 3 TROPOSPHERIC LAND AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES 3866.
4021 C 4 TROPOSPHERIC DESERT AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3867.
4022 C 5 TROPOSPHERIC HAZE AEROSOL A,B,C ARE LOCAL AVERAGE VALUES 3868.
4023 C 3869.
4024 C 1 2 3 4 5 6 7 8 9 10 11 3870.
4025 C ACID1 OCT82 SLFT1 SLFT2 BSLT1 BSLT2 SSALT DUST1 DUST2 MAY82 CARB23871.
4026 DATA AGOLDH/ 3872.
4027 1 .012, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3873.
4028 2 .0, .0, .018, .033, .012, .023, .011, .0, .0, .0, .0,3874.
4029 3 .0, .0, .031, .057, .021, .042, .0, .0, .0, .0, .018,3875.
4030 4 .0, .0, .0, .0, .0, .0, .0, .300, .300, .0, .0,3876.
4031 5 .0, .250, .0, .0, .0, .0, .0, .300, .0, .0, .0/3877.
4032 DATA BGOLDH/ 3878.
4033 1 20.0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3879.
4034 2 .0, .0, 4.00, 0.00, 4.00, 1.00, 0.00, .0, .0, .0, .0,3880.
4035 3 .0, .0, 4.00, 0.00, 4.00, 0.00, .0, .0, .0, .0, 0.00,3881.
4036 4 .0, .0, .0, .0, .0, .0, .0, 3.50, 0.00, .0, .0,3882.
4037 5 .0, 0.00, .0, .0, .0, .0, .0, 3.50, .0, .0, .0/3883.
4038 DATA CGOLDH/ 3884.
4039 1 3.00, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,3885.
4040 2 .0, .0, 3.00, 1.00, 3.00, 0.5, 1.00, .0, .0, .0, .0,3886.
4041 3 .0, .0, 3.00, 1.00, 3.00, 1.00, .0, .0, .0, .0, 1.00,3887.
4042 4 .0, .0, .0, .0, .0, .0, .0, 1.00, 1.00, .0, .0,3888.
4043 5 .0, 1.00, .0, .0, .0, .0, .0, 1.00, .0, .0, .0/3889.
4044 C 3890.
4045 C-----------------------------------------------------------------------3891.
4046 C THERMAL RADIATION 25 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB3892.
4047 C-----------------------------------------------------------------------3893.
4048 DATA QACID1/ 3894.
4049 + 0.04052,0.05895,0.08506,0.06673,0.05160,0.04437,0.03864, 3895.
4050 + 0.02719,0.01668,0.01146,0.00705,0.03286,0.02449,0.03017, 3896.
4051 + 0.03198,0.02891,0.02634,0.02366,0.02300,0.02271,0.02159, 3897.
4052 + 0.08516,0.08825,0.08982,0.09284/ 3898.
4053 DATA SACID1/ 3899.
4054 + 0.00095,0.00361,0.00273,0.00226,0.00150,0.00141,0.00131, 3900.
4055 + 0.00090,0.00049,0.00029,0.00014,0.00072,0.00049,0.00031, 3901.
4056 + 0.00023,0.00023,0.00022,0.00020,0.00019,0.00018,0.00018, 3902.
4057 + 0.00183,0.00201,0.00205,0.00207/ 3903.
4058 DATA CACID1/ 3904.
4059 + 0.11030,0.17256,0.17138,0.19696,0.19510,0.18945,0.18874, 3905.
4060 + 0.18795,0.18313,0.17814,0.17075,0.10583,0.09756,0.08388, 3906.
4061 + 0.07246,0.07266,0.07099,0.06873,0.06754,0.06661,0.06674, 3907.
4062 + 0.11197,0.11068,0.10998,0.10852/ 3908.
4063 C 3909.
4064 DATA QACID2/ 3910.
4065 + 0.05764,0.15189,0.06264,0.04527,0.03973,0.03646,0.03375, 3911.
4066 + 0.02163,0.01337,0.00979,0.00724,0.04076,0.03631,0.04273, 3912.
4067 + 0.04072,0.03752,0.03290,0.03012,0.02968,0.02914,0.02763, 3913.
4068 + 0.10731,0.12510,0.12901,0.13232/ 3914.
4069 DATA SACID2/ 3915.
4070 + 0.00367,0.00752,0.00264,0.00172,0.00188,0.00221,0.00225, 3916.
4071 + 0.00134,0.00066,0.00034,0.00012,0.00237,0.00121,0.00084, 3917.
4072 + 0.00080,0.00081,0.00074,0.00069,0.00067,0.00065,0.00064, 3918.
4073 + 0.00674,0.00807,0.00825,0.00837/ 3919.
4074 DATA CACID2/ 3920.
4075 + 0.05720,0.11171,0.11850,0.11443,0.12325,0.13171,0.13500, 3921.
4076 + 0.13575,0.13419,0.12666,0.10961,0.05186,0.04026,0.03219, 3922.
4077 + 0.03060,0.03105,0.03041,0.02959,0.02911,0.02884,0.02901, 3923.
4078 + 0.07145,0.07168,0.07134,0.07096/ 3924.
4079 C 3925.
4080 DATA QSLFT1/ 3926.
4081 + 0.15555,0.16333,0.16406,0.16396,0.16070,0.14074,0.11920, 3927.
4082 + 0.09140,0.07341,0.06645,0.05871,0.15301,0.13456,0.15809, 3928.
4083 + 0.16264,0.14805,0.12798,0.10588,0.09960,0.09604,0.08844, 3929.
4084 + 0.35895,0.27430,0.26964,0.27183/ 3930.
4085 DATA SSLFT1/ 3931.
4086 + 0.13162,0.13152,0.11642,0.12932,0.10550,0.08323,0.07081, 3932.
4087 + 0.05079,0.03287,0.02458,0.01871,0.12787,0.11183,0.09490, 3933.
4088 + 0.08739,0.08716,0.08022,0.07182,0.06899,0.06700,0.06496, 3934.
4089 + 0.13067,0.12933,0.12878,0.12808/ 3935.
4090 DATA CSLFT1/ 3936.
4091 + 0.52508,0.48102,0.59654,0.66259,0.66566,0.70224,0.71546, 3937.
4092 + 0.69308,0.62819,0.55963,0.45811,0.52840,0.54500,0.51620, 3938.
4093 + 0.50685,0.52475,0.54985,0.58351,0.59484,0.60203,0.61652, 3939.
4094 + 0.45926,0.47060,0.47243,0.47178/ 3940.
4095 C 3941.
4096 DATA QSLFT2/ 3942.
4097 + 0.44109,0.37065,0.38095,0.40554,0.37738,0.32564,0.27970, 3943.
4098 + 0.21687,0.17752,0.16154,0.14952,0.43239,0.38517,0.39512, 3944.
4099 + 0.39098,0.36978,0.32960,0.28406,0.27042,0.26204,0.24771, 3945.
4100 + 0.63665,0.59084,0.58844,0.59078/ 3946.
4101 DATA SSLFT2/ 3947.
4102 + 0.37818,0.31549,0.29505,0.33810,0.28074,0.22692,0.19562, 3948.
4103 + 0.14289,0.09653,0.07449,0.06008,0.36685,0.33089,0.28296, 3949.
4104 + 0.26185,0.26286,0.24369,0.22019,0.21220,0.20647,0.20093, 3950.
4105 + 0.31870,0.30963,0.30762,0.30507/ 3951.
4106 DATA CSLFT2/ 3952.
4107 + 0.54586,0.50074,0.62826,0.69007,0.69596,0.73443,0.74600, 3953.
4108 + 0.71846,0.64430,0.57291,0.47311,0.54977,0.56612,0.53939, 3954.
4109 + 0.53105,0.54799,0.57221,0.60426,0.61497,0.62179,0.63518, 3955.
4110 + 0.51454,0.52095,0.52268,0.52316/ 3956.
4111 C 3957.
4112 DATA QBSLT1/ 3958.
4113 + 0.19787,0.15206,0.14808,0.15505,0.14132,0.12508,0.10931, 3959.
4114 + 0.07946,0.05659,0.04675,0.03801,0.20081,0.15823,0.15732, 3960.
4115 + 0.15377,0.14273,0.13163,0.12005,0.11684,0.11523,0.11121, 3961.
4116 + 0.36601,0.39099,0.39240,0.39274/ 3962.
4117 DATA SBSLT1/ 3963.
4118 + 0.09892,0.12369,0.09780,0.11017,0.08914,0.08577,0.07794, 3964.
4119 + 0.05688,0.03912,0.03069,0.02440,0.09492,0.08277,0.05817, 3965.
4120 + 0.04773,0.04970,0.04568,0.04058,0.03865,0.03717,0.03641, 3966.
4121 + 0.07710,0.08232,0.08235,0.08163/ 3967.
4122 DATA CBSLT1/ 3968.
4123 + 0.54090,0.49369,0.59375,0.67539,0.69444,0.71623,0.71674, 3969.
4124 + 0.69425,0.63125,0.57379,0.48766,0.54072,0.57272,0.57215, 3970.
4125 + 0.57655,0.59243,0.60616,0.62323,0.62911,0.63253,0.63934, 3971.
4126 + 0.51632,0.50380,0.50414,0.50666/ 3972.
4127 C 3973.
4128 DATA QBSLT2/ 3974.
4129 + 0.49004,0.35700,0.34009,0.38146,0.35476,0.32874,0.29258, 3975.
4130 + 0.21726,0.16067,0.13571,0.11451,0.48169,0.40550,0.37263, 3976.
4131 + 0.35312,0.33842,0.31466,0.28850,0.28051,0.27574,0.26813, 3977.
4132 + 0.59495,0.63654,0.63850,0.63742/ 3978.
4133 DATA SBSLT2/ 3979.
4134 + 0.26833,0.30862,0.25309,0.29334,0.24644,0.24238,0.22164, 3980.
4135 + 0.16459,0.11742,0.09480,0.07809,0.26006,0.23936,0.17265, 3981.
4136 + 0.14418,0.15103,0.13960,0.12488,0.11925,0.11488,0.11275, 3982.
4137 + 0.19766,0.20963,0.20969,0.20807/ 3983.
4138 DATA CBSLT2/ 3984.
4139 + 0.57850,0.51330,0.62334,0.70306,0.72063,0.74166,0.74111, 3985.
4140 + 0.71466,0.64442,0.58410,0.49911,0.58174,0.60690,0.60535, 3986.
4141 + 0.60954,0.62353,0.63716,0.65423,0.66019,0.66381,0.67030, 3987.
4142 + 0.58670,0.57707,0.57759,0.58014/ 3988.
4143 C 3989.
4144 DATA QSSALT/ 3990.
4145 + 0.27651,0.36950,0.40122,0.39669,0.34286,0.33458,0.29978, 3991.
4146 + 0.26075,0.26470,0.26660,0.28507,0.27114,0.23752,0.18761, 3992.
4147 + 0.16890,0.17532,0.17705,0.17827,0.17801,0.17743,0.17914, 3993.
4148 + 0.34241,0.33620,0.33607,0.33681/ 3994.
4149 DATA SSSALT/ 3995.
4150 + 0.27651,0.36950,0.40121,0.39659,0.34226,0.33245,0.29555, 3996.
4151 + 0.22360,0.16290,0.13425,0.11177,0.27114,0.23751,0.18755, 3997.
4152 + 0.16883,0.17526,0.17700,0.17823,0.17797,0.17739,0.17911, 3998.
4153 + 0.34241,0.33620,0.33607,0.33681/ 3999.
4154 DATA CSSALT/ 4000.
4155 + 0.66858,0.50298,0.60372,0.65282,0.66694,0.67041,0.66666, 4001.
4156 + 0.62258,0.52248,0.44732,0.32878,0.66866,0.66680,0.66404, 4002.
4157 + 0.66252,0.66281,0.66265,0.66244,0.66232,0.66223,0.66226, 4003.
4158 + 0.67338,0.67406,0.67410,0.67408/ 4004.
4159 C 4005.
4160 DATA QDUST1/ 4006.
4161 + 0.60958,0.65996,0.59890,0.73030,0.64827,0.55835,0.48157, 4007.
4162 + 0.34847,0.23144,0.18097,0.13460,0.59012,0.47533,0.39938, 4008.
4163 + 0.36575,0.35808,0.33834,0.31587,0.30849,0.30369,0.29821, 4009.
4164 + 0.91360,1.14613,1.16193,1.16619/ 4010.
4165 DATA SDUST1/ 4011.
4166 + 0.32015,0.60541,0.49800,0.59591,0.46651,0.39745,0.34242, 4012.
4167 + 0.23468,0.13039,0.08473,0.04350,0.29084,0.23940,0.16410, 4013.
4168 + 0.13070,0.13267,0.12095,0.10691,0.10167,0.09788,0.09578, 4014.
4169 + 0.39128,0.54469,0.55555,0.55942/ 4015.
4170 DATA CDUST1/ 4016.
4171 + 0.50425,0.49645,0.57736,0.63615,0.63373,0.66224,0.67205, 4017.
4172 + 0.67034,0.65137,0.61767,0.53600,0.49640,0.47921,0.43825, 4018.
4173 + 0.40760,0.41364,0.41120,0.40706,0.40418,0.40149,0.40315, 4019.
4174 + 0.47280,0.39308,0.38801,0.38670/ 4020.
4175 C 4021.
4176 DATA QDUST2/ 4022.
4177 + 0.95483,0.71515,0.77676,0.91847,0.93699,0.89565,0.82979, 4023.
4178 + 0.74871,0.70959,0.69272,0.68748,0.94632,0.90846,0.85600, 4024.
4179 + 0.83350,0.83544,0.82317,0.80807,0.80270,0.79879,0.79577, 4025.
4180 + 1.02427,1.12417,1.13054,1.13169/ 4026.
4181 DATA SDUST2/ 4027.
4182 + 0.49885,0.58157,0.55165,0.64038,0.59140,0.55222,0.50136, 4028.
4183 + 0.42019,0.36087,0.33502,0.31667,0.49026,0.47989,0.42207, 4029.
4184 + 0.39751,0.40487,0.39774,0.38819,0.38426,0.38107,0.38027, 4030.
4185 + 0.49780,0.59147,0.59817,0.60013/ 4031.
4186 DATA CDUST2/ 4032.
4187 + 0.74352,0.54594,0.68229,0.72513,0.73598,0.75710,0.75041, 4033.
4188 + 0.70723,0.65024,0.61702,0.58021,0.74556,0.74741,0.75647, 4034.
4189 + 0.76384,0.76647,0.77599,0.78746,0.79136,0.79400,0.79700, 4035.
4190 + 0.71874,0.62817,0.62224,0.62062/ 4036.
4191 C 4037.
4192 DATA QCARB1/ 4038.
4193 + 0.44718,0.51882,0.26055,0.20526,0.19295,0.18655,0.17520, 4039.
4194 + 0.11120,0.06749,0.04893,0.03537,0.32912,0.25261,0.24973, 4040.
4195 + 0.23947,0.22883,0.20424,0.18781,0.18400,0.18032,0.17370, 4041.
4196 + 0.57200,0.64430,0.65267,0.65790/ 4042.
4197 DATA SCARB1/ 4043.
4198 + 0.17857,0.12659,0.06506,0.05088,0.05317,0.05712,0.05562, 4044.
4199 + 0.03310,0.01705,0.01009,0.00493,0.13908,0.08683,0.06332, 4045.
4200 + 0.06114,0.06260,0.05755,0.05319,0.05155,0.05032,0.04981, 4046.
4201 + 0.19594,0.21003,0.20967,0.20853/ 4047.
4202 DATA CCARB1/ 4048.
4203 + 0.40490,0.48729,0.43960,0.40824,0.46236,0.51422,0.53366, 4049.
4204 + 0.53211,0.51283,0.46211,0.32882,0.40923,0.35984,0.30817, 4050.
4205 + 0.30468,0.31306,0.31215,0.30857,0.30555,0.30388,0.30644, 4051.
4206 + 0.43102,0.40748,0.40436,0.40208/ 4052.
4207 C 4053.
4208 DATA QCARB2/ 4054.
4209 + 0.09591,0.22971,0.21603,0.21745,0.17928,0.17061,0.15202, 4055.
4210 + 0.10846,0.06721,0.04817,0.03076,0.09456,0.08428,0.07093, 4056.
4211 + 0.06589,0.06737,0.06766,0.06782,0.06771,0.06754,0.06792, 4057.
4212 + 0.12455,0.12130,0.12121,0.12155/ 4058.
4213 DATA SCARB2/ 4059.
4214 + 0.00748,0.06133,0.05031,0.04978,0.03714,0.03448,0.03065, 4060.
4215 + 0.02099,0.01137,0.00688,0.00291,0.00728,0.00544,0.00350, 4061.
4216 + 0.00276,0.00291,0.00290,0.00288,0.00285,0.00282,0.00286, 4062.
4217 + 0.01420,0.01327,0.01324,0.01332/ 4063.
4218 DATA CCARB2/ 4064.
4219 + 0.14117,0.25269,0.27090,0.30506,0.29845,0.28974,0.28880, 4065.
4220 + 0.28843,0.28603,0.28395,0.29112,0.14128,0.12741,0.11121, 4066.
4221 + 0.09892,0.09935,0.09786,0.09604,0.09517,0.09448,0.09466, 4067.
4222 + 0.18297,0.17686,0.17658,0.17696/ 4068.
4223 C 4069.
4224 DATA QWATER/ 4070.
4225 + 0.82334,0.89509,1.13254,1.20762,1.24075,1.18580,1.07585, 4071.
4226 + 0.95283,0.89542,0.86914,0.85864,0.87834,0.94021,1.03878, 4072.
4227 + 1.07876,1.06927,1.06987,1.07153,1.07327,1.07505,1.07280, 4073.
4228 + 1.20709,1.20194,1.20383,1.20978/ 4074.
4229 DATA SWATER/ 4075.
4230 + 0.34695,0.68566,0.86748,0.89010,0.83121,0.75556,0.65338, 4076.
4231 + 0.51441,0.40925,0.36469,0.31873,0.39396,0.39368,0.43707, 4077.
4232 + 0.45625,0.44997,0.45039,0.45146,0.45251,0.45357,0.45227, 4078.
4233 + 0.85537,0.85478,0.85718,0.86370/ 4079.
4234 DATA CWATER/ 4080.
4235 + 0.91848,0.65450,0.79206,0.82335,0.83709,0.84869,0.84338, 4081.
4236 + 0.77907,0.68419,0.62521,0.54076,0.91355,0.89224,0.85667, 4082.
4237 + 0.84557,0.85029,0.85229,0.85399,0.85411,0.85389,0.85524, 4083.
4238 + 0.91095,0.91472,0.91488,0.91467/ 4084.
4239 C 4085.
4240 DATA QICE25/ 4086.
4241 + 1.15210,0.81551,0.98885,1.10325,1.17652,1.14217,1.07777, 4087.
4242 + 1.08252,1.14496,1.16939,1.22006,1.16194,1.16781,1.19342, 4088.
4243 + 1.20279,1.19736,1.19435,1.19146,1.19097,1.19095,1.18924, 4089.
4244 + 1.19321,1.21794,1.21959,1.21942/ 4090.
4245 DATA SICE25/ 4091.
4246 + 0.57392,0.45452,0.57278,0.68806,0.74580,0.69171,0.64662, 4092.
4247 + 0.62884,0.64120,0.64892,0.66105,0.59403,0.60241,0.67853, 4093.
4248 + 0.70399,0.68299,0.66547,0.64731,0.64301,0.64122,0.63321, 4094.
4249 + 0.71867,0.77122,0.77524,0.77622/ 4095.
4250 DATA CICE25/ 4096.
4251 + 0.93634,0.72920,0.86084,0.88431,0.87489,0.88472,0.86613, 4097.
4252 + 0.82078,0.79850,0.79041,0.78539,0.93377,0.91036,0.85751, 4098.
4253 + 0.84228,0.85220,0.86089,0.87036,0.87263,0.87355,0.87810, 4099.
4254 + 0.94697,0.94840,0.94812,0.94714/ 4100.
4255 C 4101.
4256 C-----------------------------------------------------------------------4102.
4257 C SOLAR RADIATION 6 K-INTERVAL MERGED AEROSOL DATA FOR QEXT,QSCA,COSB4103.
4258 C-----------------------------------------------------------------------4104.
4259 C 4105.
4260 DATA XACID1/ 0.05776,0.10033,0.19099,0.36614,0.55931,1.04703/ 4106.
4261 DATA YACID1/ 0.01880,0.09956,0.19090,0.36613,0.55931,1.04703/ 4107.
4262 DATA ZACID1/ 0.36054,0.51871,0.57276,0.62068,0.65273,0.68988/ 4108.
4263 C 4109.
4264 DATA XACID2/0.13360,0.33875,0.51498,0.68359,0.79939,0.94494/ 4110.
4265 DATA YACID2/0.07420,0.33691,0.51483,0.68358,0.79939,0.94494/ 4111.
4266 C$ DATA ZACID2/0.40248,0.62259,0.68524,0.71328,0.71195,0.72894/ 4112.
4267 DATA ZACID2/0.39821,0.54835,0.60846,0.63637,0.63503,0.65221/ 4112.1
4268 C 4113.
4269 DATA XSLFT1/ 0.31035,0.44757,0.54238,0.66756,0.78260,1.04454/ 4114.
4270 DATA YSLFT1/ 0.24589,0.44490,0.54224,0.66755,0.78260,1.04454/ 4115.
4271 DATA ZSLFT1/ 0.70591,0.67557,0.66832,0.66438,0.66199,0.66008/ 4116.
4272 C 4117.
4273 DATA XSLFT2/ 0.60959,0.74888,0.81124,0.87560,0.92632,1.00936/ 4118.
4274 DATA YSLFT2/ 0.50477,0.74262,0.81090,0.87556,0.92631,1.00935/ 4119.
4275 DATA ZSLFT2/ 0.74067,0.70281,0.69748,0.69922,0.70070,0.70754/ 4120.
4276 C 4121.
4277 DATA XBSLT1/ 0.30419,0.46195,0.54908,0.66403,0.77732,1.02644/ 4122.
4278 DATA YBSLT1/ 0.28732,0.44765,0.53358,0.64786,0.76063,1.00769/ 4123.
4279 DATA ZBSLT1/ 0.67768,0.66588,0.66785,0.66932,0.66671,0.66818/ 4124.
4280 C 4125.
4281 DATA XBSLT2/ 0.62145,0.76377,0.81783,0.87743,0.92782,1.00765/ 4126.
4282 DATA YBSLT2/ 0.58466,0.73120,0.78367,0.84258,0.89259,0.96944/ 4127.
4283 DATA ZBSLT2/ 0.70368,0.69767,0.70313,0.70847,0.70983,0.71935/ 4128.
4284 C 4129.
4285 DATA XSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00414/ 4130.
4286 DATA YSSALT/ 0.64091,0.78294,0.83066,0.87490,0.92554,1.00413/ 4131.
4287 DATA ZSSALT/ 0.67233,0.68272,0.68718,0.69084,0.69334,0.69627/ 4132.
4288 C 4133.
4289 DATA XDUST1/ 1.17571,1.20282,1.13894,1.08190,1.04572,0.99864/ 4134.
4290 DATA YDUST1/ 1.04642,1.12320,1.04442,0.97057,0.93288,0.78720/ 4135.
4291 DATA ZDUST1/ 0.72235,0.68164,0.69516,0.72361,0.74315,0.80409/ 4136.
4292 C 4137.
4293 DATA XDUST2/ 1.09335,1.12888,1.09512,1.05217,1.02411,1.00081/ 4138.
4294 DATA YDUST2/ 0.83740,0.93590,0.88162,0.81721,0.78602,0.68767/ 4139.
4295 DATA ZDUST2/ 0.78776,0.76447,0.77511,0.79364,0.80840,0.85594/ 4140.
4296 C 4141.
4297 DATA XCARB1/0.74444,1.11851,1.14599,1.09902,1.05179,1.00292/ 4142.
4298 DATA YCARB1/0.53412,1.11290,1.14544,1.09899,1.05179,1.00292/ 4143.
4299 C$ DATA ZCARB1/0.75767,0.74553,0.72950,0.71977,0.71968,0.74073/ 4144.
4300 DATA ZCARB1/0.71248,0.66984,0.65284,0.64292,0.64282,0.66426/ 4144.1
4301 C 4145.
4302 DATA XCARB2/ 0.54418,0.82500,0.91922,0.97919,1.00345,0.99476/ 4146.
4303 DATA YCARB2/ 0.19636,0.34820,0.40558,0.44719,0.46860,0.48132/ 4147.
4304 DATA ZCARB2/ 0.45878,0.59691,0.65112,0.70444,0.74341,0.79820/ 4148.
4305 C 4149.
4306 DATA XWATER/ 1.10372,1.05381,1.03792,1.02265,1.01285,0.99989/ 4150.
4307 DATA YWATER/ 0.84758,1.03190,1.02896,1.02226,1.01282,0.99988/ 4151.
4308 DATA ZWATER/ 0.87621,0.84587,0.84884,0.85323,0.85888,0.86321/ 4152.
4309 C 4153.
4310 DATA XICE25/ 1.05394,1.02884,1.02030,1.01257,1.00706,0.99981/ 4154.
4311 DATA YICE25/ 0.75677,0.96035,1.00797,1.01184,1.00702,0.99981/ 4155.
4312 DATA ZICE25/ 0.92708,0.88645,0.87975,0.87906,0.87391,0.87623/ 4156.
4313 C 4157.
4314 C-----------------------------------------------------------------------4158.
4315 C THERMAL RADIATION 25 K-INTERVAL MERGED CLOUD & SURFACE ALBEDO DATA 4159.
4316 C-----------------------------------------------------------------------4160.
4317 DATA AGSIDV/ 4161.
4318 S 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4162.
4319 S 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4163.
4320 S 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4164.
4321 S 0.01757,0.02022,0.02059,0.02082, 4165.
4322 I 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4166.
4323 I 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4167.
4324 I 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4168.
4325 I 0.01757,0.02022,0.02059,0.02082, 4169.
4326 D 0.04500,0.10414,0.06739,0.08448,0.08516,0.06283,0.05230, 4170.
4327 D 0.03382,0.01901,0.01542,0.01178,0.05142,0.04835,0.05505, 4171.
4328 D 0.05600,0.05310,0.04603,0.03731,0.03472,0.03328,0.03000, 4172.
4329 D 0.16159,0.17592,0.17812,0.17927, 4173.
4330 V 25*0.0/ 4174.
4331 DATA AOCEAN/ 4175.
4332 + 0.04000,0.05965,0.06124,0.08339,0.09235,0.09510,0.09908, 4176.
4333 + 0.11117,0.12263,0.12577,0.12931,0.04700,0.06894,0.08970, 4177.
4334 + 0.09574,0.09565,0.09619,0.09672,0.09703,0.09723,0.09700, 4178.
4335 + 0.04645,0.04487,0.04482,0.04493/ 4179.
4336 C 4180.
4337 DATA CLDALB/ 4181.
4338 + 0.01332,0.08190,0.07036,0.05082,0.04486,0.04673,0.04770, 4182.
4339 + 0.05130,0.05240,0.05251,0.05259,0.01558,0.01763,0.02410, 4183.
4340 + 0.02571,0.02514,0.02448,0.02366,0.02347,0.02340,0.02294, 4184.
4341 + 0.04566,0.04499,0.04518,0.04544, 4185.
4342 + 0.01407,0.01653,0.03230,0.08764,0.10055,0.09095,0.08892, 4186.
4343 + 0.07985,0.06411,0.05926,0.05398,0.01576,0.02449,0.05091, 4187.
4344 + 0.05680,0.05325,0.04652,0.03809,0.03574,0.03451,0.03082, 4188.
4345 + 0.01757,0.02022,0.02059,0.02082/ 4189.
4346 C 4190.
4347 DATA ASNALB/0.600,0.350,13*0.0/ 4191.
4348 C&& DATA ASNALB/0.550,0.300,13*0.0/
4349 C 4192.
4350 C&& DATA AOIALB/0.550,0.300,13*0.0/ 4193.
4351 DATA AOIALB/0.600,0.350,13*0.0/
4352 C 4194.
4353 DATA ALIALB/0.600,0.350,13*0.0/ 4195.
4354 C 4196.
4355 C-----------------------------------------------------------------------4197.
4356 C TRACE GAS VERTICAL DISTRIBUTION & 1958 MEAN CONCENTRATION 4198.
4357 C-----------------------------------------------------------------------4199.
4358 C 4200.
4359 DATA CMANO2/ 4201.
4360 1 8.66E-06,5.15E-06,2.85E-06,1.50E-06,9.89E-07,6.91E-07,7.17E-07, 4202.
4361 2 8.96E-07,3.67E-06,4.85E-06,5.82E-06,6.72E-06,7.77E-06,8.63E-06, 4203.
4362 3 8.77E-06,8.14E-06,6.91E-06,5.45E-06,4.00E-06,2.67E-06,1.60E-06, 4204.
4363 4 8.36E-07,3.81E-07,1.58E-07,6.35E-08,2.57E-08,1.03E-08,4.18E-09, 4205.
4364 5 1.66E-09,6.57E-10,2.58E-10,1.02E-10,4.11E-11,1.71E-11,7.73E-12, 4206.
4365 6 9.07E-12,4.63E-12,2.66E-12,1.73E-12,1.28E-12,1.02E-12,1.00E-30/ 4207.
4366 C 4208.
4367 C 4209.
4368 C GAS NUMBER 1 2 3 4 5 6 7 8 9 4210.
4369 C H2O CO2 O3 O2 NO2 N2O CH4 CCL3F1 CCL2F2 4211.
4370 C DATA FULGAS/1.0, 1.0,1.0, 1.0,1.0, 1.0, 1.0, 1.0, 1.0/4212.
4371 c DATA PPMV58/0.0,315.0,0.0,210000.,0.0,0.295,1.400,8.00E-6,25.0E-6/4213.
4372 DATA PPMV58/0.0, 0.0,0.0,210000.,0.0,4*0.0/
4373 C$ DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0, 15.0, 10.0, 12.0, 12.0/4214.
4374 DATA Z0/ 0.0, 0.0,0.0, 0.0,0.0,915.0,910.0, 12.0, 12.0/4215.
4375 DATA ZH/ 8.0, 8.0,8.0, 8.0,8.0, 10.0, 30.0, 3.0, 3.0/4216.
4376 C 4217.
4377 C-----------------------------------------------------------------------4218.
4378 C TRACE GAS ABSORPTION COEFFICIENTS FOR F11 & F12 4219.
4379 C-----------------------------------------------------------------------4220.
4380 C 4221.
4381 DIMENSION F11PCM(25),F12PCM(25) 4222.
4382 EQUIVALENCE (TRACEG(1,1),F11PCM(1)),(TRACEG(1,2),F12PCM(1)) 4223.
4383 C 4224.
4384 C 4225.
4385 DATA F11PCM/ 4226.
4386 + 13.6000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 4227.
4387 + 0.0000, 0.0000, 0.0000, 0.0000,11.9504, 2.5138, 0.5054, 4228.
4388 + 0.1086, 0.0308, 0.0178, 0.0054, 0.0000, 0.0000, 0.0000, 4229.
4389 + 2.5220, 1.1731, 0.8627, 0.7445/ 4230.
4390 C 4231.
4391 DATA F12PCM/ 4232.
4392 + 5.4900, 1.3339, 0.7739, 0.1304, 0.0286, 0.0051, 0.0000, 4233.
4393 + 0.0000, 0.0000, 0.0000, 0.0000, 9.0745, 2.3577, 0.4135, 4234.
4394 + 0.0575, 0.0000, 0.2507, 0.6215, 0.7262, 0.7972, 0.9150, 4235.
4395 + 13.1663, 1.1564, 0.0388, 0.0082/ 4236.
4396 C 4236.11
4397 C ------------------------------------------------------------------4236.12
4398 C DECEMBER 4, 1991 UPDATE PROVIDES FOR THE FOLLOWING IMPROVEMENTS:4236.13
4399 C ------------------------------------------------------------------4236.14
4400 C IF(NEWASZ.GT.0) ALL AEROSOL SOLAR ZENITH ANGLE DEPENDENCE IMPROVED4236.15
4401 C IF(NEWAQA.GT.0) ALL AERSOL THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.16
4402 C (TRACER AEROSOLS ALREADY USE Q-ABSORPTION IN XRAD83XX) 4236.17
4403 C IF(NEWCQA.GT.0) ALL CLOUDS THERMAL CROSS-SECTIONS ARE Q-ABSORPTION4236.18
4404 C ------------------------------------------------------------------4236.21
4405 C 4236.22
4406 EQUIVALENCE (ISPARE(1),NEWASZ) 4236.23
4407 EQUIVALENCE (ISPARE(2),NEWAQA) 4236.24
4408 EQUIVALENCE (ISPARE(3),NEWCQA) 4236.25
4409 C 4236.26
4410 DATA NEWASZ/0/, NEWAQA/0/, NEWCQA/0/ 4236.27
4411 C 4236.28
4412 END 4237.
4413 SUBROUTINE PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 4238.
4414 C 4239.
4415 C ------------------------------------------------------------------4240.
4416 C ------------- MCCLATCHY (1972) ATMOSPHERE DATA -----------4241.
4417 C ------------------------------------------------------------------4242.
4418 C 4243.
4419 C INPUT DATA 4244.
4420 C------------------ 4245.
4421 C NATM=0 GIVES ABREVIATED DATA FOR STANDARD ATMOSPHER4246.
4422 C (INPUT: P OR H) (RETURNS: H OR P & D,T)4247.
4423 C 4248.
4424 C NATM=1 GIVES ATMOSPHERE DATA FOR TROPICAL LATITUDES4249.
4425 C NATM=2 GIVES ATMOSPHERE DATA FOR MIDLATITUDE SUMMER4250.
4426 C NATM=3 GIVES ATMOSPHERE DATA FOR MIDLATITUDE WINTER4251.
4427 C NATM=4 GIVES ATMOSPHERE DATA FOR SUBARCTIC SUMMER 4252.
4428 C NATM=5 GIVES ATMOSPHERE DATA FOR SUBARCTIC WINTER 4253.
4429 C NATM=6 GIVES ATMOSPHERE DATA FOR STANDARD ATMOSPHER4254.
4430 C 4255.
4431 C NPHD=1 RETURNS H,D,T,O,Q,S DATA FOR GIVEN PRESSURE P4256.
4432 C NPHD=2 RETURNS P,D,T,O,Q,S DATA FOR GIVEN HEIGHT H4257.
4433 C NPHD=3 RETURNS P,H,T,O,Q,S DATA FOR GIVEN DENSITY D4258.
4434 C 4259.
4435 C OUTPUT DATA 4260.
4436 C------------------ 4261.
4437 C P = PRESSURE IN MILLIBARS 4262.
4438 C H = HEIGHT IN KILOMETERS 4263.
4439 C D = DENSITY IN GRAMS/METER**3 4264.
4440 C T = TEMPERATURE (ABSOLUTE) 4265.
4441 C O = OZONE MIXING RATIO (GRAMS OZONE)/(GRAMS AIR) 4266.
4442 C Q = SPECIFIC HUMIDITY (GRAMS WATER VAPOR)/(GRAMS AIR)4267.
4443 C S = SATURATION RATIO (GRAMS WATER VAPOR)/(GRAMS AIR) 4268.
4444 C OCM = OZONE (CM-STP) ABOVE GIVEN HEIGHT 4269.
4445 C WCM = WATER VAPOR (CM-STP) ABOVE GIVEN HEIGHT 4270.
4446 C 4271.
4447 C REMARKS 4272.
4448 C------------------ 4273.
4449 C INPUT P,H,D PARAMETERS ARE NOT ALTERED 4274.
4450 C P,D INTERPOLATION IS EXPONENTIAL WITH HEIGHT 4275.
4451 C NO EXTRAPOLATION IS MADE OUTSIDE 0-100 KM INTERVAL 4276.
4452 C S IS NOT COMPUTED ABOVE 40 KM (FORMULA NOT ACCURATE)4277.
4453 C 4278.
4454 C R = Q/S GIVES RELATIVE HUMIDITY 4279.
4455 C W = Q/(1-Q) GIVES WATER VAPOR MIXING RATIO 4280.
4456 C N = D*2.079E 16 GIVES NUMBER DENSITY PER CM**3 4281.
4457 C 4282.
4458 C 4283.
4459 C 4284.
4460 C 4285.
4461 C 4286.
4462 DIMENSION PRS1(33),PRS2(33),PRS3(33),PRS4(33),PRS5(33),PRS6(33)4287.
4463 1 ,DNS1(33),DNS2(33),DNS3(33),DNS4(33),DNS5(33),DNS6(33)4288.
4464 2 ,TMP1(33),TMP2(33),TMP3(33),TMP4(33),TMP5(33),TMP6(33)4289.
4465 3 ,WVP1(33),WVP2(33),WVP3(33),WVP4(33),WVP5(33),WVP6(33)4290.
4466 4 ,OZO1(33),OZO2(33),OZO3(33),OZO4(33),OZO5(33),OZO6(33)4291.
4467 DIMENSION PRES(33,6),DENS(33,6),TEMP(33,6),WVAP(33,6),OZON(33,6)4292.
4468 C 4293.
4469 EQUIVALENCE 4294.
4470 + (PRES(1,1),PRS1(1)),(DENS(1,1),DNS1(1)),(TEMP(1,1),TMP1(1)) 4295.
4471 + ,(PRES(1,2),PRS2(1)),(DENS(1,2),DNS2(1)),(TEMP(1,2),TMP2(1)) 4296.
4472 + ,(PRES(1,3),PRS3(1)),(DENS(1,3),DNS3(1)),(TEMP(1,3),TMP3(1)) 4297.
4473 + ,(PRES(1,4),PRS4(1)),(DENS(1,4),DNS4(1)),(TEMP(1,4),TMP4(1)) 4298.
4474 + ,(PRES(1,5),PRS5(1)),(DENS(1,5),DNS5(1)),(TEMP(1,5),TMP5(1)) 4299.
4475 + ,(PRES(1,6),PRS6(1)),(DENS(1,6),DNS6(1)),(TEMP(1,6),TMP6(1)) 4300.
4476 EQUIVALENCE (WVAP(1,1),WVP1(1)),(OZON(1,1),OZO1(1)) 4301.
4477 EQUIVALENCE (WVAP(1,2),WVP2(1)),(OZON(1,2),OZO2(1)) 4302.
4478 EQUIVALENCE (WVAP(1,3),WVP3(1)),(OZON(1,3),OZO3(1)) 4303.
4479 EQUIVALENCE (WVAP(1,4),WVP4(1)),(OZON(1,4),OZO4(1)) 4304.
4480 EQUIVALENCE (WVAP(1,5),WVP5(1)),(OZON(1,5),OZO5(1)) 4305.
4481 EQUIVALENCE (WVAP(1,6),WVP6(1)),(OZON(1,6),OZO6(1)) 4306.
4482 C 4307.
4483 C 4308.
4484 DIMENSION HTKM(33) 4309.
4485 DATA HTKM/1.0E-09, 1., 2., 3., 4., 5., 6., 7., 8., 9.,10.,11. 4310.
4486 1 ,12.,13.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24. 4311.
4487 2 ,25.,30.,35.,40.,45.,50.,70.,99.9/ 4312.
4488 C 4313.
4489 C 4314.
4490 C---------------------------------------------------------------------- 4315.
4491 C0000 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4316.
4492 C---------------------------------------------------------------------- 4317.
4493 C 4318.
4494 DIMENSION SPLB(8),STLB(8),SHLB(8),SDLB(8) 4319.
4495 DATA SPLB/1013.25,226.32,54.748,8.6801,1.109,.66938,.039564 4320.
4496 + ,3.7338E-03/ 4321.
4497 DATA STLB/288.15,216.65,216.65,228.65,270.65,270.65,214.65,186.87/4322.
4498 DATA SHLB/0.0,11.0,20.0,32.0,47.0,51.0,71.0,84.852/ 4323.
4499 DATA SDLB/-6.5,0.0,1.0,2.8,0.0,-2.8,-2.0,0.0/ 4324.
4500 DATA HPCON/34.16319/ 4325.
4501 C 4326.
4502 C 4327.
4503 C-----------------------------------------------------------------------4328.
4504 C1111 TROPICAL LATITUDES MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4329.
4505 C-----------------------------------------------------------------------4330.
4506 C 4331.
4507 DATA PRS1/ 1.013E 03,9.040E 02,8.050E 02,7.150E 02,6.330E 02,4332.
4508 1 5.590E 02,4.920E 02,4.320E 02,3.780E 02,3.290E 02,2.860E 02,4333.
4509 2 2.470E 02,2.130E 02,1.820E 02,1.560E 02,1.320E 02,1.110E 02,4334.
4510 3 9.370E 01,7.890E 01,6.660E 01,5.650E 01,4.800E 01,4.090E 01,4335.
4511 4 3.500E 01,3.000E 01,2.570E 01,1.220E 01,6.000E 00,3.050E 00,4336.
4512 5 1.590E 00,8.540E-01,5.790E-02,3.000E-04/ 4337.
4513 DATA DNS1/ 1.167E 03,1.064E 03,9.689E 02,8.756E 02,7.951E 02,4338.
4514 1 7.199E 02,6.501E 02,5.855E 02,5.258E 02,4.708E 02,4.202E 02,4339.
4515 2 3.740E 02,3.316E 02,2.929E 02,2.578E 02,2.260E 02,1.972E 02,4340.
4516 3 1.676E 02,1.382E 02,1.145E 02,9.515E 01,7.938E 01,6.645E 01,4341.
4517 4 5.618E 01,4.763E 01,4.045E 01,1.831E 01,8.600E 00,4.181E 00,4342.
4518 5 2.097E 00,1.101E 00,9.210E-02,5.000E-04/ 4343.
4519 DATA TMP1/ 300.0,294.0,288.0,284.0,277.0,270.0,264.0,257.0,250.0,4344.
4520 1244.0,237.0,230.0,224.0,217.0,210.0,204.0,197.0,195.0,199.0,203.0,4345.
4521 2207.0,211.0,215.0,217.0,219.0,221.0,232.0,243.0,254.0,265.0,270.0,4346.
4522 3 219.0,210.0/ 4347.
4523 DATA WVP1/1.9E 01,1.3E 01,9.3E 00,4.7E 00,2.2E 00,1.5E 00,8.5E-01,4348.
4524 1 4.7E-01,2.5E-01,1.2E-01,5.0E-02,1.7E-02,6.0E-03,1.8E-03,1.0E-03,4349.
4525 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4350.
4526 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4351.
4527 4 1.4E-07,1.0E-09/ 4352.
4528 DATA OZO1/5.6E-05,5.6E-05,5.4E-05,5.1E-05,4.7E-05,4.5E-05,4.3E-05,4353.
4529 1 4.1E-05,3.9E-05,3.9E-05,3.9E-05,4.1E-05,4.3E-05,4.5E-05,4.5E-05,4354.
4530 2 4.7E-05,4.7E-05,6.9E-05,9.0E-05,1.4E-04,1.9E-04,2.4E-04,2.8E-04,4355.
4531 3 3.2E-04,3.4E-04,3.4E-04,2.4E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4356.
4532 4 8.6E-08,4.3E-11/ 4357.
4533 C 4358.
4534 C-----------------------------------------------------------------------4359.
4535 C2222 MIDLATITUDE SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4360.
4536 C-----------------------------------------------------------------------4361.
4537 C 4362.
4538 DATA PRS2/ 1.013E 03,9.020E 02,8.020E 02,7.100E 02,6.280E 02,4363.
4539 1 5.540E 02,4.870E 02,4.260E 02,3.720E 02,3.240E 02,2.810E 02,4364.
4540 2 2.430E 02,2.090E 02,1.790E 02,1.530E 02,1.300E 02,1.110E 02,4365.
4541 3 9.500E 01,8.120E 01,6.950E 01,5.950E 01,5.100E 01,4.370E 01,4366.
4542 4 3.760E 01,3.220E 01,2.770E 01,1.320E 01,6.520E 00,3.330E 00,4367.
4543 5 1.760E 00,9.510E-01,6.710E-02,3.000E-04/ 4368.
4544 DATA DNS2/ 1.191E 03,1.080E 03,9.757E 02,8.846E 02,7.998E 02,4369.
4545 1 7.211E 02,6.487E 02,5.830E 02,5.225E 02,4.669E 02,4.159E 02,4370.
4546 2 3.693E 02,3.269E 02,2.882E 02,2.464E 02,2.104E 02,1.797E 02,4371.
4547 3 1.535E 02,1.305E 02,1.110E 02,9.453E 01,8.056E 01,6.872E 01,4372.
4548 4 5.867E 01,5.014E 01,4.288E 01,1.322E 01,6.519E 00,3.330E 00,4373.
4549 5 1.757E 00,9.512E-01,6.706E-02,5.000E-04/ 4374.
4550 DATA TMP2/ 294.0,290.0,285.0,279.0,273.0,267.0,261.0,255.0,248.0,4375.
4551 1242.0,235.0,229.0,222.0,216.0,216.0,216.0,216.0,216.0,216.0,217.0,4376.
4552 2218.0,219.0,220.0,222.0,223.0,224.0,234.0,245.0,258.0,270.0,276.0,4377.
4553 3 218.0,210.0/ 4378.
4554 DATA WVP2/1.4E 01,9.3E 00,5.9E 00,3.3E 00,1.9E 00,1.0E 00,6.1E-01,4379.
4555 1 3.7E-01,2.1E-01,1.2E-01,6.4E-02,2.2E-02,6.0E-03,1.8E-03,1.0E-03,4380.
4556 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4381.
4557 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4382.
4558 4 1.4E-07,1.0E-09/ 4383.
4559 DATA OZO2/6.0E-05,6.0E-05,6.0E-05,6.2E-05,6.4E-05,6.6E-05,6.9E-05,4384.
4560 1 7.5E-05,7.9E-05,8.6E-05,9.0E-05,1.1E-04,1.2E-04,1.5E-04,1.8E-04,4385.
4561 2 1.9E-04,2.1E-04,2.4E-04,2.8E-04,3.2E-04,3.4E-04,3.6E-04,3.6E-04,4386.
4562 3 3.4E-04,3.2E-04,3.0E-04,2.0E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4387.
4563 4 8.6E-08,4.3E-11/ 4388.
4564 C 4389.
4565 C-----------------------------------------------------------------------4390.
4566 C3333 MIDLATITUDE WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4391.
4567 C-----------------------------------------------------------------------4392.
4568 C 4393.
4569 DATA PRS3/ 1.018E 03,8.973E 02,7.897E 02,6.938E 02,6.081E 02,4394.
4570 1 5.313E 02,4.627E 02,4.016E 02,3.473E 02,2.992E 02,2.568E 02,4395.
4571 2 2.199E 02,1.882E 02,1.610E 02,1.378E 02,1.178E 02,1.007E 02,4396.
4572 3 8.610E 01,7.350E 01,6.280E 01,5.370E 01,4.580E 01,3.910E 01,4397.
4573 4 3.340E 01,2.860E 01,2.430E 01,1.110E 01,5.180E 00,2.530E 00,4398.
4574 5 1.290E 00,6.820E-01,4.670E-02,3.000E-04/ 4399.
4575 DATA DNS3/ 1.301E 03,1.162E 03,1.037E 03,9.230E 02,8.282E 02,4400.
4576 1 7.411E 02,6.614E 02,5.886E 02,5.222E 02,4.619E 02,4.072E 02,4401.
4577 2 3.496E 02,2.999E 02,2.572E 02,2.206E 02,1.890E 02,1.620E 02,4402.
4578 3 1.388E 02,1.188E 02,1.017E 02,8.690E 01,7.421E 01,6.338E 01,4403.
4579 4 5.415E 01,4.624E 01,3.950E 01,1.783E 01,7.924E 00,3.625E 00,4404.
4580 5 1.741E 00,8.954E-01,7.051E-02,5.000E-04/ 4405.
4581 DATA TMP3/ 272.2,268.7,265.2,261.7,255.7,249.7,243.7,237.7,231.7,4406.
4582 1225.7,219.7,219.2,218.7,218.2,217.7,217.2,216.7,216.2,215.7,215.2,4407.
4583 2215.2,215.2,215.2,215.2,215.2,215.2,217.4,227.8,243.2,258.5,265.7,4408.
4584 3 230.7,210.2/ 4409.
4585 DATA WVP3/3.5E 00,2.5E 00,1.8E 00,1.2E 00,6.6E-01,3.8E-01,2.1E-01,4410.
4586 1 8.5E-02,3.5E-02,1.6E-02,7.5E-03,6.9E-03,6.0E-03,1.8E-03,1.0E-03,4411.
4587 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4412.
4588 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4413.
4589 4 1.4E-07,1.0E-09/ 4414.
4590 DATA OZO3/6.0E-05,5.4E-05,4.9E-05,4.9E-05,4.9E-05,5.8E-05,6.4E-05,4415.
4591 1 7.7E-05,9.0E-05,1.2E-04,1.6E-04,2.1E-04,2.6E-04,3.0E-04,3.2E-04,4416.
4592 2 3.4E-04,3.6E-04,3.9E-04,4.1E-04,4.3E-04,4.5E-04,4.3E-04,4.3E-04,4417.
4593 3 3.9E-04,3.6E-04,3.4E-04,1.9E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4418.
4594 4 8.6E-08,4.3E-11/ 4419.
4595 C 4420.
4596 C-----------------------------------------------------------------------4421.
4597 C4444 SUBARCTIC SUMMER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4422.
4598 C-----------------------------------------------------------------------4423.
4599 C 4424.
4600 DATA PRS4/ 1.010E 03,8.960E 02,7.929E 02,7.000E 02,6.160E 02,4425.
4601 1 5.410E 02,4.730E 02,4.130E 02,3.590E 02,3.107E 02,2.677E 02,4426.
4602 2 2.300E 02,1.977E 02,1.700E 02,1.460E 02,1.250E 02,1.080E 02,4427.
4603 3 9.280E 01,7.980E 01,6.860E 01,5.890E 01,5.070E 01,4.360E 01,4428.
4604 4 3.750E 01,3.227E 01,2.780E 01,1.340E 01,6.610E 00,3.400E 00,4429.
4605 5 1.810E 00,9.870E-01,7.070E-02,3.000E-04/ 4430.
4606 DATA DNS4/ 1.220E 03,1.110E 03,9.971E 02,8.985E 02,8.077E 02,4431.
4607 1 7.244E 02,6.519E 02,5.849E 02,5.231E 02,4.663E 02,4.142E 02,4432.
4608 2 3.559E 02,3.059E 02,2.630E 02,2.260E 02,1.943E 02,1.671E 02,4433.
4609 3 1.436E 02,1.235E 02,1.062E 02,9.128E 01,7.849E 01,6.750E 01,4434.
4610 4 5.805E 01,4.963E 01,4.247E 01,1.338E 01,6.614E 00,3.404E 00,4435.
4611 5 1.817E 00,9.868E-01,7.071E-02,5.000E-04/ 4436.
4612 DATA TMP4/ 287.0,282.0,276.0,271.0,266.0,260.0,253.0,246.0,239.0,4437.
4613 1232.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,225.0,4438.
4614 2225.0,225.0,225.0,225.0,226.0,228.0,235.0,247.0,262.0,274.0,277.0,4439.
4615 3 216.0,210.0/ 4440.
4616 DATA WVP4/9.1E 00,6.0E 00,4.2E 00,2.7E 00,1.7E 00,1.0E 00,5.4E-01,4441.
4617 1 2.9E-01,1.3E-02,4.2E-02,1.5E-02,9.4E-03,6.0E-03,1.8E-03,1.0E-03,4442.
4618 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4443.
4619 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4444.
4620 4 1.4E-07,1.0E-09/ 4445.
4621 DATA OZO4/4.9E-05,5.4E-05,5.6E-05,5.8E-05,6.0E-05,6.4E-05,7.1E-05,4446.
4622 1 7.5E-05,7.9E-05,1.1E-04,1.3E-04,1.8E-04,2.1E-04,2.6E-04,2.8E-04,4447.
4623 2 3.2E-04,3.4E-04,3.9E-04,4.1E-04,4.1E-04,3.9E-04,3.6E-04,3.2E-04,4448.
4624 3 3.0E-04,2.8E-04,2.6E-04,1.4E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4449.
4625 4 8.6E-08,4.3E-11/ 4450.
4626 C 4451.
4627 C-----------------------------------------------------------------------4452.
4628 C5555 SUBARCTIC WINTER MCCLATCHY (1972) ATMOSPHERE DATA VS HEIGHT4453.
4629 C-----------------------------------------------------------------------4454.
4630 C 4455.
4631 DATA PRS5/ 1.013E 03,8.878E 02,7.775E 02,6.798E 02,5.932E 02,4456.
4632 1 5.158E 02,4.467E 02,3.853E 02,3.308E 02,2.829E 02,2.418E 02,4457.
4633 2 2.067E 02,1.766E 02,1.510E 02,1.291E 02,1.103E 02,9.431E 01,4458.
4634 3 8.058E 01,6.882E 01,5.875E 01,5.014E 01,4.277E 01,3.647E 01,4459.
4635 4 3.109E 01,2.649E 01,2.256E 01,1.020E 01,4.701E 00,2.243E 00,4460.
4636 5 1.113E 00,5.719E-01,4.016E-02,3.000E-04/ 4461.
4637 DATA DNS5/ 1.372E 03,1.193E 03,1.058E 03,9.366E 02,8.339E 02,4462.
4638 1 7.457E 02,6.646E 02,5.904E 02,5.226E 02,4.538E 02,3.879E 02,4463.
4639 2 3.315E 02,2.834E 02,2.422E 02,2.071E 02,1.770E 02,1.517E 02,4464.
4640 3 1.300E 02,1.113E 02,9.529E 01,8.155E 01,6.976E 01,5.966E 01,4465.
4641 4 5.100E 01,4.358E 01,3.722E 01,1.645E 01,7.368E 00,3.330E 00,4466.
4642 5 1.569E 00,7.682E-01,5.695E-02,5.000E-04/ 4467.
4643 DATA TMP5/ 257.1,259.1,255.9,252.7,247.7,240.9,234.1,227.3,220.6,4468.
4644 1217.2,217.2,217.2,217.2,217.2,217.2,217.2,216.6,216.0,215.4,214.8,4469.
4645 2214.1,213.6,213.0,212.4,211.8,211.2,216.0,222.2,234.7,247.0,259.3,4470.
4646 3 245.7,210.0/ 4471.
4647 DATA WVP5/1.2E 00,1.2E 00,9.4E-01,6.8E-01,4.1E-01,2.0E-01,9.8E-02,4472.
4648 1 5.4E-02,1.1E-02,8.4E-03,5.5E-03,3.8E-03,2.6E-03,1.8E-03,1.0E-03,4473.
4649 2 7.6E-04,6.4E-04,5.6E-04,5.0E-04,4.9E-04,4.5E-04,5.1E-04,5.1E-04,4474.
4650 3 5.4E-04,6.0E-04,6.7E-04,3.6E-04,1.1E-04,4.3E-05,1.9E-05,6.3E-06,4475.
4651 4 1.4E-07,1.0E-09/ 4476.
4652 DATA OZO5/4.1E-05,4.1E-05,4.1E-05,4.3E-05,4.5E-05,4.7E-05,4.9E-05,4477.
4653 1 7.1E-05,9.0E-05,1.6E-04,2.4E-04,3.2E-04,4.3E-04,4.7E-04,4.9E-04,4478.
4654 2 5.6E-04,6.2E-04,6.2E-04,6.2E-04,6.0E-04,5.6E-04,5.1E-04,4.7E-04,4479.
4655 3 4.3E-04,3.6E-04,3.2E-04,1.5E-04,9.2E-05,4.1E-05,1.3E-05,4.3E-06,4480.
4656 4 8.6E-08,4.3E-11/ 4481.
4657 C 4482.
4658 C---------------------------------------------------------------------- 4483.
4659 C6666 GLOBAL U.S. (1976) STANDARD ATMOSPHERE P, T, GEO H PARAMETERS4484.
4660 C---------------------------------------------------------------------- 4485.
4661 C 4486.
4662 DATA PRS6/ 1.01325E+03,8.987E+02,7.950E+02,7.011E+02,6.164E+02,4487.
4663 1 5.402E+02,4.718E+02,4.106E+02,3.560E+02,3.074E+02,2.644E+02,4488.
4664 2 2.263E+02,1.933E+02,1.651E+02,1.410E+02,1.204E+02,1.029E+02,4489.
4665 3 8.787E+01,7.505E+01,6.410E+01,5.475E+01,4.678E+01,4.000E+01,4490.
4666 4 3.422E+01,2.931E+01,2.511E+01,1.172E+01,5.589E+00,2.775E+00,4491.
4667 5 1.431E+00,7.594E-01,4.634E-02,2.384E-04/ 4492.
4668 DATA DNS6/ 1.225E+03,1.112E+03,1.006E+03,9.091E+02,8.191E+02,4493.
4669 1 7.361E+02,6.597E+02,5.895E+02,5.252E+02,4.663E+02,4.127E+02,4494.
4670 2 3.639E+02,3.108E+02,2.655E+02,2.268E+02,1.937E+02,1.654E+02,4495.
4671 3 1.413E+02,1.207E+02,1.031E+02,8.803E+01,7.487E+01,6.373E+01,4496.
4672 4 5.428E+01,4.627E+01,3.947E+01,1.801E+01,8.214E+00,3.851E+00,4497.
4673 5 1.881E+00,9.775E-01,7.424E-02,4.445E-04/ 4498.
4674 DATA TMP6/ 4499.
4675 1 288.150,281.650,275.150,268.650,262.150,255.650,249.150, 4500.
4676 2 242.650,236.150,229.650,223.150,216.650,216.650,216.650, 4501.
4677 3 216.650,216.650,216.650,216.650,216.650,216.650,216.650, 4502.
4678 4 217.650,218.650,219.650,220.650,221.650,226.650,237.050, 4503.
4679 5 251.050,265.050,270.650,217.450,186.870/ 4504.
4680 DATA WVP6/ 1.083E+01,6.323E+00,3.612E+00,2.015E+00,1.095E+00,4505.
4681 1 5.786E-01,2.965E-01,1.469E-01,7.021E-02,3.226E-02,1.419E-02,4506.
4682 2 5.956E-03,5.002E-03,4.186E-03,3.490E-03,2.896E-03,2.388E-03,4507.
4683 3 1.954E-03,1.583E-03,1.267E-03,9.967E-04,8.557E-04,7.104E-04,4508.
4684 4 5.600E-04,4.037E-04,2.406E-04,5.404E-05,2.464E-05,1.155E-05,4509.
4685 5 5.644E-06,2.932E-06,2.227E-07,1.334E-09/ 4510.
4686 DATA OZO6/ 7.526E-05,3.781E-05,6.203E-05,3.417E-05,5.694E-05,4511.
4687 1 3.759E-05,5.970E-05,4.841E-05,7.102E-05,6.784E-05,9.237E-05,4512.
4688 2 9.768E-05,1.251E-04,1.399E-04,1.715E-04,1.946E-04,2.300E-04,4513.
4689 3 2.585E-04,2.943E-04,3.224E-04,3.519E-04,3.714E-04,3.868E-04,4514.
4690 4 3.904E-04,3.872E-04,3.728E-04,2.344E-04,9.932E-05,3.677E-05,4515.
4691 5 1.227E-05,4.324E-06,5.294E-08,1.262E-10/ 4516.
4692 C 4517.
4693 C 4518.
4694 IF(NATM.GT.0) GO TO 200 4519.
4695 O=1.E-10 4520.
4696 Q=1.E-10 4521.
4697 S=1.E-10 4522.
4698 OCM=1.E-10 4523.
4699 WCM=1.E-10 4524.
4700 IF(NPHD.LT.2) GO TO 150 4525.
4701 DO 110 N=2,8 4526.
4702 IF(H.LT.SHLB(N)) GO TO 120 4527.
4703 110 CONTINUE 4528.
4704 N=9 4529.
4705 120 N=N-1 4530.
4706 IF(ABS(SDLB(N)).LT.1.E-04) GO TO 130 4531.
4707 P=SPLB(N)*(1.+SDLB(N)/STLB(N)*(H-SHLB(N)))**(-HPCON/SDLB(N)) 4532.
4708 GO TO 140 4533.
4709 130 P=SPLB(N)*EXP(-HPCON/STLB(N)*(H-SHLB(N))) 4534.
4710 140 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4535.
4711 D=P/T*28.9644E 05/8.31432E 03 4536.
4712 RETURN 4537.
4713 C 4538.
4714 150 CONTINUE 4539.
4715 DO 160 N=2,8 4540.
4716 160 IF(P.GT.SPLB(N)) GO TO 170 4541.
4717 N=9 4542.
4718 170 N=N-1 4543.
4719 IF(ABS(SDLB(N)).LT.1.E-04) GO TO 180 4544.
4720 H=SHLB(N)+STLB(N)/SDLB(N)*((SPLB(N)/P)**(SDLB(N)/HPCON)-1.) 4545.
4721 GO TO 190 4546.
4722 C ALOG
4723 180 H=SHLB(N)+STLB(N)/HPCON*LOG(SPLB(N)/P) 4547.
4724 C ALOG
4725 190 T=STLB(N)+SDLB(N)*(H-SHLB(N)) 4548.
4726 D=P/T*28.9644E 05/8.31432E 03 4549.
4727 RETURN 4550.
4728 C 4551.
4729 200 CONTINUE 4552.
4730 IF(NPHD.EQ.1) GO TO 240 4553.
4731 IF(NPHD.EQ.2) GO TO 220 4554.
4732 XX=D 4555.
4733 XI=DENS(1,NATM) 4556.
4734 IF(D.GT.XI) XX=XI 4557.
4735 IF(D.LT.5.0E-04) GO TO 280 4558.
4736 DO 210 J=2,33 4559.
4737 XJ=DENS(J,NATM) 4560.
4738 IF(XX.GT.XJ) GO TO 260 4561.
4739 210 XI=XJ 4562.
4740 220 XX=H 4563.
4741 XI=HTKM(1) 4564.
4742 IF(H.LT.XI) XX=XI 4565.
4743 IF(H.GT.99.9) GO TO 280 4566.
4744 DO 230 J=2,33 4567.
4745 XJ=HTKM(J) 4568.
4746 IF(XX.LT.XJ) GO TO 260 4569.
4747 230 XI=XJ 4570.
4748 240 XX=P 4571.
4749 XI=PRES(1,NATM) 4572.
4750 IF(P.GT.XI) XX=XI 4573.
4751 IF(P.LT.3.0E-04) GO TO 280 4574.
4752 DO 250 J=2,33 4575.
4753 XJ=PRES(J,NATM) 4576.
4754 IF(XX.GT.XJ) GO TO 260 4577.
4755 250 XI=XJ 4578.
4756 260 DELTA=(XX-XI)/(XJ-XI) 4579.
4757 I=J-1 4580.
4758 C ALOG
4759 IF(NPHD.NE.2) H=HTKM(I)+(HTKM(J)-HTKM(I))*LOG(XX/XI)/LOG(XJ/XI) 4581.
4760 C ALOG
4761 PI=PRES(I,NATM) 4582.
4762 PJ=PRES(J,NATM) 4583.
4763 DI=DENS(I,NATM) 4584.
4764 DJ=DENS(J,NATM) 4585.
4765 IF(NPHD.NE.1) P=PI+DELTA*(PJ-PI) 4586.
4766 IF(NPHD.NE.3) D=DI+DELTA*(DJ-DI) 4587.
4767 T=TEMP(I,NATM)+DELTA*(TEMP(J,NATM)-TEMP(I,NATM)) 4588.
4768 O=OZON(I,NATM)/DI+DELTA*(OZON(J,NATM)/DJ-OZON(I,NATM)/DI) 4589.
4769 Q=WVAP(I,NATM)/DI+DELTA*(WVAP(J,NATM)/DJ-WVAP(I,NATM)/DI) 4590.
4770 ES=10.**(9.4051-2353./T) 4591.
4771 IF(P.LT.PI) PI=P 4592.
4772 S=1.E+06 4593.
4773 RS=(PI-ES+0.622*ES)/(0.622*ES) 4594.
4774 IF(RS.GT.1.E-06) S=1./RS 4595.
4775 OI=O 4596.
4776 QI=Q 4597.
4777 OCM=0. 4598.
4778 WCM=0. 4599.
4779 DO 270 K=J,33 4600.
4780 PJ=PRES(K,NATM) 4601.
4781 DJ=DENS(K,NATM) 4602.
4782 OJ=OZON(K,NATM)/DJ 4603.
4783 QJ=WVAP(K,NATM)/DJ 4604.
4784 DP=PI-PJ 4605.
4785 OCM=OCM+0.5*(OI+OJ)*DP 4606.
4786 WCM=WCM+0.5*(QI+QJ)*DP 4607.
4787 OI=OJ 4608.
4788 QI=QJ 4609.
4789 270 PI=PJ 4610.
4790 WCM=WCM/0.980*22420.7/18.0 4611.
4791 OCM=OCM/0.980*22420.7/48.0 4612.
4792 RETURN 4613.
4793 280 T=210.0 4614.
4794 IF(NATM.EQ.6) T=186.87 4615.
4795 O=1.E-10 4616.
4796 Q=1.E-10 4617.
4797 S=1.E-10 4618.
4798 OCM=1.E-10 4619.
4799 WCM=1.E-10 4620.
4800 IF(NPHD.NE.1) P=1.E-05 4621.
4801 IF(NPHD.NE.2) H=99.99 4622.
4802 IF(NPHD.NE.3) D=2.E-05 4623.
4803 RETURN 4624.
4804 END 4625.
4805 FUNCTION PFOFTK(WAVNA,WAVNB,TK) 4626.
4806 C ------------------------------------------------------------------4627.
4807 C 4628.
4808 C INPUT DATA 4629.
4809 C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4630.
4810 C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4631.
4811 C 4632.
4812 C TK ABSOLUTE TEMPERATURE IN DEGREES KELVIN 4633.
4813 C 4634.
4814 C OUTPUT DATA 4635.
4815 C PFOFTK PLANCK FLUX (W/M**2) 4636.
4816 C 4637.
4817 C 4638.
4818 C REMARKS 4639.
4819 C PLANCK INTENSITY (W/M**2/STER) IS GIVEN BY PFOFTK/PI4640.
4820 C 4641.
4821 C ------------------------------------------------------------------4642.
4822 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4643.
4823 DIMENSION BN(21),BD(21) 4644.
4824 DATA BN/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,5.D0,-691.D0,7.D0 4645.
4825 1,-3617.D0,43867.D0,-174611.D0,854513.D0,-236364091.D0 4646.
4826 2,8553103.D0,-23749461029.D0,8615841276005.D0,-7709321041217.D0 4647.
4827 3,2577687858367.D0,-2631527155305348D 04,2929993913841559D0/ 4648.
4828 DATA BD/1.D0,2.D0,6.D0,30.D0,42.D0,30.D0,66.D0,2730.D0,6.D0 4649.
4829 1,510.D0,798.D0,330.D0,138.D0,2730.D0,6.D0,870.D0,14322.D0 4650.
4830 2,510.D0,6.D0,1919190.D0,6.D0/ 4651.
4831 DATA PI4/97.40909103400244D0/ 4652.
4832 C DATA PI/3.141592653589793D0/ 4653.
4833 DATA HCK/1.43879D0/ 4654.
4834 DATA DGXLIM/1.D-06/ 4655.
4835 PFOFTK=0.D0 4656.
4836 IF(TK.LT.1.D-06) RETURN 4657.
4837 DO 160 II=1,2 4658.
4838 IF(II.EQ.1) X=HCK*WAVNA/TK 4659.
4839 IF(II.EQ.2) X=HCK*WAVNB/TK 4660.
4840 IF(X.GT.2.3D0) GO TO 120 4661.
4841 XX=X*X 4662.
4842 GSUM=1.D0/3.D0-X/8.D0+XX/60.D0 4663.
4843 NB=3 4664.
4844 XNF=XX/2.D0 4665.
4845 DO 100 N=4,38,2 4666.
4846 NB=NB+1 4667.
4847 NNB=NB 4668.
4848 B=BN(NB)/BD(NB) 4669.
4849 XN3=N+3 4670.
4850 XNM=N*(N-1) 4671.
4851 XNF=XNF*(XX/XNM) 4672.
4852 DG=B/XN3*XNF 4673.
4853 GSUM=GSUM+DG 4674.
4854 DGB=DG 4675.
4855 IF(DABS(DG).LT.DGXLIM) GO TO 110 4676.
4856 100 CONTINUE 4677.
4857 110 GX=GSUM*XX*X 4678.
4858 GO TO 150 4679.
4859 120 GSUM=PI4/15.D0 4680.
4860 DO 130 N=1,20 4681.
4861 NNB=N 4682.
4862 XN=N 4683.
4863 XNN=XN*XN 4684.
4864 XNX=XN*X 4685.
4865 IF(XNX.GT.100.D0) GO TO 140 4686.
4866 GTERM=(X*X*(3.D0+XNX)+6.D0*(1.D0+XNX)/XNN)/XNN 4687.
4867 DG=GTERM*DEXP(-XNX) 4688.
4868 GSUM=GSUM-DG 4689.
4869 DGB=DG 4690.
4870 IF(DG.LT.DGXLIM) GO TO 140 4691.
4871 130 CONTINUE 4692.
4872 140 GX=GSUM 4693.
4873 150 CONTINUE 4694.
4874 IF(II.EQ.1) GXA=GX 4695.
4875 IF(II.EQ.2) GXB=GX 4696.
4876 160 CONTINUE 4697.
4877 PNORM=15.D0/PI4 4698.
4878 PFOFTK=DABS(GXB-GXA)*PNORM 4699.
4879 PFOFTK=PFOFTK*5.6692D-08*TK**4 4700.
4880 RETURN 4701.
4881 END 4702.
4882 FUNCTION TKOFPF(WAVNA,WAVNB,FLUXAB) 4703.
4883 C ------------------------------------------------------------------4704.
4884 C 4705.
4885 C INPUT DATA 4706.
4886 C------------------ 4707.
4887 C WAVNA,WAVNB SPECLTRAL INTERVAL IN WAVENUMBERS 4708.
4888 C (ORDER OF WAVNA,WAVNB NOT IMPORTANT) 4709.
4889 C FLUXAB PLANCK FLUX (W/M**2) IN INTERVAL 4710.
4890 C (WAVNA,WAVNB) 4711.
4891 C 4712.
4892 C OUTPUT DATA 4713.
4893 C------------------ 4714.
4894 C TK BRIGHTNESS TEMPERATURE IN DEGREES KELVIN4715.
4895 C 4716.
4896 C 4717.
4897 C REMARKS 4718.
4898 C------------------ 4719.
4899 C TKOFPF IS INVERSE FUNCTION OF PFOFTK(WAVNA,WAVNB,TK)4720.
4900 C THE OUTPUT OF TKOFPF SATISFIES THE IDENTITY 4721.
4901 C FLUXAB=PFOFTK(WAVNA,WAVNB,TK) 4722.
4902 C (UNITS FOR FLUXAB AND PFOFTK MUST BE IDENTICAL) 4723.
4903 C 4724.
4904 C ------------------------------------------------------------------4725.
4905 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 4726.
4906 LOGICAL LOGFIT 4727.
4907 DATA DELFIT/1.D-06/ 4728.
4908 DATA NMAX/20/ 4729.
4909 C IF(FLUXAB.LE.0.D0) RETURN 4730.
4910 LOGFIT=.FALSE. 4731.
4911 NFIT=0 4732.
4912 PF=FLUXAB 4733.
4913 XA=0.D0 4734.
4914 YA=0.D0 4735.
4915 XB=250.D0 4736.
4916 YB=PFOFTK(WAVNA,WAVNB,XB) 4737.
4917 XX=PF*XB/YB 4738.
4918 YY=PFOFTK(WAVNA,WAVNB,XX) 4739.
4919 IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4740.
4920 IF((YY/PF).LT.0.5D0) GO TO 150 4741.
4921 IF((YY/PF).GT.2.0D0) GO TO 170 4742.
4922 IF(XX.GT.XB) GO TO 110 4743.
4923 XC=XB 4744.
4924 YC=YB 4745.
4925 XB=XX 4746.
4926 YB=YY 4747.
4927 GO TO 120 4748.
4928 110 XC=XX 4749.
4929 YC=YY 4750.
4930 120 XBA=XB-XA 4751.
4931 XCA=XC-XA 4752.
4932 XBC=XB-XC 4753.
4933 YBA=YB-YA 4754.
4934 YCA=YC-YA 4755.
4935 YBC=YB-YC 4756.
4936 NFIT=NFIT+1 4757.
4937 IF(NFIT.GT.NMAX) GO TO 200 4758.
4938 YXBA=YBA/XBA 4759.
4939 YXCA=YCA/XCA 4760.
4940 C=(YXBA-YXCA)/XBC 4761.
4941 B=YXBA-(XB+XA)*C 4762.
4942 A=YA-XA*(B+XA*C) 4763.
4943 ROOT=DSQRT(B*B+4.D0*C*(PF-A)) 4764.
4944 XX=0.5D0*(ROOT-B)/C 4765.
4945 IF(XX.LT.XA.OR.XX.GT.XC) XX=-0.5D0*(ROOT+B)/C 4766.
4946 YY=PFOFTK(WAVNA,WAVNB,XX) 4767.
4947 IF(LOGFIT) YY=DLOG(YY) 4768.
4948 IF(DABS(YY-PF).LT.DELFIT) GO TO 200 4769.
4949 IF(XX.GT.XB) GO TO 130 4770.
4950 XC=XB 4771.
4951 YC=YB 4772.
4952 GO TO 140 4773.
4953 130 XA=XB 4774.
4954 YA=YB 4775.
4955 140 XB=XX 4776.
4956 YB=YY 4777.
4957 GO TO 120 4778.
4958 150 XA=XX 4779.
4959 YA=YY 4780.
4960 160 XC=XB 4781.
4961 YC=YB 4782.
4962 XB=XB/2.D0 4783.
4963 YB=PFOFTK(WAVNA,WAVNB,XB) 4784.
4964 IF(YB.LT.YA) GO TO 190 4785.
4965 IF(YB.GT.PF) GO TO 160 4786.
4966 XA=XB 4787.
4967 YA=YB 4788.
4968 GO TO 190 4789.
4969 170 XC=XX 4790.
4970 YC=YY 4791.
4971 180 XA=XB 4792.
4972 YA=YB 4793.
4973 XB=XB*2.D0 4794.
4974 YB=PFOFTK(WAVNA,WAVNB,XB) 4795.
4975 IF(YB.GT.YC) GO TO 190 4796.
4976 IF(YB.LT.PF) GO TO 180 4797.
4977 XC=XB 4798.
4978 YC=YB 4799.
4979 190 XB=XA+(PF-YA)*(XC-XA)/(YC-YA) 4800.
4980 YB=PFOFTK(WAVNA,WAVNB,XB) 4801.
4981 XX=XB 4802.
4982 IF(DABS(YB-PF).LT.DELFIT) GO TO 200 4803.
4983 PF=DLOG(PF) 4804.
4984 YA=DLOG(YA) 4805.
4985 YB=DLOG(YB) 4806.
4986 YC=DLOG(YC) 4807.
4987 LOGFIT=.TRUE. 4808.
4988 GO TO 120 4809.
4989 200 TKOFPF=XX 4810.
4990 RETURN 4811.
4991 END 4812.
4992 SUBROUTINE WRITER(INDEX,KPAGE) 4813.
4993
4994 #include "B83XX.COM"
4995
4996 DIMENSION SRAOC(15),SRAEA(15),SRAOI(15),SRALI(15),SRASN(15) 4875.
4997 C 4876.
4998 DIMENSION SRBALB(6),SRXALB(6) 4877.
4999 EQUIVALENCE (SRBXAL(1,1),SRBALB(1)),(SRBXAL(1,2),SRXALB(1)) 4878.
5000 C 4879.
5001 +, (BXA(20),BSNVIS),(BXA(21),BSNNIR) 4880.
5002 +, (BXA(22),XSNVIS),(BXA(23),XSNNIR) 4881.
5003 C 4882.
5004 EQUIVALENCE (ASNALB(1),ASNVIS),(ASNALB(2),ASNNIR) 4883.
5005 EQUIVALENCE (AOIALB(1),AOIVIS),(AOIALB(2),AOINIR) 4884.
5006 EQUIVALENCE (ALIALB(1),ALIVIS),(ALIALB(2),ALINIR) 4885.
5007 C 4886.
5008 EQUIVALENCE 4887.
5009 + (FEMTRA(1),ECLTRA), (FZASRA(1),ZCLSRA) 4888.
5010 +, (FEMTRA(2),EOCTRA), (FZASRA(2),ZOCSRA) 4889.
5011 +, (FEMTRA(3),ESNTRA), (FZASRA(3),ZSNSRA) 4890.
5012 +, (FEMTRA(4),EICTRA), (FZASRA(4),ZICSRA) 4891.
5013 +, (FEMTRA(5),EDSTRA), (FZASRA(5),ZDSSRA) 4892.
5014 +, (FEMTRA(6),EVGTRA), (FZASRA(6),ZVGSRA) 4893.
5015 C 4894.
5016 EQUIVALENCE (IMG(1),IMGAS1),(IMG(2),IMGAS2) 4895.
5017 EQUIVALENCE (ILG(1),ILGAS1),(ILG(2),ILGAS2) 4896.
5018 C 4897.
5019 EQUIVALENCE (ID5(1),IDPROG),(ID5(2),ID2TRD),(ID5(3),ID3SRD) 4898.
5020 EQUIVALENCE (ID5(4),ID4VEG),(ID5(5),ID5FOR) 4899.
5021 C 4900.
5022 EQUIVALENCE (PVT( 1),DESRT),(PVT( 2),TNDRA),(PVT( 3),GRASS) 4901.
5023 + ,(PVT( 4),SHRUB),(PVT( 5),TREES),(PVT( 6),DECID) 4902.
5024 + ,(PVT( 7),EVERG),(PVT( 8),RAINF),(PVT( 9),ROCKS) 4903.
5025 + ,(PVT(10),CROPS),(PVT(11),ALGAE) 4904.
5026 C 4905.
5027 EQUIVALENCE (FRC(1),FRACCC),(FRC(2), FCHI),(FRC(3), FCMI) 4906.
5028 + ,(FRC(4), FCLO),(FRC(5), FCOV) 4907.
5029 C 4908.
5030 C 4909.
5031 CHARACTER*8 FTYPE 4910.
5032 DIMENSION BGFLUX(25),BGFRAC(25),TAUSUM(25) 4911.
5033 DIMENSION SUM0(15),SUM1(40),SUM2(40),SUM3(40),FTYPE(5),AUXGAS(4) 4912.
5034 DATA FTYPE/'DOWNWARD',' UPWARD','UPWD NET','COOLRATE','FRACTION'/4913.
5035 DATA AUXGAS/1H0,1HL,1HX,1HX/ 4914.
5036 DATA P0/1013.25/ 4915.
5037 C 4916.
5038 INDJ=MOD(INDEX,10) 4917.
5039 IF(INDJ.LT.1) INDJ=10 4918.
5040 INDI=1 4919.
5041 IF(INDEX.LT.11) INDI=INDJ 4920.
5042 DO 9999 INDX=INDI,INDJ 4921.
5043 C 4922.
5044 IF(INDEX.EQ.0) GO TO 10 4923.
5045 GO TO (100,200,300,400,500,600,700,800,900,1000),INDX 4924.
5046 C 4925.
5047 C------------- 4926.
5048 10 CONTINUE 4927.
5049 C------------- 4928.
5050 C 4929.
5051 NPAGE=1 4930.
5052 WRITE(6,6001) NPAGE 4931.
5053 6001 FORMAT(1I1,'(1) RADCOM M/R: (CONTROL/INPUT PARAMETERS)' 4932.
5054 + ,' DEFAULT VALUES & MODIFICATIONS'/) 4933.
5055 WRITE(6,6002) 4934.
5056 6002 FORMAT(20X,'PARAMETER/VALUE',5X,'COMMENTS RE PARAMETER DEFAULT' 4935.
5057 + ,' VALUE AND PARAMETER RANGE AND EFFECT'/10X,'AEROSOLS') 4936.
5058 WRITE(6,6003) 4937.
5059 6003 FORMAT(20X,'FGOLDH(1) = 1.0',5X,'STRATOSPHERIC AEROSOL, GLOBAL' 4938.
5060 + ,' BACKGROUND - TAU(.55) = 0.005' 4939.
5061 + /20X,'FGOLDH(2) = 1.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4940.
5062 + ,' BACKGROUND: TAU(.55) = 0.125' 4941.
5063 + /20X,'FGOLDH(3) = 0.0',5X,' TROPOSPHERIC AEROSOL OVER LAND' 4942.
5064 + ,' BACKGROUND: TAU(.55) = 0.125 (FOR FGOLDH(3)=1.0' 4943.
5065 + /) 4944.
5066 GO TO 9999 4945.
5067 C 4946.
5068 C------------- 4947.
5069 100 CONTINUE 4948.
5070 C------------- 4949.
5071 C 4950.
5072 C 4951.
5073 NPAGE=1 4952.
5074 IF(INDEX.LT.11) NPAGE=KPAGE 4953.
5075 WRITE(6,6101) NPAGE,LASTVC,KFORCE 4954.
5076 WRITE(6,6102) 4955.
5077 IDPROG=ID5(1) 4956.
5078 ID2TRD=ID5(2) 4957.
5079 ID3SRD=ID5(3) 4958.
5080 ID4VEG=ID5(4) 4959.
5081 ID5FOR=ID5(5) 4960.
5082 FACTOR=P0/(PLB(1)-PLB(2))*1.25 4961.
5083 PPMCO2=ULGAS(1,2)*FACTOR 4962.
5084 PPMO2 =ULGAS(1,4)*FACTOR 4963.
5085 PPMN2O=ULGAS(1,6)*FACTOR 4964.
5086 PPMCH4=ULGAS(1,7)*FACTOR 4965.
5087 PPMF11=ULGAS(1,8)*FACTOR 4966.
5088 PPMF12=ULGAS(1,9)*FACTOR 4967.
5089 WRITE(6,6103) (FULGAS(I),I=1,9),(FGOLDH(I),I=1,5) 4968.
5090 IF(KGASSR.GT.0.OR.KAERSR.GT.0) 4969.
5091 +WRITE(6,6104) (FULGAS(I+9),I=1,9),(FGOLDH(I+9),I=1,5) 4970.
5092 !
5093 ! === Chien Wang 121797
5094 !
5095 #if ( defined CPL_CHEM )
5096 WRITE(6,6105) PPMCO2,PPMO3,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12
5097 #else
5098 WRITE(6,6105) PPMCO2,PPMO2,PPMN2O,PPMCH4,PPMF11,PPMF12 4971.
5099 #endif
5100 + ,(FGOLDH(I),I=6,9),NV 4972.
5101 WRITE(6,6106) TAUMIN,TLGRAD,EOCTRA,ZOCSRA,FMARCL,FCLDTR,NTRACE 4973.
5102 + ,IDPROG,IMGAS1,KEEPRH,KGASSR,LAYRAD 4974.
5103 WRITE(6,6107) FRACSL,TKCICE,ESNTRA,ZSNSRA,WETTRA,FCLDSR,ITR(1) 4975.
5104 + ,ID2TRD,IMGAS2,KEEPAL,KAERSR,NL 4976.
5105 WRITE(6,6108) RATQSL,FLONO3,EICTRA,ZICSRA,WETSRA,FALGAE,ITR(2) 4977.
5106 + ,ID3SRD,ILGAS1,ISOSCT,KFRACC,NLP 4978.
5107 WRITE(6,6109) FOGTSL,ECLTRA,EDSTRA,ZDSSRA,DMOICE,FRAYLE,ITR(3) 4979.
5108 + ,ID4VEG,ILGAS2,IHGSCT,MARCLD,JMLAT 4980.
5109 WRITE(6,6110) PTLISO,ZCLSRA,EVGTRA,ZVGSRA,DMLICE,LICETK,ITR(4) 4981.
5110 + ,ID5FOR,KWVCON,LAPGAS,NORMS0,IMLON 4982.
5111 C 4983.
5112 6101 FORMAT(1I1,'(1) RADCOM 1/F: (CONTROL/INPUT PARAMETERS)' 4984.
5113 + ,' (GAS/AEROSOL REFERENCE AMOUNT SCALE FACTORS,' 4985.
5114 + ,' DEFAULTS & OPTIONS IN FORCE) LASTVC=',I7 4986.
5115 + /1X,113('-'),' KFORCE=',I10) 4987.
5116 6102 FORMAT(4X,'GAS: ','H2O',5X,'CO2',7X,'O3',6X,'O2',5X,'NO2' 4988.
5117 + ,5X,'N2O',5X,'CH4',6X,'CCL3F1',3X,'CCL2F2' 4989.
5118 + ,3X,'AERSOL: GLOBAL OCEAN LAND DESERT HAZE') 4990.
5119 6103 FORMAT(1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4991.
5120 + ,3X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4992.
5121 6104 FORMAT(1H+,T84,'T' 4993.
5122 + /1X,'FULGAS=',1P,1E7.1,1P,2E8.1,1P,1E9.1,1P,3E8.1,1P,2E9.1 4994.
5123 + ,' S',1X,'FGOLDH=',1P,1E7.1,1P,2E9.2,1P,2E8.1) 4995.
5124 !
5125 ! === Chien Wang 121797
5126 !
5127 #if ( defined CPL_CHEM )
5128 6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,f8.4,F8.0,8X,F8.4,F8.4,1X,F8.7
5129 #else
5130 6105 FORMAT(1X,'PPM(1)=$',6X,0P,1F8.3,9X,F8.0,8X,F8.4,F8.4,1X,F8.7 4996.
5131 #endif
5132 + ,1X,F8.7,3X,'TRACER=',1P,E7.1,1P,2E9.2,1P,E8.1,' NV=',I2) 4997.
5133 6106 FORMAT(1X,'TAUMIN=',1P,E7.1,1X,'TLGRAD=',0P,F4.1,' EOCTRA=',F3.1 4998.
5134 + ,1X,'ZOCSRA=', F3.1,1X,'FMARCL=', F4.2,1X,'FCLDTR=',F3.1 4999.
5135 + ,1X,'NTRACE=', I2,3X,'IDPROG=', I4,1X,'IMGAS1=', I1 5000.
5136 + ,1X,'KEEPRH=', I1,1X,'KGASSR=', I1,1X,'LAYRAD=', I2) 5001.
5137 6107 FORMAT(1X,'FRACSL=',1P,E7.1,1X,'TKCICE=',0P,F4.0,' ESNTRA=',F3.1 5002.
5138 + ,1X,'ZSNSRA=', F3.1,1X,'WETTRA=', F4.2,1X,'FCLDSR=',F3.1 5003.
5139 + ,1X,'ITR(1)=', I2,3X,'ID2TRD=', I4,1X,'IMGAS2=', I1 5004.
5140 + ,1X,'KEEPAL=', I1,1X,'KAERSR=', I1,1X,' NL=', I2) 5005.
5141 6108 FORMAT(1X,'RATQSL=', F4.2,4X,'FLONO3=', F4.1,1X,'EICTRA=',F3.1 5006.
5142 + ,1X,'ZICSRA=', F3.1,1X,'WETSRA=', F4.2,1X,'FALGAE=',F3.1 5007.
5143 + ,1X,'ITR(2)=', I2,3X,'ID3SRD=', I4,1X,'ILGAS1=', I1 5008.
5144 + ,1X,'ISOSCT=', I1,1X,'KFRACC=', I1,1X,' NLP=', I2) 5009.
5145 6109 FORMAT(1X,'FOGTSL=', F4.2,4X,'ECLTRA=', F4.2,1X,'EDSTRA=',F3.1 5010.
5146 + ,1X,'ZDSSRA=', F3.1,1X,'DMOICE=', F4.1,1X,'FRAYLE=',F3.1 5011.
5147 + ,1X,'ITR(3)=', I2,3X,'ID4VEG=', I4,1X,'ILGAS2=', I1 5012.
5148 + ,1X,'IHGSCT=', I1,1X,'MARCLD=', I1,1X,' JMLAT=', I2) 5013.
5149 6110 FORMAT(1X,'PTLISO=',1PE7.1,1X,'ZCLSRA=',0PF4.2,1X,'EVGTRA=',F3.1 5014.
5150 + ,1X,'ZVGSRA=', F3.1,1X,'DMLICE=', F4.1,1X,'LICETK=', I3 5015.
5151 + ,1X,'ITR(4)=', I2,3X,'ID5FOR=', I4,1X,'KWVCON=', I1 5016.
5152 + ,1X,'LAPGAS=', I1,1X,'NORMS0=', I1,1X,'IMLON=', I3) 5017.
5153 GO TO 9999 5018.
5154 C 5019.
5155 C------------- 5020.
5156 200 CONTINUE 5021.
5157 C------------- 5022.
5158 C 5023.
5159 NPAGE=0 5024.
5160 IF(INDEX.LT.11) NPAGE=KPAGE 5025.
5161 WRITE(6,6201) NPAGE,AUXGAS(LUXGAS+1),S0,COSZ 5026.
5162 DO 202 K=1,9 5027.
5163 DO 201 L=1,NL 5028.
5164 IF(LUXGAS.EQ.0) UXGAS(L,K)=U0GAS(L,K) 5029.
5165 201 IF(LUXGAS.EQ.1) UXGAS(L,K)=ULGAS(L,K) 5030.
5166 202 CONTINUE 5031.
5167 IF(LUXGAS.LT.2) GO TO 205 5032.
5168 LGS=(LUXGAS-2)*9 5033.
5169 DO 203 L=1,NL 5034.
5170 UXGAS(L,1)=U0GAS(L,1)*FULGAS(1+LGS) 5035.
5171 UXGAS(L,3)=U0GAS(L,3)*FULGAS(3+LGS) 5036.
5172 203 UXGAS(L,5)=U0GAS(L,5)*FULGAS(5+LGS) 5037.
5173 C 5038.
5174 DO 204 L=1,NL 5039.
5175 UXGAS(L,2)=U0GAS(L,2)*FULGAS(2+LGS) 5040.
5176 UXGAS(L,4)=U0GAS(L,4)*FULGAS(4+LGS) 5041.
5177 UXGAS(L,6)=U0GAS(L,6)*FULGAS(6+LGS) 5042.
5178 UXGAS(L,7)=U0GAS(L,7)*FULGAS(7+LGS) 5043.
5179 UXGAS(L,8)=U0GAS(L,8)*FULGAS(8+LGS) 5044.
5180 204 UXGAS(L,9)=U0GAS(L,9)*FULGAS(9+LGS) 5045.
5181 205 CONTINUE 5046.
5182 DO 206 N=1,NL 5047.
5183 L=NLP-N 5048.
5184 WRITE(6,6202) L,PLB(L),HLB(L),TLB(L),TLT(L),TLM(L) 5049.
5185 + ,(UXGAS(L,K),K=1,9),CLDTAU(L),SHL(L),RHL(L) 5050.
5186 206 CONTINUE 5051.
5187 DO 207 I=1,15 5052.
5188 207 SUM0(I)=0. 5053.
5189 DO 210 L=1,NL 5054.
5190 DO 208 I=1,9 5055.
5191 208 SUM0(I)=SUM0(I)+ULGAS(L,I) 5056.
5192 DO 209 I=1,4 5057.
5193 209 SUM0(11+I)=SUM0(11+I)+TRACER(L,I) 5058.
5194 210 SUM0(10)=SUM0(10)+CLDTAU(L) 5059.
5195 DO 212 J=1,NGOLDH 5060.
5196 TAU55=0. 5061.
5197 DO 211 I=1,NAERO 5062.
5198 211 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5063.
5199 212 SUM0(11)=SUM0(11)+TAU55 5064.
5200 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5065.
5201 TGMEAN=SQRT(TGMEAN) 5066.
5202 TGMEAN=SQRT(TGMEAN) 5067.
5203 WRITE(6,6203) SUM0(11),(SUM0(I),I=1,10) 5068.
5204 C WRITE(6,6204) POCEAN, TGO, AGESN, ZOICE,LASTVC, DESRT, DECID 5069.
5205 C + ,SRAOC(1),SRAEA(1),SRAOI(1),SRALI(1),SRASN(1) 5070.
5206 C + ,SRDALB(1),SRXALB(1) 5071.
5207 C WRITE(6,6205) PEARTH, TGE, SNOWE,WEARTH, PSIG0, TNDRA, EVERG 5072.
5208 C WRITE(6,6206) POICE, TGOI,SNOWOI,FRACCC, ALGAE, GRASS, RAINF 5073.
5209 C WRITE(6,6207) PLICE, TGLI,SNOWLI, JYEAR,TRACR1, SHRUB, ROCKS 5074.
5210 C WRITE(6,6208) MEANAL,TGMEAN,EXSNEA, JDAY,TRACR2, TREES, CROPS 5075.
5211 C WRITE(6,6209) KALVIS, TSL,EXSNOI, JLAT,TRACR3, FCHI, FCLO 5076.
5212 C WRITE(6,6210) LUXGAS, WMAG,EXSNLI, ILON,TRACR4, FCMI, FCOV 5077.
5213 C 5078.
5214 WRITE(6,6204) POCEAN,TGO,AGESN,WMAG,SUM0(12),JYEAR,BSNVIS,BSNNIR 5079.
5215 + ,LASTVC 5080.
5216 WRITE(6,6205) PEARTH,TGE,SNOWE,WEARTH,SUM0(13),JDAY,XSNVIS,XSNNIR 5081.
5217 WRITE(6,6206) POICE,TGOI,SNOWOI,ZOICE,SUM0(14),JLAT 5082.
5218 + ,(SRBALB(I),I=1,6) 5083.
5219 WRITE(6,6207) PLICE,TGLI,SNOWLI,FRC(5),SUM0(15),ILON 5084.
5220 + ,(SRXALB(I),I=1,6) 5085.
5221 WRITE(6,6208) TGMEAN,LUXGAS,PSUM,TSL,MEANAL,KALVIS,(PVT(I),I=1,11)5086.
5222 WRITE(6,6209) (BXA(I),I=1,19) 5087.
5223 6201 FORMAT(1I1,'(2) RADCOM G/L: (INPUT DATA)' 5088.
5224 + ,T41,' ABSORBER AMOUNT PER LAYER:' 5089.
5225 + ,' U',1A1,'GAS(L,K) IN CM**3(STP)/CM**2' 5090.
5226 + ,T109,'S0=',F8.3,3X,'COSZ=',F6.4/1X,132('-') 5091.
5227 + /' LN PLB HLB TLB TLT TLM ' 5092.
5228 + ,'H2O CO2 O3 O2 NO2 N2O CH4' 5093.
5229 + ,' CCL3F1 CCL2F2 CLDTAU SHL RHL ') 5094.
5230 6202 FORMAT(1X,I2,F9.3,F6.2,3F7.2,F9.3,F8.3,1X,F6.5,F8.0,1P,1E9.2 5095.
5231 + ,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,1F7.2,1X,F7.6,1X,F5.4) 5096.
5232 6203 FORMAT( 1X,'$SUM AERSOL=',F5.3,7X,'$COLUMN AMOUNT',F9.3 5097.
5233 + ,F8.3,1X,F6.5,F8.0,1P,1E9.2,1X,0P,1F6.5,F7.4,1P,2E9.2,0P,F7.2) 5098.
5234 6204 FORMAT(/1X,'POCEAN=',F6.4,' TGO=' ,F6.2,1X,' AGESN=',F6.3 5099.
5235 + , 1X,' WMAG=',F6.3,' TRACER 1=',F5.3,' JYEAR=',I4 5100.
5236 + , 3X,'BSNVIS=',F6.4,' BSNNIR=' ,F6.4,7X,'LASTVC=',I7) 5101.
5237 6205 FORMAT( ' PEARTH=',F6.4,' TGE=',F6.2,' SNOWE=',F6.3 5102.
5238 + , ' WEARTH=',F6.3,' $SUMS: 2=',F5.3 5103.
5239 + , ' JDAY=',I4 ,2X,' XSNVIS=',F6.4,' XSNNIR=',F6.4 5104.
5240 + , 8X,'NIRALB VISALB') 5105.
5241 6206 FORMAT( ' POICE=',F6.4,' TGOI=',F6.2,' SNOWOI=',F6.3 5106.
5242 + , ' ZOICE=',F6.3,' 3=',F5.3 5107.
5243 + , ' JLAT=',I4, 2X,' SRBALB=',F6.4 5108.
5244 + ,4F7.4,F7.4) 5109.
5245 6207 FORMAT( ' PLICE=',F6.4,' TGLI=',F6.2,' SNOWLI=',F6.3 5110.
5246 + , ' FRC(5)=',F6.3,' 4=',F5.3 5111.
5247 + , ' ILON=',I4, 2X,' SRXALB=',F6.4 5112.
5248 + ,4F7.4,F7.4) 5113.
5249 6208 FORMAT( 1X,13('-'),'$TGMEAN=',F6.2,14X,' LUXGAS=',I1,5X 5114.
5250 + ,1X,'DESERT TUNDRA GRASSL SHRUBS TREES DECIDF' 5115.
5251 + ,' EVERGF',' RAINF',' ROCKS',' CROPS',' ALGAE' 5116.
5252 + / ' $PSUM=',F6.4,' TSL=',F6.2,' MEANAL=',I1 5117.
5253 + ,5X,' KALVIS=',I1,T54,'PVT=',F6.4,10F7.4) 5118.
5254 6209 FORMAT(' BOCVIS BOCNIR XOCVIS XOCNIR|BEAVIS BEANIR XEAVIS XEANIR' 5119.
5255 + ,'|BOIVIS BOINIR XOIVIS XOINIR|BLIVIS BLINIR XLIVIS XLINIR' 5120.
5256 + ,'|EXPSNE|EXPSNO|EXPSNL'/1X,F6.4,18F7.4) 5121.
5257 GO TO 9999 5122.
5258 C 5123.
5259 C------------- 5124.
5260 300 CONTINUE 5125.
5261 C------------- 5126.
5262 C 5127.
5263 NPAGE=0 5128.
5264 IF(INDEX.LT.11) NPAGE=KPAGE 5129.
5265 IF(NL.GT.13) NPAGE=1 5130.
5266 L=NLP 5131.
5267 STNFLB=SRNFLB(L)-TRNFLB(L) 5132.
5268 WRITE(6,6301) NPAGE,NORMS0 5133.
5269 WRITE(6,6302) L,PLB(L),HLB(L),TLB(L) 5134.
5270 + ,TRDFLB(L),TRUFLB(L),TRNFLB(L) 5135.
5271 + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),STNFLB 5136.
5272 DO 301 N=1,NL 5137.
5273 L=NLP-N 5138.
5274 CRHRF=8.4167/(PLB(L)-PLB(L+1)) 5139.
5275 STNFLB=SRNFLB(L)-TRNFLB(L) 5140.
5276 STFHR =SRFHRL(L)-TRFCRL(L) 5141.
5277 TRDCR =TRFCRL(L)*CRHRF 5142.
5278 SRDHR =SRFHRL(L)*CRHRF 5143.
5279 STDHR=STFHR*CRHRF 5144.
5280 SRALB =SRUFLB(L)/(SRDFLB(L)+1.E-10) 5145.
5281 SRXVIS=SRXATM(1) 5146.
5282 SRXNIR=SRXATM(2) 5147.
5283 WRITE(6,6303) L,PLB(L),HLB(L),TLB(L),TLT(L) 5148.
5284 + ,TRDFLB(L),TRUFLB(L),TRNFLB(L),TRFCRL(L) 5149.
5285 + ,SRDFLB(L),SRUFLB(L),SRNFLB(L),SRFHRL(L) 5150.
5286 + ,STNFLB,STFHR,STDHR,TRDCR,SRDHR,SRALB 5151.
5287 301 CONTINUE 5152.
5288 C 5153.
5289 WRITE(6,6304) BTEMPW,TRUFTW,SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR 5154.
5290 + ,PLANIR 5155.
5291 WRITE(6,6305) TRDFGW,TRUFGW,SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR 5156.
5292 + ,ALBNIR 5157.
5293 WRITE(6,6306) SRXVIS,SRXNIR,SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR 5158.
5294 + ,SRANIR 5159.
5295 WRITE(6,6307) TRDFSL,TRUFSL,TRSLCR,TRSLTS,TRSLTG,TRSLWV,TRSLBS 5160.
5296 + ,SRSLHR 5161.
5297 C 5162.
5298 WRITE(6,6308) (FSRNFG(I),I=1,4),LTOPCL,JLAT,JYEAR 5163.
5299 WRITE(6,6309) (FTRUFG(I),I=1,4),LBOTCL,ILON,JDAY 5164.
5300 WRITE(6,6310) (DTRUFG(I),I=1,4),TTRUFG,COSZ 5165.
5301 C 5166.
5302 6301 FORMAT(1I1,'(3) RADCOM M/S: (OUTPUT DATA)' 5167.
5303 + ,T37,'THERMAL FLUXES (W/M**2)',4X,'SOLAR FLUXES (W/M**2)' 5168.
5304 + ,1X,'NORMS0=',I1,' ENERGY INPUT HEAT/COOL DEG/DAY ALB' 5169.
5305 + ,'DO'/1X,31('-'),2X,9('---'),2X,10('---'),1X,'$',7('-') 5170.
5306 + ,'$',5('-'),1X,'$',5('-'),'$',5('-'),'$',5('-'),1X,'$----' 5171.
5307 + /' LN PLB HLB TLB TLT ' 5172.
5308 + ,' TRDFLB TRUFLB TRNFLB TRFCRL SRDFLB SRUFLB SRNFLB' 5173.
5309 + ,' SRFHRL STNFLB STFHR STDHR TRDCR SRDHR SRALB') 5174.
5310 6302 FORMAT(1X,I2,F9.3,F6.2,1X,F6.2,8X,3F7.2,8X,3F8.2,7X,F8.2) 5175.
5311 6303 FORMAT(1X,I2,F9.3,F6.2,2F7.2,1X,3F7.2,F7.2,1X,3F8.2,F7.2,1X,F7.2 5176.
5312 + ,1X,F6.2,1X,3F6.2,1X,F5.4) 5177.
5313 6304 FORMAT(/1X,'AT ATM TOP: ',' BTEMPW=',F6.2,1X,' TRUFTW=',F6.3 5178.
5314 + , 2X,' SRIVIS=',F6.2,' SROVIS=',F6.2, ' PLAVIS=',F6.4 5179.
5315 + , 2X,' SRINIR=',F6.2,' SRONIR=',F6.2, ' PLANIR=',F6.4) 5180.
5316 6305 FORMAT( 1X,'AT GROUND : ',' TRDFGW=',F6.3,1X,' TRUFGW=',F6.3 5181.
5317 + , 2X,' SRDVIS=',F6.2,' SRUVIS=',F6.2, ' ALBVIS=',F6.4 5182.
5318 + , 2X,' SRDNIR=',F6.2,' SRUNIR=',F6.2, ' ALBNIR=',F6.4) 5183.
5319 6306 FORMAT( 1X,'ATMOSPHERE: ',' SRXVIS=',F6.4,1X,' SRXNIR=',F6.4 5184.
5320 + , 2X,' SRTVIS=',F6.4,' SRRVIS=',F6.4, ' SRAVIS=',F6.4 5185.
5321 + , 2X,' SRTNIR=',F6.4,' SRRNIR=',F6.4, ' SRANIR=',F6.4) 5186.
5322 6307 FORMAT( 1X,'SURF LAYER: ',' TRDRSL=',F6.2,1X,' TRUFSL=',F6.2 5187.
5323 + , 2X,' TRSLCR=',F6.4,'+TRSLTS=',F6.4, '-TRSLTG=',F6.4 5188.
5324 + , 2X,' TRSLWV=',F6.4,' TRSLBS=',F6.3, ' SRSLHR=',F6.4) 5189.
5325 6308 FORMAT(/1X,'FSRNFG(I)=> FRAC SRNFLB(1) EACH SURFTYPE' 5190.
5326 + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5191.
5327 + ,F7.4,1X,' LTOPCL=',I2,' JLAT=',I2,' JYEAR',I4) 5192.
5328 6309 FORMAT( 1X,'FTRUFG(I)=> FRAC TRUFLB(1) EACH SURFTYPE' 5193.
5329 + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5194.
5330 + ,F7.4,1X,' LBOTCL=',I2,' ILON=',I2,' JDAY=',I4) 5195.
5331 6310 FORMAT( 1X,'DTRUFG(I)=> DERIV TRUFLB(1) EACH SURFTYPE' 5196.
5332 + ,' OCEAN=',F7.4,' EARTH=',F7.4,' OICE=',F7.4,' LICE=' 5197.
5333 + ,F7.4, '=>TTRUFG=',F6.4,' COSZ=',F6.4) 5198.
5334 GO TO 9999 5199.
5335 C 5200.
5336 C------------- 5201.
5337 400 CONTINUE 5202.
5338 C------------- 5203.
5339 GO TO 9999 5204.
5340 C 5205.
5341 C------------- 5206.
5342 500 CONTINUE 5207.
5343 C------------- 5208.
5344 C 5209.
5345 NPAGE=1 5210.
5346 IF(INDEX.LT.11) NPAGE=KPAGE 5211.
5347 SIGMA=5.6697D-08 5212.
5348 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5213.
5349 TGMEAN=SQRT(TGMEAN) 5214.
5350 TGMEAN=SQRT(TGMEAN) 5215.
5351 SIGT4=SIGMA*TGMEAN**4 5216.
5352 ITG=TGMEAN 5217.
5353 WTG=TGMEAN-ITG 5218.
5354 ITG=ITG-IT0 5219.
5355 SUMK=0.0 5220.
5356 DO 501 K=1,NKTR 5221.
5357 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5222.
5358 BGFRAC(K)=BGFLUX(K)/SIGT4 5223.
5359 SUMK=SUMK+BGFLUX(K) 5224.
5360 ITG=ITG+ITNEXT 5225.
5361 501 CONTINUE 5226.
5362 WRITE(6,6501) NPAGE 5227.
5363 WRITE(6,6502) (K,K=1,11) 5228.
5364 DO 502 N=1,NL 5229.
5365 L=NLP-N 5230.
5366 LI=L 5231.
5367 LL=NL*10+L 5232.
5368 WRITE(6,6503) L,PL(L),DPL(L),TLM(L),(TAULAP(I),I=LI,LL,NL) 5233.
5369 502 CONTINUE 5234.
5370 LK=0 5235.
5371 DO 504 K=1,NKTR 5236.
5372 TAUSUM(K)=0. 5237.
5373 DO 503 L=1,NL 5238.
5374 LK=LK+1 5239.
5375 503 TAUSUM(K)=TAUSUM(K)+TAULAP(LK) 5240.
5376 504 CONTINUE 5241.
5377 WRITE(6,6504) (TAUSUM(K),K=1,11) 5242.
5378 WRITE(6,6505) 5243.
5379 WRITE(6,6506) SUMK,(BGFLUX(K),K=1,11) 5244.
5380 WRITE(6,6507) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5245.
5381 NPAGE=0 5246.
5382 IF(NL.GT.13) NPAGE=1 5247.
5383 WRITE(6,6508) NPAGE 5248.
5384 WRITE(6,6509) (K,K=12,25) 5249.
5385 DO 505 N=1,NL 5250.
5386 L=NLP-N 5251.
5387 LI=NL*11+L 5252.
5388 LL=NL*24+L 5253.
5389 WRITE(6,6510) L,(TAULAP(I),I=LI,LL,NL) 5254.
5390 505 CONTINUE 5255.
5391 WRITE(6,6511) (TAUSUM(K),K=12,NKTR) 5256.
5392 WRITE(6,6512) (BGFLUX(K),K=12,NKTR) 5257.
5393 WRITE(6,6513) (BGFRAC(K),K=12,NKTR) 5258.
5394 C 5259.
5395 6501 FORMAT(1I1,'(5) TAULAP TABLE FOR THERMAL RADIATION: INCLUDES' 5260.
5396 + ,' WEAK OVERLAPPING GAS ABSORPTION BY' 5261.
5397 + ,' H2O, CO2, O3, N2O, CH4',T117,'LIST: TAULAP(LK)'/ 5262.
5398 + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5263.
5399 + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5264.
5400 + ,/T30,8('-'),3X,93('-')) 5265.
5401 6502 FORMAT(' LN PL DPL TLM K=' 5266.
5402 + ,I4,5X,'K=',I4,I10,5I9,3I10) 5267.
5403 6503 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5268.
5404 6504 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5269.
5405 6505 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5270.
5406 6506 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5271.
5407 6507 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5272.
5408 + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5273.
5409 6508 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5274.
5410 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5275.
5411 + /4X,92('-'),3X,34('-')) 5276.
5412 6509 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5277.
5413 6510 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5278.
5414 6511 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5279.
5415 6512 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5280.
5416 6513 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5281.
5417 GO TO 9999 5282.
5418 C 5283.
5419 C------------- 5284.
5420 600 CONTINUE 5285.
5421 C------------- 5286.
5422 C 5287.
5423 NPAGE=1 5288.
5424 IF(INDEX.LT.11) NPAGE=KPAGE 5289.
5425 SIGMA=5.6697D-08 5290.
5426 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5291.
5427 TGMEAN=SQRT(TGMEAN) 5292.
5428 TGMEAN=SQRT(TGMEAN) 5293.
5429 SIGT4=SIGMA*TGMEAN**4 5294.
5430 ITG=TGMEAN 5295.
5431 WTG=TGMEAN-ITG 5296.
5432 ITG=ITG-IT0 5297.
5433 SUMK=0.0 5298.
5434 DO 601 K=1,NKTR 5299.
5435 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5300.
5436 BGFRAC(K)=BGFLUX(K)/SIGT4 5301.
5437 SUMK=SUMK+BGFLUX(K) 5302.
5438 ITG=ITG+ITNEXT 5303.
5439 601 CONTINUE 5304.
5440 WRITE(6,6601) NPAGE 5305.
5441 WRITE(6,6602) (K,K=1,11) 5306.
5442 DO 602 N=1,NL 5307.
5443 L=NLP-N 5308.
5444 LI=L 5309.
5445 LL=NL*10+L 5310.
5446 WRITE(6,6603) L,PL(L),DPL(L),TLM(L),(TAUN(I),I=LI,LL,NL) 5311.
5447 602 CONTINUE 5312.
5448 LK=0 5313.
5449 DO 604 K=1,NKTR 5314.
5450 TAUSUM(K)=TAUSL(K) 5315.
5451 DO 603 L=1,NL 5316.
5452 LK=LK+1 5317.
5453 603 TAUSUM(K)=TAUSUM(K)+TAUN(LK) 5318.
5454 604 CONTINUE 5319.
5455 WRITE(6,6604) (TAUSL(K),K=1,11) 5320.
5456 WRITE(6,6605) (TAUSUM(K),K=1,11) 5321.
5457 WRITE(6,6606) SUMK,(BGFLUX(K),K=1,11) 5322.
5458 WRITE(6,6607) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5323.
5459 NPAGE=0 5324.
5460 IF(NL.GT.13) NPAGE=1 5325.
5461 WRITE(6,6608) NPAGE 5326.
5462 WRITE(6,6609) (K,K=12,25) 5327.
5463 DO 605 N=1,NL 5328.
5464 L=NLP-N 5329.
5465 LI=NL*11+L 5330.
5466 LL=NL*24+L 5331.
5467 WRITE(6,6610) L,(TAUN(I),I=LI,LL,NL) 5332.
5468 605 CONTINUE 5333.
5469 WRITE(6,6611) ( TAUSL(K),K=12,NKTR) 5334.
5470 WRITE(6,6612) (TAUSUM(K),K=12,NKTR) 5335.
5471 WRITE(6,6613) (BGFLUX(K),K=12,NKTR) 5336.
5472 WRITE(6,6614) (BGFRAC(K),K=12,NKTR) 5337.
5473 C 5338.
5474 6601 FORMAT(1I1,'(6) TAU TABLE FOR THERMAL RADIATION: INCLUDES ANY' 5339.
5475 + ,' SPECIFIED OVERLAP, CLOUD & AEROSOL ABSORPTION' 5340.
5476 + ,T117,'TAUN(LK),TAUSL(L)'/ 5341.
5477 + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5342.
5478 + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5343.
5479 + ,/T30,8('-'),3X,93('-')) 5344.
5480 6602 FORMAT(' LN PL DPL TLM K=' 5345.
5481 + ,I4,5X,'K=',I4,I10,5I9,3I10) 5346.
5482 6603 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5347.
5483 6604 FORMAT(/13X,'SURFACE LAYER=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5348.
5484 6605 FORMAT(/13X,'COLUMN AMOUNT=',F10.3,F11.3,F10.3,5F9.3,3F10.3) 5349.
5485 6606 FORMAT(/1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5350.
5486 6607 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5351.
5487 + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5352.
5488 6608 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5353.
5489 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5354.
5490 + /4X,92('-'),3X,34('-')) 5355.
5491 6609 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5356.
5492 6610 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5357.
5493 6611 FORMAT(/1X,'SL',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5358.
5494 6612 FORMAT(/1X,'CA',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5359.
5495 6613 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5360.
5496 6614 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5361.
5497 GO TO 9999 5362.
5498 C 5363.
5499 C------------- 5364.
5500 700 CONTINUE 5365.
5501 C------------- 5366.
5502 C 5367.
5503 NPAGE=1 5368.
5504 IF(INDEX.LT.11) NPAGE=KPAGE 5369.
5505 SIGMA=5.6697D-08 5370.
5506 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5371.
5507 TGMEAN=SQRT(TGMEAN) 5372.
5508 TGMEAN=SQRT(TGMEAN) 5373.
5509 SIGT4=SIGMA*TGMEAN**4 5374.
5510 ITG=TGMEAN 5375.
5511 WTG=TGMEAN-ITG 5376.
5512 ITG=ITG-IT0 5377.
5513 SUMK=0.0 5378.
5514 DO 701 K=1,NKTR 5379.
5515 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5380.
5516 BGFRAC(K)=BGFLUX(K)/SIGT4 5381.
5517 SUMK=SUMK+BGFLUX(K) 5382.
5518 ITG=ITG+ITNEXT 5383.
5519 701 CONTINUE 5384.
5520 WRITE(6,6701) NPAGE 5385.
5521 WRITE(6,6702) (K,K=1,11) 5386.
5522 DO 702 N=1,NL 5387.
5523 L=NLP-N 5388.
5524 WRITE(6,6703) L,PL(L),DPL(L),TLM(L),(TRAEXT(L,K),K=1,11) 5389.
5525 702 CONTINUE 5390.
5526 DO 704 K=1,NKTR 5391.
5527 TAUSUM(K)=0. 5392.
5528 DO 703 L=1,NL 5393.
5529 703 TAUSUM(K)=TAUSUM(K)+TRAEXT(L,K) 5394.
5530 704 CONTINUE 5395.
5531 WRITE(6,6704) (TAUSUM(K),K=1,11) 5396.
5532 WRITE(6,6705) 5397.
5533 WRITE(6,6706) SUMK,(BGFLUX(K),K=1,11) 5398.
5534 WRITE(6,6707) TGMEAN,SIGT4,(BGFRAC(K),K=1,11) 5399.
5535 NPAGE=0 5400.
5536 IF(NL.GT.13) NPAGE=1 5401.
5537 WRITE(6,6708) NPAGE 5402.
5538 WRITE(6,6709) (K,K=12,25) 5403.
5539 DO 705 N=1,NL 5404.
5540 L=NLP-N 5405.
5541 WRITE(6,6710) L,(TRAEXT(L,K),K=12,NKTR) 5406.
5542 705 CONTINUE 5407.
5543 WRITE(6,6711) (TAUSUM(K),K=12,NKTR) 5408.
5544 WRITE(6,6712) (BGFLUX(K),K=12,NKTR) 5409.
5545 WRITE(6,6713) (BGFRAC(K),K=12,NKTR) 5410.
5546 C 5411.
5547 6701 FORMAT(1I1,'(7) AEROSOL TAU TABLE FOR THERMAL RADIATION:' 5412.
5548 + ,' CLOUD & AEROSOL ABSORPTION' 5413.
5549 + ,T116,'LIST: TRAEXT(L,K)'/ 5414.
5550 + ,/1X,'K-DISTRIBUTION BREAKDOWN:' 5415.
5551 + ,T31,'WINDOW',T65,'WATER VAPOR: PRINCIPAL ABSORBER REGION'5416.
5552 + ,/T30,8('-'),3X,93('-')) 5417.
5553 6702 FORMAT(' LN PL DPL TLM K=' 5418.
5554 + ,I4,5X,'K=',I4,I10,5I9,3I10) 5419.
5555 6703 FORMAT(1X,I2,2F8.3,F7.2,F11.6,F11.6,F10.6,5F9.5,3F10.5) 5420.
5556 6704 FORMAT(/13X,'COLUMN AMOUNT=',F10.6,F11.6,F10.6,5F9.5,3F10.5) 5421.
5557 6705 FORMAT(' K-INTERVAL CONTRIBUTIONS:'/' COMPARE WITH GROUND FLUX:') 5422.
5558 6706 FORMAT( 1X,'PLANCK FLUX W/M**2=',F6.2,2F11.3,F10.3,5F9.3,3F10.3) 5423.
5559 6707 FORMAT( 1X,'FRAC(TG=',F6.2,')**4=',F6.2,2X 5424.
5560 + ,F9.5,F11.5,F10.5,5F9.5,3F10.5) 5425.
5561 6708 FORMAT(1I1/T25,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5426.
5562 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5427.
5563 + /4X,92('-'),3X,34('-')) 5428.
5564 6709 FORMAT(1X,'LN K=',I4,I10,6I9,2I10,5X,'K=',I3,3I9) 5429.
5565 6710 FORMAT( 1X, I2,F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5430.
5566 6711 FORMAT(/1X,'CA',F9.6,F10.6,6F9.5,2F10.5,F10.5,3F9.5) 5431.
5567 6712 FORMAT(/1X,'PF',F9.3,F10.3,6F9.3,2F10.3,F10.3,3F9.3) 5432.
5568 6713 FORMAT( 1X,'FR',F9.5,F10.5,6F9.5,2F10.5,F10.5,3F9.5) 5433.
5569 GO TO 9999 5434.
5570 C 5435.
5571 C------------- 5436.
5572 800 CONTINUE 5437.
5573 C------------- 5438.
5574 C 5439.
5575 NPAGE=1 5440.
5576 IF(INDEX.LT.11) NPAGE=KPAGE 5441.
5577 WRITE(6,6801) NPAGE 5442.
5578 DO 802 K=1,NKSR 5443.
5579 SUM1(K)=0. 5444.
5580 SUM2(K)=0. 5445.
5581 SUM3(K)=0. 5446.
5582 DO 801 L=1,NL 5447.
5583 SUM1(K)=SUM1(K)+EXTAER(L,K) 5448.
5584 SUM2(K)=SUM2(K)+SCTAER(L,K) 5449.
5585 SUM3(K)=SUM3(K)+SCTAER(L,K)*COSAER(L,K) 5450.
5586 801 PI0AER(L,K)=SCTAER(L,K)/(EXTAER(L,K)+1.E-10) 5451.
5587 SUM3(K)=SUM3(K)/(SUM2(K)+1.E-10) 5452.
5588 SUM0(K)=SUM2(K)/(SUM1(K)+1.E-10) 5453.
5589 802 CONTINUE 5454.
5590 WRITE(6,6802) (K,K=1,6),(K,K=1,6) 5455.
5591 DO 803 N=1,NL 5456.
5592 L=NLP-N 5457.
5593 WRITE(6,6803) L,PLB(L),HLB(L) 5458.
5594 + ,(EXTAER(L,J),J=1,6),(SCTAER(L,J),J=1,6) 5459.
5595 803 CONTINUE 5460.
5596 WRITE(6,6804) (SUM1(K),K=1,NKSR),(SUM2(K),K=1,NKSR) 5461.
5597 NPAGE=0 5462.
5598 IF(NL.GT.13) NPAGE=1 5463.
5599 WRITE(6,6805) NPAGE 5464.
5600 WRITE(6,6806) (K,K=1,6),(K,K=1,6) 5465.
5601 DO 804 N=1,NL 5466.
5602 L=NLP-N 5467.
5603 WRITE(6,6807) L,PL(L),DPL(L) 5468.
5604 + ,(COSAER(L,J),J=1,6),(PI0AER(L,J),J=1,6) 5469.
5605 804 CONTINUE 5470.
5606 WRITE(6,6808) (SUM3(K),K=1,NKSR),(SUM0(K),K=1,NKSR) 5471.
5607 WRITE(6,6809) (SRBALB(K),K=1,NKSR) 5472.
5608 WRITE(6,6810) (SRXALB(K),K=1,NKSR) 5473.
5609 WRITE(6,6811) 5474.
5610 SUM=0. 5475.
5611 DO 806 J=1,5 5476.
5612 TAU55=0. 5477.
5613 DO 805 I=1,NAERO 5478.
5614 805 TAU55=TAU55+AGOLDH(I,J)*FGOLDH(J) 5479.
5615 WRITE(6,6812) J,FGOLDH(J),TAU55 5480.
5616 806 SUM=SUM+TAU55 5481.
5617 WRITE(6,6813) SUM 5482.
5618 C 5483.
5619 6801 FORMAT(1I1,'(8) AEROSOL INPUT FOR SOLAR RADIATION:' 5484.
5620 + ,' AEROSOL RADIATIVE PROPERTIES' 5485.
5621 + ,T81,'LIST: EXTAER(L,K),SCTAER(L,K),COSAER(L,K),PIZERO(L,K)'5486.
5622 + //T42,'TAU -- EXTINCTION',T99,'TAU -- SCATTERING' 5487.
5623 + ,/T24,53('-'),4X,53('-')) 5488.
5624 6802 FORMAT(' LN PLB HLB K=',I3,5I9,7X,'K=',I3,5I9) 5489.
5625 6803 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5490.
5626 6804 FORMAT(/1X,T7,'COLUMN AMOUNT=',2X,6F9.6,3X,6F9.6) 5491.
5627 6805 FORMAT(1I1/T48,'COSBAR',T105,'PIZERO' 5492.
5628 + ,/T24,53('-'),4X,53('-')) 5493.
5629 6806 FORMAT(' LN PL DPL K=',I3,5I9,7X,'K=',I3,5I9) 5494.
5630 6807 FORMAT(1X,I2,2F8.3,3X,6F9.6,3X,6F9.6) 5495.
5631 6808 FORMAT(/1X,T7,'COLUMN MEAN=',2X,6F9.6,3X,6F9.6) 5496.
5632 6809 FORMAT(/1X,T7,'ALBEDO RSURFB=',2X,6F9.6,3X,6F9.6) 5497.
5633 6810 FORMAT( 1X,T7,'ALBEDO RSURFX=',2X,6F9.6,3X,6F9.6) 5498.
5634 GO TO 9999 5499.
5635 6811 FORMAT(///T44,'AEROSOL COMPOSITION AND TYPE MIX:' 5500.
5636 + ,T81,'FACTOR',6X,'VALUE',T107,'TAU(0.55)'/) 5501.
5637 6812 FORMAT(T81,'FGOLDH(',I1,') =',1P,E9.2,5X,0P,F7.4) 5502.
5638 6813 FORMAT(/T81,'SUM COLUMN TAU(0.55) =',F10.4) 5503.
5639 C 5504.
5640 C------------- 5505.
5641 900 CONTINUE 5506.
5642 C------------- 5507.
5643 C 5508.
5644 SIGMA=5.6697D-08 5509.
5645 TGMEAN=POCEAN*TGO**4+PEARTH*TGE**4+PLICE*TGLI**4+POICE*TGOI**4 5510.
5646 TGMEAN=SQRT(TGMEAN) 5511.
5647 TGMEAN=SQRT(TGMEAN) 5512.
5648 SIGT4=SIGMA*TGMEAN**4 5513.
5649 ITG=TGMEAN 5514.
5650 WTG=TGMEAN-ITG 5515.
5651 ITG=ITG-IT0 5516.
5652 DO 901 K=1,NKTR 5517.
5653 BGFLUX(K)=PLANCK(ITG)-(PLANCK(ITG)-PLANCK(ITG+1))*WTG 5518.
5654 BGFRAC(K)=BGFLUX(K)/SIGT4 5519.
5655 ITG=ITG+ITNEXT 5520.
5656 901 CONTINUE 5521.
5657 DO 910 NW=1,5 5522.
5658 DO 903 K=1,NKTR 5523.
5659 DO 902 L=1,NLP 5524.
5660 IF(NW.EQ.1) WFLB(L,K)=DFLB(L,K) 5525.
5661 IF(NW.EQ.2) WFLB(L,K)=UFLB(L,K) 5526.
5662 IF(NW.EQ.3) WFLB(L,K)=UFLB(L,K)-DFLB(L,K) 5527.
5663 IF(NW.GT.3.AND.L.GT.NL) GO TO 902 5528.
5664 IF(NW.EQ.4) WFLB(L,K)=WFLB(L+1,K)-WFLB(L,K) 5529.
5665 IF(NW.EQ.5.AND.ABS(TRFCRL(L)).LT.1.E-10) WFLB(L,K)=1.E-30 5530.
5666 IF(NW.EQ.5) WFLB(L,K)=WFLB(L,K)/(ABS(TRFCRL(L))+1.E-10) 5531.
5667 902 CONTINUE 5532.
5668 IF(NW.EQ.1) WFSL(K)=DFSL(K) 5533.
5669 IF(NW.EQ.2) WFSL(K)=UFSL(K) 5534.
5670 IF(NW.EQ.3) WFSL(K)=UFSL(K)-DFSL(K) 5535.
5671 IF(NW.EQ.4) WFSL(K)=WFSL(K)-UFLB(1,K)+DFLB(1,K) 5536.
5672 IF(NW.EQ.5.AND.ABS(TRSLCR).LT.1.E-10) WFSL(K)=1.E-30 5537.
5673 IF(NW.EQ.5) WFSL(K)=WFSL(K)/(ABS(TRSLCR)+1.E-10) 5538.
5674 903 CONTINUE 5539.
5675 DO 907 L=1,NLP 5540.
5676 IF(L.GT.NL.AND.NW.GT.3) GO TO 907 5541.
5677 ASUM1=0. 5542.
5678 BSUM1=0. 5543.
5679 CSUM1=0. 5544.
5680 DSUM1=0. 5545.
5681 ESUM1=0. 5546.
5682 FSUM1=0. 5547.
5683 SUM=0. 5548.
5684 DO 904 K=2,11 5549.
5685 ASUM1=ASUM1+ WFSL(K) 5550.
5686 BSUM1=BSUM1+ BGFEMT(K) 5551.
5687 CSUM1=CSUM1+BGFLUX(K) 5552.
5688 DSUM1=DSUM1+BGFRAC(K) 5553.
5689 ESUM1=ESUM1+TRCALB(K) 5554.
5690 FSUM1=FSUM1+ TRGALB(K) 5555.
5691 904 SUM=SUM+WFLB(L,K) 5556.
5692 SUM1(L)=SUM 5557.
5693 ASUM2=0. 5558.
5694 BSUM2=0. 5559.
5695 CSUM2=0. 5560.
5696 DSUM2=0. 5561.
5697 ESUM2=0. 5562.
5698 FSUM2=0. 5563.
5699 SUM=0. 5564.
5700 DO 905 K=12,21 5565.
5701 ASUM2=ASUM2+ WFSL(K) 5566.
5702 BSUM2=BSUM2+ BGFEMT(K) 5567.
5703 CSUM2=CSUM2+BGFLUX(K) 5568.
5704 DSUM2=DSUM2+BGFRAC(K) 5569.
5705 ESUM2=ESUM2+TRCALB(K) 5570.
5706 FSUM2=FSUM2+ TRGALB(K) 5571.
5707 905 SUM=SUM+WFLB(L,K) 5572.
5708 SUM2(L)=SUM 5573.
5709 ASUM3=0. 5574.
5710 BSUM3=0. 5575.
5711 CSUM3=0. 5576.
5712 DSUM3=0. 5577.
5713 ESUM3=0. 5578.
5714 FSUM3=0. 5579.
5715 SUM=0. 5580.
5716 DO 906 K=22,NKTR 5581.
5717 ASUM3=ASUM3+ WFSL(K) 5582.
5718 BSUM3=BSUM3+ BGFEMT(K) 5583.
5719 CSUM3=CSUM3+BGFLUX(K) 5584.
5720 DSUM3=DSUM3+BGFRAC(K) 5585.
5721 ESUM3=ESUM3+TRCALB(K) 5586.
5722 FSUM3=FSUM3+ TRGALB(K) 5587.
5723 906 SUM=SUM+WFLB(L,K) 5588.
5724 SUM3(L)=SUM 5589.
5725 907 CONTINUE 5590.
5726 C 5591.
5727 NPAGE=1 5592.
5728 WRITE(6,6901) NPAGE,NW,FTYPE(NW) 5593.
5729 WRITE(6,6902) (K,K=1,11) 5594.
5730 DO 908 N=1,NLP 5595.
5731 L=NLP+1-N 5596.
5732 IF(L.GT.NL.AND.NW.GT.3) GO TO 908 5597.
5733 SUML=SUM1(L)+SUM2(L)+SUM3(L)+WFLB(L,1) 5598.
5734 WRITE(6,6903) L,SUML,SUM1(L),SUM2(L),SUM3(L),(WFLB(L,K),K=1,11) 5599.
5735 908 CONTINUE 5600.
5736 SUMA=ASUM1+ASUM2+ASUM3+ WFSL(1) 5601.
5737 SUMB=BSUM1+BSUM2+BSUM3+ BGFEMT(1) 5602.
5738 SUMC=CSUM1+CSUM2+CSUM3+BGFLUX(1) 5603.
5739 SUMD=DSUM1+DSUM2+DSUM3+BGFRAC(1) 5604.
5740 SUME=ESUM1+ESUM2+ESUM3+TRCALB(1) 5605.
5741 SUMF=FSUM1+FSUM2+FSUM3+TRGALB(1) 5606.
5742 WRITE(6,6904) SUMA,ASUM1,ASUM2,ASUM3,( WFSL(K),K=1,11) 5607.
5743 WRITE(6,6905) SUMB,BSUM1,BSUM2,BSUM3,( BGFEMT(K),K=1,11) 5608.
5744 WRITE(6,6906) SUMC,CSUM1,CSUM2,CSUM3,(BGFLUX(K),K=1,11) 5609.
5745 WRITE(6,6907) SUMD,DSUM1,DSUM2,DSUM3,(BGFRAC(K),K=1,11) 5610.
5746 WRITE(6,6908) SUME,ESUM1,ESUM2,ESUM3,(TRCALB(K),K=1,11) 5611.
5747 WRITE(6,6909) SUMF,FSUM1,FSUM2,FSUM3,(TRGALB(K),K=1,11) 5612.
5748 NPAGE=0 5613.
5749 IF(NL.GT.13) NPAGE=1 5614.
5750 WRITE(6,6910) NPAGE 5615.
5751 WRITE(6,6911) (K,K=12,25) 5616.
5752 DO 909 N=1,NLP 5617.
5753 L=NLP+1-N 5618.
5754 IF(L.GT.NL.AND.NW.GT.3) GO TO 909 5619.
5755 WRITE(6,6912) L,(WFLB(L,K),K=12,NKTR) 5620.
5756 909 CONTINUE 5621.
5757 WRITE(6,6913) ( WFSL(K),K=12,NKTR) 5622.
5758 WRITE(6,6914) ( BGFEMT(K),K=12,NKTR) 5623.
5759 WRITE(6,6915) (BGFLUX(K),K=12,NKTR) 5624.
5760 WRITE(6,6916) (BGFRAC(K),K=12,NKTR) 5625.
5761 WRITE(6,6917) (TRCALB(K),K=12,NKTR) 5626.
5762 WRITE(6,6918) ( TRGALB(K),K=12,NKTR) 5627.
5763 910 CONTINUE 5628.
5764 C 5629.
5765 6901 FORMAT(1I1,'(9.',I1,') THERMAL RADIATION: K-DISTRIBUTION' 5630.
5766 + ,' BREAKDOWN FOR ',1A8,' FLUX'/ 5631.
5767 + /T8,'SUM PRINCIPAL REGION SUM',4X 5632.
5768 + ,'WINDOW',T66,'WATER VAPOR: PRINCIPAL ABSORBER REGION' 5633.
5769 + ,/T7,'-----',2X,20('-'),4X,6('-'),3X,87('-')) 5634.
5770 6902 FORMAT(1X,'LN TOTAL H2O CO2 O3 K=' 5635.
5771 + ,I2,5X,'K=',I2,9I9) 5636.
5772 6903 FORMAT( 1X,I2,F8.2,1X,3F7.2,F10.3,10F9.3) 5637.
5773 6904 FORMAT(/' SL',F8.2,1X,3F7.2,F10.3,10F9.3) 5638.
5774 6905 FORMAT(/' BG',F8.2,1X,3F7.2,F10.3,10F9.3) 5639.
5775 6906 FORMAT( ' PF',F8.2,1X,3F7.2,F10.3,10F9.3) 5640.
5776 6907 FORMAT( ' FR',F8.4,1X,3F7.4,F10.5,10F9.5) 5641.
5777 6908 FORMAT(/' AC',F8.2,1X,3F7.2,F10.3,10F9.3) 5642.
5778 6909 FORMAT( ' AG',F8.2,1X,3F7.2,F10.3,10F9.3) 5643.
5779 6910 FORMAT(1I1/T26,'CARBON DIOXIDE: PRINCIPAL ABSORBER REGION' 5644.
5780 + ,T100,'OZONE: PRINCIPAL ABSORBER REGION' 5645.
5781 + /5X,89('-'),5X,34('-')) 5646.
5782 6911 FORMAT(1X,'LN K=',I4,9I9,7X,'K=',I3,3I9) 5647.
5783 6912 FORMAT( 1X,I2,1X,10F9.3,3X,4F9.3) 5648.
5784 6913 FORMAT(/' SL',1X,10F9.3,3X,4F9.3) 5649.
5785 6914 FORMAT(/' BG',1X,10F9.3,3X,4F9.3) 5650.
5786 6915 FORMAT( ' PF',1X,10F9.3,3X,4F9.3) 5651.
5787 6916 FORMAT( ' FR',1X,10F9.5,3X,4F9.5) 5652.
5788 6917 FORMAT(/' AC',1X,10F9.3,3X,4F9.3) 5653.
5789 6918 FORMAT( ' AG',1X,10F9.3,3X,4F9.3) 5654.
5790 RETURN 5655.
5791 C 5656.
5792 C------------- 5657.
5793 1000 CONTINUE 5658.
5794 C------------- 5659.
5795 C 5660.
5796 NPAGE=1 5661.
5797 IF(INDEX.LT.11) NPAGE=KPAGE 5662.
5798 WRITE(6,7001) NPAGE 5663.
5799 7001 FORMAT(1I1,'(10) BLOCK DATA AEROSOL PROPERTY SPECIFICATION:') 5664.
5800 9999 CONTINUE 5665.
5801 RETURN 5666.
5802 END 5667.
5803 SUBROUTINE SOLARZ(NG,KWRITE) 5668.
5804 #include "B83XX.COM" 5669.
5805 DIMENSION SRDATA(187),ZRDATA(187) 5730.
5806 EQUIVALENCE (SRDFLB(1),SRDATA(1)) 5731.
5807 c DOUBLE PRECISION XMU(50),WT(50) 5732.
5808 dimension XMU(50),WT(50)
5809 DATA NSRD/187/ 5733.
5810 DIMENSION NOFLUX(7) 5734.
5811 DATA NOFLUX/164,167,168,169,170,171,174/ 5735.
5812 C 5736.
5813 C------------------------------------- 5737.
5814 CALL GAUSST(NG,0.D0,1.D0,XMU,WT) 5738.
5815 C------------------------------------- 5739.
5816 DO 100 J=1,NG 5740.
5817 100 WT(J)=WT(J)*2.D0*XMU(J) 5741.
5818 C 5742.
5819 DO 110 I=1,NSRD 5743.
5820 110 ZRDATA(I)=0. 5744.
5821 C 5745.
5822 NORM=NORMS0 5746.
5823 ZCOS=COSZ 5747.
5824 C 5748.
5825 DO 130 J=1,NG 5749.
5826 COSZ=XMU(J) 5750.
5827 NORMS0=1 5751.
5828 C--------------- 5752.
5829 CALL SOLAR 5753.
5830 C--------------- 5754.
5831 DO 120 I=1,NSRD 5755.
5832 120 ZRDATA(I)=ZRDATA(I)+SRDATA(I)*WT(J) 5756.
5833 KPAGE=J-(J/2)*2 5757.
5834 IF(KWRITE.GT.1) CALL WRITER(3,KPAGE) 5758.
5835 130 CONTINUE 5759.
5836 C 5760.
5837 DO 150 I=1,NSRD 5761.
5838 FACTOR=0.25 5762.
5839 DO 140 K=1,7 5763.
5840 IF(I.EQ.NOFLUX(K)) FACTOR=1. 5764.
5841 140 CONTINUE 5765.
5842 IF(I.GT.176) FACTOR=1. 5766.
5843 150 SRDATA(I)=ZRDATA(I)*FACTOR 5767.
5844 COSZ=NG 5768.
5845 IF(NG.GT.9) COSZ=.1*NG 5769.
5846 COSZ=COSZ+NG/1000. 5770.
5847 KPAGE=1 5771.
5848 C 5772.
5849 NORMS0=100 5773.
5850 C 5774.
5851 IF(KWRITE.GT.0) CALL WRITER(13,KPAGE) 5775.
5852 C 5776.
5853 COSZ=ZCOS 5777.
5854 NORMS0=NORM 5778.
5855 C 5779.
5856 RETURN 5780.
5857 END 5781.
5858 SUBROUTINE GAUSST(NG,X1,X2,XP,WT) 5782.
5859 c IMPLICIT DOUBLE PRECISION (A-H,O-Z) 5783.
5860 DIMENSION XP(1),WT(1) 5784.
5861 real*8 pi, ps, dxl
5862 DATA PI,PS,DXL/3.141592653589793D0,1.013211836423378D-01,1.D-16/ 5785.
5863 XMID=(X2+X1)/2.D0 5786.
5864 XDIF=X2-X1 5787.
5865 XHAF=XDIF/2.D0 5788.
5866 DNG=NG 5789.
5867 NN=NG/2 5790.
5868 N2=NN*2 5791.
5869 IF(N2.EQ.NG) GO TO 110 5792.
5870 XP(NN+1)=XMID 5793.
5871 WT(NN+1)=XDIF 5794.
5872 IF(NG.LT.2) RETURN 5795.
5873 PN=1.D0 5796.
5874 N=0 5797.
5875 100 N=N+2 5798.
5876 DN=N 5799.
5877 DM=DN-1.D0 5800.
5878 PN=PN*(DM/DN) 5801.
5879 IF(N.LT.N2) GO TO 100 5802.
5880 WT(NN+1)=XDIF/(DNG*PN)**2 5803.
5881 110 I=0 5804.
5882 C=PI/DSQRT(DNG*(DNG+1.D0)+0.5D0-PS)/105.D0 5805.
5883 120 I=I+1 5806.
5884 DI=I 5807.
5885 Z=PS/(4.D0*DI-1.D0)**2 5808.
5886 ZZ=(105.D0+Z*(210.D0-Z*(2170.D0-Z*(105812.D0-12554474.D0*Z)))) 5809.
5887 X=DCOS(ZZ*C*(DI-0.25D0)) 5810.
5888 130 N=1 5811.
5889 DM=1.D0 5812.
5890 PNI=1.D0 5813.
5891 PNJ=X 5814.
5892 140 N=N+1 5815.
5893 DN=N 5816.
5894 PNK=((DM+DN)*X*PNJ-DM*PNI)/DN 5817.
5895 PNI=PNJ 5818.
5896 PNJ=PNK 5819.
5897 DM=DN 5820.
5898 IF(N.LT.NG) GO TO 140 5821.
5899 DX=PNJ*(1.D0-X*X)/DNG/(PNI-X*PNJ) 5822.
5900 X=X-DX 5823.
5901 IF(DABS(DX).GT.DXL) GO TO 130 5824.
5902 J=NG+1-I 5825.
5903 XP(I)=XMID-XHAF*X 5826.
5904 XP(J)=XMID+XHAF*X 5827.
5905 WT(I)=XDIF*(1.D0-X*X)/(DNG*PNI)**2 5828.
5906 WT(J)=WT(I) 5829.
5907 IF(I.LT.NN) GO TO 120 5830.
5908 RETURN 5831.
5909 END 5832.
5910 SUBROUTINE SETATM 5833.
5911 #include "B83XX.COM" 5834.
5912 DIMENSION NL4(4),PLB4(40,4) 5877.
5913 DATA NL4/12,12,24,35/ 5878.
5914 DATA PLB4/ 5879.
5915 1 1013.2500, 961.7485, 879.3460, 741.3219, 566.2166, 401.4117, 5880.
5916 1 262.3575, 154.2043, 71.8018, 10.0000, 5.0000, 2.0000, 5881.
5917 1 1.E-05, 27*0., 5882.
5918 C 5883.
5919 2 984.0000, 934.0000, 854.0000, 720.0000, 550.0000, 390.0000, 5884.
5920 2 255.0000, 150.0000, 70.0000, 10.0000, 5.0000, 2.0000, 5885.
5921 2 1.E-05, 27*0., 5886.
5922 C 5887.
5923 3 1013.2500, 988.8846, 956.9068, 910.2775, 820.4963, 683.6775, 5888.
5924 3 521.6665, 356.3138, 209.4467, 102.9552, 47.7944, 22.1797, 5889.
5925 3 10.29439, 4.77932, 2.21785, 1.01932, 0.46761, 0.21156, 5890.
5926 3 0.092671, 0.047500, 0.021885, 0.010000, 0.005000, 0.002000, 5891.
5927 3 1.00E-05, 15*0.0, 5892.
5928 C 5893.
5929 4 1013.2500,1000.0000, 950.0000, 900.0000, 850.0000, 800.0000, 5894.
5930 4 750.0000, 700.0000, 650.0000, 600.0000, 550.0000, 500.0000, 5895.
5931 4 450.0000, 400.0000, 350.0000, 300.0000, 250.0000, 200.0000, 5896.
5932 4 150.0000, 100.0000, 50.0000, 20.0000, 10.0000, 5.0000, 5897.
5933 4 2.0000, 1.0000, 0.5000, 0.2000, 0.1000, 0.0500, 5898.
5934 4 0.0200, 0.0100, 0.0050, 0.0020, 0.0010, 1.E-05, 5899.
5935 4 4*0./ 5900.
5936 C 5901.
5937 LAST=LASTVC 5902.
5938 LMAG=100000 5903.
5939 C ------------------------------------------ 5904.
5940 C NLAY: ATMOSPHERIC LAYERING SPECIFICATION 5905.
5941 C ------------------------------------------ 5906.
5942 NLAY=LAST/LMAG 5907.
5943 LAST=LAST-LMAG*NLAY 5908.
5944 LMAG=LMAG/10 5909.
5945 C 5910.
5946 KSCALE=0 5911.
5947 IF(NLAY.GT.9) KSCALE=1 5912.
5948 IF(NLAY.GT.9) NLAY=NLAY-10 5913.
5949 C 5914.
5950 IF(NLAY.LT.1.OR.NLAY.GT.8) GO TO 20 5915.
5951 GO TO (10,10,10,10,12,14,16,18),NLAY 5916.
5952 10 NL=NL4(NLAY) 5917.
5953 NLP=NL+1 5918.
5954 C (1-4)=(12,12,24,35 PRESSURE SPECIFICATIONS)5919.
5955 C -------------------------------------------5920.
5956 DO 11 N=1,NLP 5921.
5957 11 PLB(N)=PLB4(N,NLAY) 5922.
5958 GO TO 20 5923.
5959 C (5)=(1-D MODEL LAYER SPECIFICATION)5924.
5960 C -----------------------------------5925.
5961 12 NL=18 5926.
5962 DO 13 N=1,NL 5927.
5963 HLB(N)=N-1+2*(N/7) 5928.
5964 IF(N.GT. 8) HLB(N)=4*N-24-N/11-N/12 5929.
5965 13 IF(N.GT.13) HLB(N)=30+(N-14)*5 5930.
5966 HLB( 1)=1.0E-10 5931.
5967 HLB(19)=99.99 5932.
5968 GO TO 20 5933.
5969 C (6)=(LINE-BY-LINE LAYER SPECIFICATION)5934.
5970 C --------------------------------------5935.
5971 14 NL=30 5936.
5972 DO 15 N=1,NL 5937.
5973 HLB(N)=N-1+(N-17)*(N/17) 5938.
5974 15 IF(N.GT.20) HLB(N)=20+(N-20)*5 5939.
5975 HLB( 1)=1.0E-10 5940.
5976 HLB(31)=99.99 5941.
5977 GO TO 20 5942.
5978 C (7)=(MCCLATCHEY LAYER SPECIFICATION)5943.
5979 C ------------------------------------5944.
5980 16 NL=32 5945.
5981 DO 17 N=1,NL 5946.
5982 HLB(N)=N-1 5947.
5983 17 IF(N.GT.25) HLB(N)=25+5*(N-26) 5948.
5984 HLB( 1)=1.0E-10 5949.
5985 HLB(32)=70.00 5950.
5986 HLB(33)=99.99 5951.
5987 GO TO 20 5952.
5988 C (8)=(HI-RES LAYER SPECIFICATION)5953.
5989 C --------------------------------5954.
5990 18 NL=39 5955.
5991 DO 19 N=1,NL 5956.
5992 HLB(N)=N-1 5957.
5993 IF(N.GT.21) HLB(N)=20+(N-21)*2 5958.
5994 IF(N.GT.31) HLB(N)=40+(N-31)*5 5959.
5995 19 IF(N.GT.37) HLB(N)=70+(N-37)*10 5960.
5996 HLB( 1)=1.0E-10 5961.
5997 HLB(40)=99.99 5962.
5998 C 5963.
5999 C ------------------------------------------- 5964.
6000 C NATM: ATMOSPHERIC STRUCTURE SPECIFICATION 5965.
6001 C ------------------------------------------- 5966.
6002 20 NATM=LAST/LMAG 5967.
6003 LAST=LAST-LMAG*NATM 5968.
6004 LMAG=LMAG/10 5969.
6005 C 5970.
6006 IF(KSCALE.NE.1) GO TO 24 5971.
6007 C 5972.
6008 C SIGMA LEVEL RESCALING OF PRESSURES RELATIVE TO PSIG05973.
6009 C ----------------------------------------------------5974.
6010 C 5975.
6011 NLMOD=NL-LAYRAD 5976.
6012 IF(NLAY.GT.4) GO TO 22 5977.
6013 PTOP=PLB(NLMOD+1) 5978.
6014 PBOT=PLB(1) 5979.
6015 DO 21 L=1,NLMOD 5980.
6016 PSIG(L)=(PLB(L)-PTOP)/(PBOT-PTOP) 5981.
6017 21 PLB(L) =PSIG(L)*(PSIG0-PTOP)+PTOP 5982.
6018 PSIG(NLMOD+1)=0. 5983.
6019 GO TO 24 5984.
6020 C 5985.
6021 C SIGMA LEVEL RESCALING OF HEIGHTS RELATIVE TO PSIG05986.
6022 C --------------------------------------------------5987.
6023 22 HTOP=HLB(NLMOD+1) 5988.
6024 HBOT=HLB(1) 5989.
6025 DO 23 L=1,NLMOD 5990.
6026 PSIG(L)=(HLB(L)-HTOP)/(HBOT-HTOP) 5991.
6027 23 HLB(L) =PSIG(L)*(PSIG0-HTOP)+HTOP 5992.
6028 PSIG(NLMOD+1)=0. 5993.
6029 24 CONTINUE 5994.
6030 C 5995.
6031 NLP=NL+1 5996.
6032 NPHD=1+NLAY/5 5997.
6033 N=1 5998.
6034 IF(NPHD.EQ.1) P=PLB(N) 5999.
6035 IF(NPHD.EQ.2) H=HLB(N) 6000.
6036 CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6001.
6037 IF(NPHD.EQ.1) HLB(N)=H 6002.
6038 IF(NPHD.EQ.2) PLB(N)=P 6003.
6039 PB=P 6004.
6040 TB=T 6005.
6041 OB=OCM 6006.
6042 WB=WCM 6007.
6043 DO 25 N=1,NL 6008.
6044 IF(NPHD.EQ.1) P=PLB(N+1) 6009.
6045 IF(NPHD.EQ.2) H=HLB(N+1) 6010.
6046 CALL PHDATM(P,H,D,T,O,Q,S,OCM,WCM,NPHD,NATM) 6011.
6047 IF(NPHD.EQ.1) HLB(N+1)=H 6012.
6048 IF(NPHD.EQ.2) PLB(N+1)=P 6013.
6049 TLB(N)=TB 6014.
6050 TLT(N)=T 6015.
6051 TLM(N)=0.5*(T+TB) 6016.
6052 U0GAS(N,1)=WB-WCM 6017.
6053 U0GAS(N,3)=OB-OCM 6018.
6054 SHL(N)=U0GAS(N,1)/(U0GAS(N,1)+1268.75*(PB-P)) 6019.
6055 EQ=0.5*(PB+P)*SHL(N)/(0.662+0.338*SHL(N)) 6020.
6056 C$ EQ=0.5*(PB+P)*SHL(N)/(0.622+0.338*SHL(N)) 6021.
6057 ES=10.0**(9.4051-2353.0/TLM(N)) 6022.
6058 RHL(N)=EQ/ES 6023.
6059 PB=P 6024.
6060 TB=T 6025.
6061 OB=OCM 6026.
6062 25 WB=WCM 6027.
6063 TLB(NLP)=TLT(NL) 6028.
6064 TSL=TLB(1) 6029.
6065 TGO=TLB(1) 6030.
6066 TGE=TLB(1) 6031.
6067 TGOI=TGO-5. 6032.
6068 TGLI=TGE-5. 6033.
6069 C ---------------------------------- 6034.
6070 C NSUR: SURFACE TYPE SPECIFICATION 6035.
6071 C ---------------------------------- 6036.
6072 30 NSUR=LAST/LMAG 6037.
6073 LAST=LAST-LMAG*NSUR 6038.
6074 LMAG=LMAG/10 6039.
6075 C 6040.
6076 IF(NSUR.EQ.0) GO TO 40 6041.
6077 POCEAN=0. 6042.
6078 PEARTH=0. 6043.
6079 POICE =0. 6044.
6080 PLICE =0. 6045.
6081 AGESN =0. 6046.
6082 SNOWE =0. 6047.
6083 SNOWOI=0. 6048.
6084 SNOWLI=0. 6049.
6085 C 6050.
6086 IF(NSUR.EQ.1) POCEAN=1. 6051.
6087 IF(NSUR.EQ.2) PEARTH=1. 6052.
6088 IF(NSUR.EQ.3) POICE =1. 6053.
6089 IF(NSUR.EQ.4) PLICE =1. 6054.
6090 IF(NSUR.EQ.5) PEARTH=1. 6055.
6091 IF(NSUR.EQ.5) SNOWE =1. 6056.
6092 IF(NSUR.GT.5) PLICE =1. 6057.
6093 IF(NSUR.EQ.6) SNOWLI=1. 6058.
6094 IF(NSUR.LT.7) GO TO 40 6059.
6095 BXAVIS=0. 6060.
6096 BXANIR=0. 6061.
6097 IF(NSUR.EQ.7) BXAVIS=1. 6062.
6098 IF(NSUR.GT.7) BXANIR=1. 6063.
6099 IF(NSUR.EQ.9) BXAVIS=1. 6064.
6100 DO 31 I=1,5 6065.
6101 SRBXAL(I,1)=BXANIR 6066.
6102 31 SRBXAL(I,2)=BXANIR 6067.
6103 SRBXAL(6,1)=BXAVIS 6068.
6104 SRBXAL(6,2)=BXAVIS 6069.
6105 IF(KALVIS.GT.0) SRBXAL(4,1)=SRBXAL(6,1) 6070.
6106 IF(KALVIS.GT.0) SRBXAL(4,2)=SRBXAL(6,2) 6071.
6107 C 6072.
6108 C ---------------------------------------- 6073.
6109 C NTRA: TRACER COMPOSITION SPECIFICATION 6074.
6110 C ---------------------------------------- 6075.
6111 40 NTRA=LAST/LMAG 6076.
6112 LAST=LAST-LMAG*NTRA 6077.
6113 LMAG=LMAG/10 6078.
6114 C 6079.
6115 TAUT55=1.0 6080.
6116 NTRACE=1 6081.
6117 IF(NTRA.LT.1) TAUT55=0. 6082.
6118 IF(NTRA.LT.1) NTRACE=0 6083.
6119 ITR(1)=NTRA 6084.
6120 DO 41 L=1,NL 6085.
6121 41 TRACER(L,1)=TAUT55*(PLB(L)-PLB(L+1))/PLB(1) 6086.
6122 C 6087.
6123 C ------------------------------------- 6088.
6124 C NVEG: VEGETATION TYPE SPECIFICATION 6089.
6125 C ------------------------------------- 6090.
6126 50 NVEG=LAST/LMAG 6091.
6127 LAST=LAST-LMAG*NVEG 6092.
6128 LMAG=LMAG/10 6093.
6129 C 6094.
6130 DO 51 K=1,11 6095.
6131 51 PVT(K)=0. 6096.
6132 IF(NVEG.LT.1) GO TO 60 6097.
6133 PVT(NVEG)=1. 6098.
6134 C ------------------------------------- 6099.
6135 C NCLD: CLOUD LAYER,TAU SPECIFICATION 6100.
6136 C ------------------------------------- 6101.
6137 60 NCLD=LAST 6102.
6138 DO 61 L=1,NL 6103.
6139 61 CLDTAU(L)=0. 6104.
6140 IF(NCLD.GT.0) CLDTAU(NCLD)=64./2**NCLD 6105.
6141 RETURN 6106.
6142 END 6107.
6143 SUBROUTINE SETFOR(NFTFOR) 6108.
6144 #include "B83XX.COM" 6109.
6145 C COMMON/TMINOR/FCO2,FN2O,FCH4,FF11,FF12,FVOL,FSUN 6150.
6146 C 6151.
6147 C-----------------------------------------------------------------------6152.
6148 C EXTERNAL FORCING FOR CO2,N2O,CH4,F11,F12,VOLCANIC AER,SOLAR CONST6153.
6149 C STARTING FROM JAN 1,1880 PROJECTED THROUGH DEC 31,2100 6154.
6150 C INPUT FORCING DATA READ IN FROM DISK DATA DSN=CLIM.RUN.FORCING 6155.
6151 C 6156.
6152 C CALL SETFOR TO READ IN AND/OR INITIALIZE DATA AND/OR RESET PARAMS6157.
6153 C 6158.
6154 C IF(NFTFOR.GT.0) FORCING DATA WILL BE READ IN FROM DISKUNIT=NFTFOR6159.
6155 C IF(NFTFOR.EQ.0) NO DATA READ, SELECT CONSTITUENTS FOR EXT FORCING6160.
6156 C IF(NFTFOR.LT.0) NO DATA READ, RESET ONLY SOL CONST REFERENCE VALU6161.
6157 C-----------------------------------------------------------------------6162.
6158 C 6163.
6159 DIMENSION YEAR(221),SCO2(221),SCH4(221),SN2O(221) 6164.
6160 DIMENSION SF11(221),SF12(221),UPPM(221) 6165.
6161 DIMENSION TAUS(12,221),TAUM(2652) 6166.
6162 EQUIVALENCE (TAUS(1,1),TAUM(1)) 6167.
6163 C 6168.
6164 DIMENSION INDEX(9),INFOR(9) 6169.
6165 EQUIVALENCE (INFOR(1),KVOL),(INFOR(2),KCO2),(INFOR(3),KXXX) 6170.
6166 EQUIVALENCE (INFOR(4),KSUN),(INFOR(5),KYYY),(INFOR(6),KN2O) 6171.
6167 EQUIVALENCE (INFOR(7),KCH4),(INFOR(8),KF11),(INFOR(9),KF12) 6172.
6168 C 6173.
6169 DIMENSION DMO(12),JDY(12) 6174.
6170 DATA DMO/31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31./ 6175.
6171 DATA JDY/31,59,90,120,151,181,212,243,278,304,334,365/ 6176.
6172 C 6177.
6173 IF(NFTFOR.LT.0) GO TO 150 6178.
6174 IF(NFTFOR.LT.1) GO TO 110 6179.
6175 C 6180.
6176 REWIND NFTFOR 6181.
6177 READ (NFTFOR) NOUT,NEND,KFS,KCS,(YEAR(L),SCO2(L),SCH4(L),SN2O(L) 6182.
6178 + ,SF11(L),SF12(L),UPPM(L),(TAUS(K,L),K=1,12),L=1,221)6183.
6179 + ,IDATE 6184.
6180 REWIND NFTFOR 6184.5
6181 C 6185.
6182 ID5(5)=IDATE+10*KFS+KCS 6186.
6183 C 6187.
6184 C-----------------------------------------------------------------------6188.
6185 C REFERENCE YEAR IS (1958) WHERE FULGAS(K)=1 FOR CO2,N2O,CH4,F11,F126189.
6186 C MEAN 1958 BACKGROUND CO2=315 N2O=.295 CH4=1.4 F11=8.E-6 F12=25.E-66190.
6187 C GAS PPM IS LINEARLY INTERPOLATED (MEAN ANNUAL PPM OCCURS JDAY=183)6191.
6188 C 6192.
6189 C BACKGROUND TAU STRATAER=0.012 (VOLCANIC CONTRIBUTION IS ADDITIVE)6193.
6190 C 6194.
6191 C KFS=IDENTIFIER FOR F11,F12 ABUNDANCE SCENARIOS 6195.
6192 C KCS=IDENTIFIER FOR CO2 ABUNDANCE SCENARIOS 6196.
6193 C ID5(5)=IDATE+10*KFS+KCS IS THE FORCING DATA SET IDENTIFIER 6197.
6194 C-----------------------------------------------------------------------6198.
6195 C 6199.
6196 RRCO2=PPMV58(2) 6200.
6197 RCH4=PPMV58(7) 6201.
6198 RN2O=PPMV58(6) 6202.
6199 C (F11,F12 EXTERNAL FORCING DATA ARE IN PPM) 6203.
6200 RF11=PPMV58(8)*1000. 6204.
6201 RF12=PPMV58(9)*1000. 6205.
6202 C 6206.
6203 RVOL=AGOLDH(1,1) 6207.
6204 C-----------------------------------------------------------------------6208.
6205 C 6209.
6206 C SELECT CONSTITUENTS FOR WHICH EXTERNAL FORCING WILL BE IMPLEMENTED6210.
6207 C 6211.
6208 C KFORCE IS AN INTEGER UP TO NINE DIGITS LONG, SUCH THAT EACH DIGIT6212.
6209 C IS AN ON/OFF SWITCH FOR IMPLEMENTING EXTERNAL FORCING FOR:6213.
6210 C 6214.
6211 C (1) (2) (4) (6) (7) (8) (9) CODED DIGITS 6215.
6212 C VOL-AER, CO2, SOL-CON, N2O, CH4, F11, F12, RESPECTIVELY. 6216.
6213 C (THE DIGITS (3) & (5)...ARE NOT USED)6217.
6214 C 6218.
6215 C EXAMPLE: 1206789 SELECTS FORCING FOR ALL EXCEPT SOL CONST6219.
6216 C (ORDER OR REPETITION OF DIGITS IS NOT IMPORTANT)6220.
6217 C-----------------------------------------------------------------------6221.
6218 110 KFOR=KFORCE 6222.
6219 KMAG=100000000 6223.
6220 DO 120 K=1,9 6224.
6221 KF=KFOR/KMAG 6225.
6222 INDEX(K)=KF 6226.
6223 KFOR=KFOR-KF*KMAG 6227.
6224 120 KMAG=KMAG/10 6228.
6225 DO 130 K=1,9 6229.
6226 130 INFOR(K)=0 6230.
6227 DO 140 K=1,9 6231.
6228 IF(INDEX(K).EQ.0) GO TO 140 6232.
6229 INFOR(INDEX(K))=1 6233.
6230 140 CONTINUE 6234.
6231 C 6235.
6232 C-----------------------------------------------------------------------6236.
6233 C SELECT REFERENCE SOLAR CONSTANT (S0) AS PASSED IN COMMON/RADCOM/6237.
6234 C-----------------------------------------------------------------------6238.
6235 C 6239.
6236 150 S00=S0 6240.
6237 RETURN 6241.
6238 C 6242.
6239 C----------------- 6243.
6240 ENTRY GETFOR 6244.
6241 C----------------- 6245.
6242 C 6246.
6243 C-----------------------------------------------------------------------6247.
6244 C EXTERNAL FORCING RETURNED FOR CONSTITUENTS PRESELECTED IN SETFOR6248.
6245 C 6249.
6246 C RADCOM INPUT DATA: JYEAR, JDAY 6250.
6247 C 6251.
6248 C RADCOM OUTPUT DATA: FULGAS(K),K=2,6,7,8,9; FGOLDH(1), S06252.
6249 C 6253.
6250 C-----------------------------------------------------------------------6254.
6251 C 6255.
6252 JDM=JDAY 6256.
6253 DO 210 JMONTH=1,12 6257.
6254 IF(JDAY.GT.JDY(JMONTH)) GO TO 210 6258.
6255 GO TO 220 6259.
6256 210 JDM=JDAY-JDY(JMONTH) 6260.
6257 JMONTH=12 6261.
6258 220 MO=JMONTH+(JYEAR-1880)*12 6262.
6259 IF(MO.LT. 1) MO=1 6263.
6260 IF(MO.GT.2651) MO=2651 6264.
6261 C 6265.
6262 FRACYR=(JDAY-183)/365. 6266.
6263 FRACMO=JDM/DMO(JMONTH) 6267.
6264 C 6268.
6265 NY=JYEAR-1880+1 6269.
6266 IF(JDAY.LT.183) NY=NY-1 6270.
6267 IF(JDAY.LT.183) FRACYR=FRACYR+0.5 6271.
6268 IF(NY.LT. 1) NY=1 6272.
6269 IF(NY.GT.220) NY=220 6273.
6270 FCO2=SCO2(NY)+(SCO2(NY+1)-SCO2(NY))*FRACYR 6274.
6271 FCH4=SCH4(NY)+(SCH4(NY+1)-SCH4(NY))*FRACYR 6275.
6272 FN2O=SN2O(NY)+(SN2O(NY+1)-SN2O(NY))*FRACYR 6276.
6273 FF11=SF11(NY)+(SF11(NY+1)-SF11(NY))*FRACYR 6277.
6274 FF12=SF12(NY)+(SF12(NY+1)-SF12(NY))*FRACYR 6278.
6275 FSUN=UPPM(NY)+(UPPM(NY+1)-UPPM(NY))*FRACYR 6279.
6276 FVOL=TAUM(MO)+(TAUM(MO+1)-TAUM(MO))*FRACMO 6280.
6277 C 6281.
6278 C-----------------------------------------------------------------------6282.
6279 C OUTPUT FORCING DATA6283.
6280 C-----------------------------------------------------------------------6284.
6281 C 6285.
6282 IF(KCO2.GT.0) FULGAS(2)=FCO2/RRCO2 6286.
6283 IF(KN2O.GT.0) FULGAS(6)=FN2O/RN2O 6287.
6284 IF(KCH4.GT.0) FULGAS(7)=FCH4/RCH4 6288.
6285 IF(KF11.GT.0) FULGAS(8)=FF11/RF11 6289.
6286 IF(KF12.GT.0) FULGAS(9)=FF12/RF12 6290.
6287 IF(KVOL.GT.0) FGOLDH(1)=(RVOL+FVOL)/RVOL 6291.
6288 IF(KSUN.GT.0) S0=S00+S00*0.03*(FSUN-0.2) 6292.
6289 C 6293.
6290 RETURN 6294.
6291 END 6295.
6292 SUBROUTINE HGAER1(XMU,TAU,G,GG) 6301.
6293 C 6302.
6294 DIMENSION C05T00(51),C06T00(51),C07T00(51),C08T00(51),C09T00(51) 6303.
6295 DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6304.
6296 DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6305.
6297 DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6306.
6298 DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6307.
6299 DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6308.
6300 DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6309.
6301 DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6310.
6302 DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6311.
6303 DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6312.
6304 DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6313.
6305 C 6314.
6306 DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6315.
6307 DIMENSION C09TAU(51,11) 6316.
6308 C 6317.
6309 DIMENSION GTAU(51,11,5) 6318.
6310 C 6319.
6311 EQUIVALENCE (C05TAU(1, 1),C05T00(1)),(C05TAU(1, 2),C05T01(1)) 6320.
6312 EQUIVALENCE (C05TAU(1, 3),C05T02(1)),(C05TAU(1, 4),C05T03(1)) 6321.
6313 EQUIVALENCE (C05TAU(1, 5),C05T04(1)),(C05TAU(1, 6),C05T05(1)) 6322.
6314 EQUIVALENCE (C05TAU(1, 7),C05T06(1)),(C05TAU(1, 8),C05T07(1)) 6323.
6315 EQUIVALENCE (C05TAU(1, 9),C05T08(1)),(C05TAU(1,10),C05T09(1)) 6324.
6316 EQUIVALENCE (C05TAU(1,11),C05T10(1)) 6325.
6317 C 6326.
6318 EQUIVALENCE (C06TAU(1, 1),C06T00(1)),(C06TAU(1, 2),C06T01(1)) 6327.
6319 EQUIVALENCE (C06TAU(1, 3),C06T02(1)),(C06TAU(1, 4),C06T03(1)) 6328.
6320 EQUIVALENCE (C06TAU(1, 5),C06T04(1)),(C06TAU(1, 6),C06T05(1)) 6329.
6321 EQUIVALENCE (C06TAU(1, 7),C06T06(1)),(C06TAU(1, 8),C06T07(1)) 6330.
6322 EQUIVALENCE (C06TAU(1, 9),C06T08(1)),(C06TAU(1,10),C06T09(1)) 6331.
6323 EQUIVALENCE (C06TAU(1,11),C06T10(1)) 6332.
6324 C 6333.
6325 EQUIVALENCE (C07TAU(1, 1),C07T00(1)),(C07TAU(1, 2),C07T01(1)) 6334.
6326 EQUIVALENCE (C07TAU(1, 3),C07T02(1)),(C07TAU(1, 4),C07T03(1)) 6335.
6327 EQUIVALENCE (C07TAU(1, 5),C07T04(1)),(C07TAU(1, 6),C07T05(1)) 6336.
6328 EQUIVALENCE (C07TAU(1, 7),C07T06(1)),(C07TAU(1, 8),C07T07(1)) 6337.
6329 EQUIVALENCE (C07TAU(1, 9),C07T08(1)),(C07TAU(1,10),C07T09(1)) 6338.
6330 EQUIVALENCE (C07TAU(1,11),C07T10(1)) 6339.
6331 C 6340.
6332 EQUIVALENCE (C08TAU(1, 1),C08T00(1)),(C08TAU(1, 2),C08T01(1)) 6341.
6333 EQUIVALENCE (C08TAU(1, 3),C08T02(1)),(C08TAU(1, 4),C08T03(1)) 6342.
6334 EQUIVALENCE (C08TAU(1, 5),C08T04(1)),(C08TAU(1, 6),C08T05(1)) 6343.
6335 EQUIVALENCE (C08TAU(1, 7),C08T06(1)),(C08TAU(1, 8),C08T07(1)) 6344.
6336 EQUIVALENCE (C08TAU(1, 9),C08T08(1)),(C08TAU(1,10),C08T09(1)) 6345.
6337 EQUIVALENCE (C08TAU(1,11),C08T10(1)) 6346.
6338 C 6347.
6339 EQUIVALENCE (C09TAU(1, 1),C09T00(1)),(C09TAU(1, 2),C09T01(1)) 6348.
6340 EQUIVALENCE (C09TAU(1, 3),C09T02(1)),(C09TAU(1, 4),C09T03(1)) 6349.
6341 EQUIVALENCE (C09TAU(1, 5),C09T04(1)),(C09TAU(1, 6),C09T05(1)) 6350.
6342 EQUIVALENCE (C09TAU(1, 7),C09T06(1)),(C09TAU(1, 8),C09T07(1)) 6351.
6343 EQUIVALENCE (C09TAU(1, 9),C09T08(1)),(C09TAU(1,10),C09T09(1)) 6352.
6344 EQUIVALENCE (C09TAU(1,11),C09T10(1)) 6353.
6345 C 6354.
6346 EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6355.
6347 EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6356.
6348 EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6357.
6349 C 6358.
6350 C 6359.
6351 DATA C05T00/0.0, 6360.
6352 1 .0179,.0379,.0574,.0767,.0958,.1147,.1334,.1520,.1703,.1884, 6361.
6353 2 .2062,.2238,.2410,.2580,.2747,.2910,.3070,.3226,.3380,.3530, 6362.
6354 3 .3675,.3819,.3958,.4094,.4227,.4355,.4481,.4603,.4722,.4838, 6363.
6355 4 .4950,.5059,.5166,.5269,.5370,.5468,.5563,.5655,.5745,.5832, 6364.
6356 5 .5917,.5999,.6079,.6157,.6233,.6306,.6378,.6445,.6513,.6578/ 6365.
6357 C 6366.
6358 DATA C05T01/0.0, 6367.
6359 1 .0000,.0226,.0463,.0679,.0885,.1084,.1278,.1469,.1655,.1838, 6368.
6360 2 .2018,.2194,.2367,.2537,.2704,.2866,.3026,.3182,.3335,.3484, 6369.
6361 3 .3630,.3773,.3911,.4047,.4180,.4308,.4433,.4556,.4675,.4791, 6370.
6362 4 .4904,.5014,.5121,.5224,.5326,.5424,.5520,.5613,.5703,.5792, 6371.
6363 5 .5877,.5961,.6041,.6120,.6197,.6271,.6344,.6414,.6483,.6550/ 6372.
6364 C 6373.
6365 DATA C05T02/0.0, 6374.
6366 1 .0000,.0207,.0434,.0649,.0856,.1057,.1252,.1444,.1632,.1816, 6375.
6367 2 .1996,.2173,.2346,.2516,.2683,.2845,.3005,.3161,.3313,.3463, 6376.
6368 3 .3608,.3750,.3889,.4024,.4156,.4284,.4410,.4532,.4651,.4767, 6377.
6369 4 .4880,.4990,.5097,.5201,.5303,.5401,.5497,.5591,.5682,.5771, 6378.
6370 5 .5857,.5941,.6022,.6102,.6179,.6254,.6327,.6398,.6467,.6535/ 6379.
6371 C 6380.
6372 DATA C05T03/0.0, 6381.
6373 1 .0095,.0317,.0517,.0712,.0904,.1095,.1283,.1469,.1651,.1832, 6382.
6374 2 .2009,.2184,.2355,.2523,.2688,.2849,.3008,.3162,.3313,.3461, 6383.
6375 3 .3605,.3747,.3885,.4019,.4151,.4278,.4403,.4525,.4643,.4759, 6384.
6376 4 .4872,.4981,.5089,.5192,.5294,.5392,.5488,.5582,.5673,.5762, 6385.
6377 5 .5848,.5932,.6013,.6093,.6170,.6246,.6319,.6391,.6460,.6528/ 6386.
6378 C 6387.
6379 DATA C05T04/0.0, 6388.
6380 1 .0260,.0472,.0656,.0833,.1008,.1183,.1359,.1534,.1709,.1882, 6389.
6381 2 .2053,.2223,.2389,.2554,.2715,.2873,.3029,.3181,.3330,.3476, 6390.
6382 3 .3619,.3759,.3895,.4028,.4158,.4284,.4408,.4529,.4647,.4762, 6391.
6383 4 .4873,.4982,.5089,.5192,.5293,.5391,.5487,.5580,.5671,.5759, 6392.
6384 5 .5845,.5929,.6010,.6090,.6167,.6243,.6316,.6388,.6457,.6525/ 6393.
6385 C 6394.
6386 DATA C05T05/0.0, 6395.
6387 1 .0428,.0635,.0812,.0978,.1140,.1302,.1465,.1629,.1793,.1958, 6396.
6388 2 .2121,.2284,.2444,.2603,.2760,.2914,.3066,.3214,.3360,.3504, 6397.
6389 3 .3643,.3781,.3915,.4046,.4175,.4299,.4422,.4541,.4657,.4771, 6398.
6390 4 .4882,.4990,.5095,.5197,.5298,.5395,.5490,.5583,.5673,.5761, 6399.
6391 5 .5846,.5930,.6011,.6090,.6167,.6243,.6316,.6387,.6457,.6524/ 6400.
6392 C 6401.
6393 DATA C05T06/0.0, 6402.
6394 1 .0590,.0796,.0969,.1129,.1283,.1435,.1588,.1741,.1896,.2051, 6403.
6395 2 .2206,.2360,.2514,.2667,.2818,.2967,.3114,.3258,.3401,.3541, 6404.
6396 3 .3677,.3812,.3943,.4072,.4198,.4321,.4441,.4559,.4673,.4786, 6405.
6397 4 .4895,.5002,.5106,.5207,.5306,.5403,.5497,.5589,.5678,.5766, 6406.
6398 5 .5850,.5934,.6014,.6093,.6170,.6244,.6317,.6388,.6458,.6525/ 6407.
6399 C 6408.
6400 DATA C05T07/0.0, 6409.
6401 1 .0742,.0948,.1120,.1277,.1427,.1572,.1716,.1861,.2007,.2153, 6410.
6402 2 .2300,.2447,.2594,.2740,.2885,.3028,.3171,.3310,.3448,.3584, 6411.
6403 3 .3717,.3849,.3977,.4103,.4227,.4347,.4465,.4581,.4693,.4804, 6412.
6404 4 .4912,.5017,.5120,.5220,.5318,.5413,.5506,.5597,.5686,.5772, 6413.
6405 5 .5856,.5939,.6019,.6097,.6173,.6247,.6320,.6390,.6459,.6526/ 6414.
6406 C 6415.
6407 DATA C05T08/0.0, 6416.
6408 1 .0885,.1090,.1263,.1418,.1565,.1705,.1844,.1982,.2121,.2260, 6417.
6409 2 .2400,.2540,.2680,.2819,.2958,.3096,.3233,.3368,.3502,.3633, 6418.
6410 3 .3763,.3890,.4015,.4138,.4259,.4377,.4493,.4606,.4717,.4825, 6419.
6411 4 .4931,.5035,.5136,.5235,.5331,.5425,.5517,.5607,.5695,.5780, 6420.
6412 5 .5864,.5945,.6024,.6102,.6177,.6251,.6323,.6393,.6461,.6528/ 6421.
6413 C 6422.
6414 DATA C05T09/0.0, 6423.
6415 1 .1017,.1223,.1395,.1550,.1695,.1833,.1968,.2101,.2234,.2367, 6424.
6416 2 .2501,.2634,.2768,.2902,.3035,.3167,.3299,.3429,.3558,.3686, 6425.
6417 3 .3811,.3935,.4057,.4176,.4295,.4409,.4523,.4634,.4742,.4849, 6426.
6418 4 .4952,.5054,.5154,.5251,.5346,.5439,.5530,.5618,.5705,.5789, 6427.
6419 5 .5871,.5952,.6031,.6107,.6182,.6255,.6326,.6396,.6464,.6530/ 6428.
6420 C 6429.
6421 DATA C05T10/0.0, 6430.
6422 1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6431.
6423 2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6432.
6424 3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6433.
6425 4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6434.
6426 5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6435.
6427 C 6436.
6428 DATA C06T00/0.0, 6437.
6429 1 .0250,.0525,.0792,.1056,.1316,.1572,.1823,.2070,.2311,.2547, 6438.
6430 2 .2776,.3000,.3217,.3427,.3631,.3827,.4019,.4201,.4378,.4550, 6439.
6431 3 .4713,.4872,.5024,.5170,.5312,.5446,.5576,.5701,.5820,.5936, 6440.
6432 4 .6047,.6153,.6257,.6354,.6450,.6541,.6628,.6713,.6794,.6873, 6441.
6433 5 .6948,.7021,.7091,.7159,.7224,.7287,.7348,.7407,.7462,.7516/ 6442.
6434 C 6443.
6435 DATA C06T01/0.0, 6444.
6436 1 .0000,.0339,.0652,.0941,.1216,.1480,.1737,.1987,.2229,.2466, 6445.
6437 2 .2694,.2918,.3134,.3344,.3548,.3744,.3935,.4118,.4295,.4467, 6446.
6438 3 .4632,.4792,.4945,.5092,.5236,.5372,.5504,.5631,.5753,.5871, 6447.
6439 4 .5984,.6093,.6198,.6299,.6396,.6490,.6580,.6667,.6751,.6832, 6448.
6440 5 .6909,.6984,.7056,.7126,.7194,.7259,.7322,.7382,.7441,.7498/ 6449.
6441 C 6450.
6442 DATA C06T02/0.0, 6451.
6443 1 .0000,.0307,.0608,.0893,.1168,.1433,.1690,.1941,.2183,.2420, 6452.
6444 2 .2648,.2871,.3087,.3296,.3500,.3696,.3887,.4070,.4247,.4420, 6453.
6445 3 .4584,.4745,.4898,.5047,.5191,.5328,.5461,.5590,.5713,.5832, 6454.
6446 4 .5947,.6057,.6164,.6266,.6365,.6460,.6552,.6641,.6726,.6808, 6455.
6447 5 .6887,.6964,.7038,.7110,.7178,.7245,.7309,.7371,.7431,.7489/ 6456.
6448 C 6457.
6449 DATA C06T03/0.0, 6458.
6450 1 .0130,.0424,.0692,.0953,.1210,.1462,.1709,.1952,.2188,.2420, 6459.
6451 2 .2645,.2865,.3078,.3285,.3486,.3680,.3870,.4051,.4228,.4399, 6460.
6452 3 .4563,.4723,.4877,.5025,.5169,.5306,.5440,.5569,.5692,.5812, 6461.
6453 4 .5927,.6038,.6146,.6248,.6348,.6444,.6537,.6626,.6712,.6796, 6462.
6454 5 .6876,.6954,.7028,.7101,.7170,.7238,.7303,.7366,.7427,.7486/ 6463.
6455 C 6464.
6456 DATA C06T04/0.0, 6465.
6457 1 .0314,.0594,.0842,.1080,.1315,.1549,.1781,.2012,.2238,.2461, 6466.
6458 2 .2678,.2892,.3099,.3302,.3499,.3690,.3876,.4055,.4230,.4399, 6467.
6459 3 .4561,.4720,.4872,.5019,.5163,.5299,.5432,.5561,.5684,.5804, 6468.
6460 4 .5918,.6029,.6137,.6240,.6340,.6436,.6529,.6619,.6705,.6790, 6469.
6461 5 .6870,.6948,.7023,.7096,.7167,.7235,.7300,.7364,.7425,.7485/ 6470.
6462 C 6471.
6463 DATA C06T05/0.0, 6472.
6464 1 .0503,.0777,.1014,.1237,.1456,.1673,.1889,.2105,.2319,.2531, 6473.
6465 2 .2739,.2944,.3145,.3341,.3533,.3718,.3901,.4076,.4247,.4413, 6474.
6466 3 .4573,.4730,.4880,.5025,.5167,.5302,.5434,.5562,.5684,.5803, 6475.
6467 4 .5917,.6028,.6135,.6238,.6338,.6434,.6527,.6617,.6703,.6787, 6476.
6468 5 .6868,.6946,.7021,.7095,.7165,.7233,.7299,.7363,.7425,.7485/ 6477.
6469 C 6478.
6470 DATA C06T06/0.0, 6479.
6471 1 .0686,.0956,.1188,.1403,.1611,.1814,.2017,.2220,.2421,.2622, 6480.
6472 2 .2820,.3016,.3208,.3397,.3582,.3762,.3939,.4110,.4276,.4439, 6481.
6473 3 .4596,.4749,.4897,.5040,.5180,.5313,.5443,.5569,.5690,.5808, 6482.
6474 4 .5921,.6031,.6138,.6240,.6339,.6435,.6527,.6617,.6703,.6787, 6483.
6475 5 .6868,.6946,.7021,.7094,.7165,.7233,.7300,.7364,.7425,.7485/ 6484.
6476 C 6485.
6477 DATA C06T07/0.0, 6486.
6478 1 .0859,.1128,.1357,.1567,.1767,.1961,.2154,.2345,.2535,.2725, 6487.
6479 2 .2913,.3099,.3283,.3464,.3642,.3816,.3987,.4153,.4315,.4473, 6488.
6480 3 .4626,.4776,.4920,.5061,.5198,.5329,.5457,.5582,.5701,.5818, 6489.
6481 4 .5930,.6038,.6144,.6245,.6344,.6439,.6530,.6620,.6705,.6789, 6490.
6482 5 .6869,.6947,.7022,.7095,.7166,.7234,.7300,.7364,.7426,.7486/ 6491.
6483 C 6492.
6484 DATA C06T08/0.0, 6493.
6485 1 .1022,.1290,.1517,.1723,.1919,.2107,.2291,.2473,.2654,.2834, 6494.
6486 2 .3013,.3191,.3366,.3539,.3710,.3877,.4042,.4202,.4360,.4513, 6495.
6487 3 .4662,.4808,.4950,.5087,.5221,.5350,.5476,.5598,.5715,.5830, 6496.
6488 4 .5941,.6048,.6152,.6252,.6350,.6444,.6535,.6624,.6709,.6792, 6497.
6489 5 .6872,.6949,.7024,.7097,.7167,.7235,.7301,.7365,.7427,.7486/ 6498.
6490 C 6499.
6491 DATA C06T09/0.0, 6500.
6492 1 .1173,.1440,.1666,.1871,.2063,.2246,.2425,.2600,.2773,.2945, 6501.
6493 2 .3116,.3285,.3453,.3619,.3783,.3943,.4102,.4257,.4409,.4558, 6502.
6494 3 .4703,.4845,.4982,.5116,.5248,.5374,.5497,.5617,.5732,.5845, 6503.
6495 4 .5954,.6060,.6163,.6262,.6358,.6451,.6541,.6629,.6713,.6796, 6504.
6496 5 .6875,.6952,.7026,.7099,.7168,.7236,.7302,.7365,.7427,.7487/ 6505.
6497 C 6506.
6498 DATA C06T10/0.0, 6507.
6499 1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6508.
6500 2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6509.
6501 3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6510.
6502 4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6511.
6503 5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6512.
6504 C 6513.
6505 DATA C07T00/0.0, 6514.
6506 1 .0360,.0751,.1129,.1498,.1858,.2209,.2546,.2873,.3183,.3484, 6515.
6507 2 .3767,.4040,.4296,.4540,.4773,.4990,.5199,.5392,.5577,.5753, 6516.
6508 3 .5916,.6073,.6220,.6358,.6492,.6615,.6733,.6845,.6950,.7051, 6517.
6509 4 .7147,.7237,.7324,.7406,.7484,.7559,.7630,.7698,.7762,.7824, 6518.
6510 5 .7883,.7940,.7994,.8046,.8096,.8144,.8190,.8234,.8276,.8317/ 6519.
6511 C 6520.
6512 DATA C07T01/0.0, 6521.
6513 1 .0000,.0500,.0929,.1323,.1696,.2052,.2391,.2719,.3029,.3329, 6522.
6514 2 .3612,.3886,.4144,.4390,.4625,.4845,.5058,.5256,.5445,.5626, 6523.
6515 3 .5795,.5957,.6109,.6253,.6392,.6521,.6644,.6762,.6872,.6979, 6524.
6516 4 .7079,.7174,.7266,.7351,.7434,.7513,.7587,.7659,.7727,.7793, 6525.
6517 5 .7855,.7915,.7971,.8026,.8079,.8129,.8177,.8223,.8268,.8310/ 6526.
6518 C 6527.
6519 DATA C07T02/0.0, 6528.
6520 1 .0000,.0433,.0845,.1233,.1604,.1958,.2296,.2623,.2932,.3232, 6529.
6521 2 .3515,.3788,.4047,.4294,.4530,.4753,.4967,.5168,.5360,.5544, 6530.
6522 3 .5715,.5881,.6037,.6184,.6327,.6459,.6586,.6707,.6821,.6931, 6531.
6523 4 .7034,.7133,.7228,.7316,.7402,.7484,.7561,.7636,.7706,.7774, 6532.
6524 5 .7839,.7901,.7960,.8017,.8071,.8123,.8173,.8221,.8267,.8311/ 6533.
6525 C 6534.
6526 DATA C07T03/0.0, 6535.
6527 1 .0139,.0544,.0915,.1272,.1620,.1958,.2284,.2601,.2903,.3197, 6536.
6528 2 .3475,.3745,.4001,.4246,.4481,.4703,.4918,.5119,.5311,.5496, 6537.
6529 3 .5669,.5836,.5993,.6142,.6287,.6420,.6550,.6673,.6789,.6901, 6538.
6530 4 .7006,.7107,.7204,.7294,.7382,.7465,.7545,.7621,.7693,.7763, 6539.
6531 5 .7829,.7893,.7953,.8012,.8067,.8121,.8172,.8221,.8269,.8314/ 6540.
6532 C 6541.
6533 DATA C07T04/0.0, 6542.
6534 1 .0339,.0723,.1065,.1393,.1714,.2028,.2336,.2637,.2927,.3210, 6543.
6535 2 .3480,.3743,.3993,.4234,.4465,.4684,.4897,.5096,.5288,.5471, 6544.
6536 3 .5644,.5811,.5968,.6118,.6263,.6398,.6528,.6652,.6769,.6882, 6545.
6537 4 .6988,.7090,.7188,.7280,.7369,.7454,.7534,.7612,.7685,.7756, 6546.
6538 5 .7823,.7888,.7950,.8009,.8066,.8120,.8173,.8223,.8271,.8317/ 6547.
6539 C 6548.
6540 DATA C07T05/0.0, 6549.
6541 1 .0546,.0920,.1246,.1553,.1852,.2144,.2432,.2715,.2990,.3260, 6550.
6542 2 .3519,.3772,.4015,.4249,.4474,.4689,.4897,.5093,.5283,.5464, 6551.
6543 3 .5635,.5801,.5957,.6106,.6251,.6386,.6516,.6640,.6757,.6871, 6552.
6544 4 .6978,.7080,.7179,.7272,.7361,.7447,.7528,.7606,.7680,.7752, 6553.
6545 5 .7820,.7886,.7948,.8008,.8065,.8121,.8174,.8224,.8273,.8320/ 6554.
6546 C 6555.
6547 DATA C07T06/0.0, 6556.
6548 1 .0749,.1117,.1434,.1728,.2010,.2284,.2554,.2820,.3079,.3335, 6557.
6549 2 .3582,.3825,.4058,.4284,.4502,.4711,.4914,.5106,.5292,.5470, 6558.
6550 3 .5639,.5802,.5957,.6105,.6248,.6382,.6511,.6635,.6752,.6865, 6559.
6551 4 .6972,.7075,.7174,.7267,.7357,.7442,.7524,.7603,.7677,.7750, 6560.
6552 5 .7818,.7884,.7947,.8008,.8065,.8121,.8174,.8226,.8275,.8322/ 6561.
6553 C 6562.
6554 DATA C07T07/0.0, 6563.
6555 1 .0943,.1306,.1617,.1902,.2173,.2434,.2689,.2940,.3185,.3427, 6564.
6556 2 .3662,.3893,.4117,.4334,.4545,.4747,.4944,.5131,.5312,.5486, 6565.
6557 3 .5651,.5812,.5964,.6110,.6252,.6384,.6512,.6635,.6752,.6864, 6566.
6558 4 .6971,.7073,.7172,.7265,.7355,.7440,.7522,.7601,.7676,.7748, 6567.
6559 5 .7817,.7883,.7946,.8007,.8065,.8121,.8175,.8227,.8276,.8324/ 6568.
6560 C 6569.
6561 DATA C07T08/0.0, 6570.
6562 1 .1125,.1486,.1793,.2071,.2334,.2585,.2828,.3066,.3299,.3529, 6571.
6563 2 .3753,.3973,.4186,.4395,.4597,.4792,.4982,.5164,.5340,.5510, 6572.
6564 3 .5672,.5829,.5978,.6122,.6261,.6392,.6518,.6640,.6755,.6867, 6573.
6565 4 .6973,.7074,.7172,.7265,.7354,.7440,.7522,.7600,.7675,.7748, 6574.
6566 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8277,.8325/ 6575.
6567 C 6576.
6568 DATA C07T09/0.0, 6577.
6569 1 .1296,.1655,.1958,.2232,.2489,.2732,.2966,.3194,.3416,.3635, 6578.
6570 2 .3848,.4058,.4262,.4462,.4656,.4844,.5028,.5203,.5374,.5539, 6579.
6571 3 .5697,.5850,.5997,.6137,.6274,.6403,.6527,.6647,.6761,.6872, 6580.
6572 4 .6977,.7077,.7175,.7267,.7356,.7441,.7522,.7601,.7675,.7748, 6581.
6573 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6582.
6574 C 6583.
6575 DATA C07T10/0.0, 6584.
6576 1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 6585.
6577 2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 6586.
6578 3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 6587.
6579 4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 6588.
6580 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 6589.
6581 C 6590.
6582 DATA C08T00/0.0, 6591.
6583 1 .0568,.1172,.1747,.2295,.2813,.3300,.3748,.4169,.4547,.4903, 6592.
6584 2 .5220,.5517,.5784,.6030,.6257,.6460,.6652,.6825,.6985,.7134, 6593.
6585 3 .7269,.7396,.7513,.7621,.7723,.7816,.7904,.7987,.8064,.8137, 6594.
6586 4 .8204,.8268,.8329,.8385,.8439,.8490,.8538,.8584,.8627,.8668, 6595.
6587 5 .8707,.8744,.8780,.8814,.8846,.8877,.8906,.8934,.8961,.8987/ 6596.
6588 C 6597.
6589 DATA C08T01/0.0, 6598.
6590 1 .0045,.0786,.1413,.1980,.2505,.2994,.3445,.3870,.4255,.4620, 6599.
6591 2 .4948,.5257,.5538,.5798,.6039,.6258,.6464,.6650,.6823,.6985, 6600.
6592 3 .7132,.7270,.7398,.7516,.7629,.7730,.7826,.7917,.8000,.8080, 6601.
6593 4 .8153,.8223,.8289,.8350,.8408,.8463,.8514,.8564,.8610,.8654, 6602.
6594 5 .8696,.8736,.8773,.8809,.8843,.8876,.8907,.8937,.8965,.8992/ 6603.
6595 C 6604.
6596 DATA C08T02/0.0, 6605.
6597 1 .0000,.0639,.1239,.1794,.2314,.2799,.3249,.3675,.4063,.4431, 6606.
6598 2 .4766,.5081,.5370,.5637,.5888,.6115,.6330,.6525,.6707,.6878, 6607.
6599 3 .7032,.7179,.7314,.7440,.7559,.7667,.7769,.7865,.7954,.8038, 6608.
6600 4 .8117,.8190,.8260,.8325,.8387,.8445,.8499,.8551,.8600,.8647, 6609.
6601 5 .8690,.8733,.8772,.8810,.8845,.8880,.8912,.8943,.8973,.9001/ 6610.
6602 C 6611.
6603 DATA C08T03/0.0, 6612.
6604 1 .0129,.0725,.1266,.1778,.2266,.2730,.3165,.3580,.3962,.4326, 6613.
6605 2 .4659,.4975,.5265,.5536,.5790,.6021,.6241,.6441,.6628,.6804, 6614.
6606 3 .6964,.7116,.7256,.7386,.7510,.7622,.7728,.7828,.7921,.8009, 6615.
6607 4 .8090,.8167,.8240,.8307,.8372,.8432,.8489,.8543,.8594,.8642, 6616.
6608 5 .8688,.8731,.8772,.8811,.8848,.8884,.8917,.8949,.8980,.9009/ 6617.
6609 C 6618.
6610 DATA C08T04/0.0, 6619.
6611 1 .0338,.0901,.1399,.1870,.2320,.2754,.3165,.3561,.3930,.4283, 6620.
6612 2 .4609,.4920,.5207,.5477,.5730,.5962,.6184,.6385,.6575,.6753, 6621.
6613 3 .6916,.7071,.7214,.7347,.7474,.7589,.7698,.7801,.7896,.7987, 6622.
6614 4 .8071,.8150,.8225,.8294,.8361,.8423,.8481,.8537,.8589,.8639, 6623.
6615 5 .8686,.8731,.8773,.8813,.8851,.8887,.8922,.8955,.8986,.9016/ 6624.
6616 C 6625.
6617 DATA C08T05/0.0, 6626.
6618 1 .0561,.1105,.1578,.2017,.2435,.2838,.3224,.3597,.3948,.4287, 6627.
6619 2 .4602,.4904,.5185,.5450,.5699,.5930,.6150,.6351,.6541,.6720, 6628.
6620 3 .6884,.7040,.7185,.7319,.7448,.7565,.7676,.7781,.7877,.7970, 6629.
6621 4 .8056,.8136,.8213,.8284,.8352,.8416,.8476,.8533,.8586,.8637, 6630.
6622 5 .8685,.8731,.8774,.8815,.8854,.8891,.8926,.8960,.8991,.9022/ 6631.
6623 C 6632.
6624 DATA C08T06/0.0, 6633.
6625 1 .0782,.1314,.1770,.2187,.2581,.2958,.3319,.3670,.4002,.4324, 6634.
6626 2 .4626,.4917,.5189,.5447,.5691,.5918,.6134,.6334,.6522,.6700, 6635.
6627 3 .6864,.7020,.7165,.7300,.7430,.7548,.7660,.7766,.7864,.7957, 6636.
6628 4 .8044,.8126,.8204,.8276,.8345,.8410,.8471,.8529,.8583,.8635, 6637.
6629 5 .8684,.8731,.8774,.8816,.8856,.8893,.8929,.8963,.8996,.9027/ 6638.
6630 C 6639.
6631 DATA C08T07/0.0, 6640.
6632 1 .0994,.1518,.1962,.2363,.2739,.3095,.3436,.3765,.4080,.4385, 6641.
6633 2 .4673,.4951,.5213,.5463,.5700,.5921,.6134,.6329,.6515,.6691, 6642.
6634 3 .6854,.7009,.7154,.7289,.7418,.7536,.7649,.7755,.7854,.7948, 6643.
6635 4 .8036,.8118,.8197,.8270,.8340,.8405,.8467,.8526,.8581,.8634, 6644.
6636 5 .8683,.8731,.8775,.8817,.8857,.8896,.8932,.8967,.8999,.9031/ 6645.
6637 C 6646.
6638 DATA C08T08/0.0, 6647.
6639 1 .1197,.1714,.2148,.2538,.2899,.3238,.3562,.3874,.4172,.4461, 6648.
6640 2 .4735,.5001,.5253,.5493,.5722,.5937,.6144,.6335,.6518,.6691, 6649.
6641 3 .6852,.7005,.7148,.7283,.7412,.7529,.7642,.7748,.7847,.7942, 6650.
6642 4 .8030,.8113,.8192,.8265,.8336,.8402,.8464,.8524,.8579,.8632, 6651.
6643 5 .8682,.8730,.8775,.8818,.8858,.8897,.8934,.8969,.9002,.9034/ 6652.
6644 C 6653.
6645 DATA C08T09/0.0, 6654.
6646 1 .1387,.1899,.2326,.2705,.3055,.3382,.3691,.3988,.4271,.4546, 6655.
6647 2 .4808,.5061,.5302,.5533,.5754,.5962,.6163,.6350,.6528,.6698, 6656.
6648 3 .6855,.7007,.7148,.7281,.7409,.7526,.7638,.7744,.7843,.7937, 6657.
6649 4 .8025,.8109,.8188,.8262,.8333,.8399,.8462,.8521,.8577,.8631, 6658.
6650 5 .8681,.8730,.8775,.8818,.8859,.8898,.8935,.8971,.9004,.9036/ 6659.
6651 C 6660.
6652 DATA C08T10/0.0, 6661.
6653 1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 6662.
6654 2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 6663.
6655 3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 6664.
6656 4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 6665.
6657 5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 6666.
6658 C 6667.
6659 DATA C09T00/0.0, 6668.
6660 1 .1151,.2302,.3312,.4172,.4903,.5514,.6016,.6447,.6796,.7102, 6669.
6661 2 .7355,.7578,.7769,.7935,.8085,.8212,.8330,.8432,.8524,.8609, 6670.
6662 3 .8683,.8752,.8815,.8872,.8926,.8974,.9019,.9061,.9100,.9136, 6671.
6663 4 .9170,.9201,.9231,.9258,.9284,.9309,.9332,.9354,.9374,.9394, 6672.
6664 5 .9412,.9430,.9446,.9462,.9477,.9492,.9506,.9519,.9531,.9543/ 6673.
6665 C 6674.
6666 DATA C09T01/0.0, 6675.
6667 1 .0245,.1526,.2576,.3468,.4239,.4902,.5461,.5952,.6357,.6717, 6676.
6668 2 .7017,.7283,.7513,.7712,.7891,.8043,.8183,.8304,.8413,.8512, 6677.
6669 3 .8599,.8680,.8753,.8818,.8880,.8934,.8985,.9032,.9075,.9116, 6678.
6670 4 .9153,.9187,.9220,.9250,.9278,.9305,.9329,.9353,.9375,.9396, 6679.
6671 5 .9415,.9434,.9451,.9468,.9484,.9499,.9513,.9527,.9540,.9552/ 6680.
6672 C 6681.
6673 DATA C09T02/0.0, 6682.
6674 1 .0057,.1184,.2173,.3044,.3816,.4494,.5078,.5598,.6035,.6428, 6683.
6675 2 .6758,.7053,.7309,.7532,.7733,.7904,.8062,.8197,.8320,.8432, 6684.
6676 3 .8529,.8619,.8700,.8772,.8841,.8901,.8956,.9008,.9055,.9099, 6685.
6677 4 .9139,.9177,.9212,.9244,.9274,.9302,.9329,.9354,.9377,.9399, 6686.
6678 5 .9419,.9439,.9457,.9475,.9491,.9507,.9521,.9535,.9549,.9561/ 6687.
6679 C 6688.
6680 DATA C09T03/0.0, 6689.
6681 1 .0177,.1190,.2077,.2880,.3610,.4269,.4847,.5372,.5820,.6227, 6690.
6682 2 .6574,.6886,.7157,.7396,.7612,.7796,.7967,.8113,.8246,.8367, 6691.
6683 3 .8472,.8570,.8657,.8735,.8809,.8873,.8933,.8989,.9039,.9086, 6692.
6684 4 .9129,.9168,.9205,.9239,.9271,.9301,.9329,.9355,.9379,.9402, 6693.
6685 5 .9423,.9444,.9462,.9481,.9497,.9514,.9529,.9543,.9557,.9570/ 6694.
6686 C 6695.
6687 DATA C09T04/0.0, 6696.
6688 1 .0383,.1335,.2145,.2879,.3553,.4173,.4729,.5241,.5685,.6094, 6697.
6689 2 .6446,.6766,.7046,.7294,.7519,.7713,.7891,.8046,.8186,.8314, 6698.
6690 3 .8425,.8529,.8621,.8704,.8782,.8850,.8913,.8972,.9025,.9074, 6699.
6691 4 .9119,.9161,.9200,.9235,.9269,.9300,.9328,.9356,.9381,.9405, 6700.
6692 5 .9427,.9448,.9467,.9486,.9503,.9520,.9535,.9550,.9564,.9577/ 6701.
6693 C 6702.
6694 DATA C09T05/0.0, 6703.
6695 1 .0614,.1528,.2288,.2967,.3590,.4167,.4692,.5181,.5613,.6013, 6704.
6696 2 .6363,.6684,.6966,.7219,.7449,.7648,.7832,.7993,.8138,.8271, 6705.
6697 3 .8387,.8495,.8591,.8678,.8759,.8830,.8896,.8958,.9013,.9064, 6706.
6698 4 .9111,.9154,.9195,.9232,.9266,.9298,.9328,.9356,.9382,.9407, 6707.
6699 5 .9429,.9451,.9471,.9490,.9508,.9525,.9541,.9556,.9570,.9583/ 6708.
6700 C 6709.
6701 DATA C09T06/0.0, 6710.
6702 1 .0849,.1736,.2461,.3098,.3680,.4217,.4710,.5172,.5586,.5974, 6711.
6703 2 .6316,.6632,.6913,.7166,.7398,.7599,.7787,.7951,.8100,.8236, 6712.
6704 3 .8355,.8467,.8566,.8656,.8740,.8813,.8882,.8945,.9002,.9055, 6713.
6705 4 .9104,.9148,.9190,.9228,.9264,.9297,.9328,.9356,.9383,.9408, 6714.
6706 5 .9431,.9454,.9474,.9494,.9512,.9529,.9545,.9561,.9575,.9589/ 6715.
6707 C 6716.
6708 DATA C09T07/0.0, 6717.
6709 1 .1078,.1944,.2643,.3249,.3797,.4300,.4764,.5199,.5594,.5965, 6718.
6710 2 .6296,.6605,.6881,.7132,.7362,.7565,.7753,.7918,.8069,.8208, 6719.
6711 3 .8330,.8443,.8545,.8637,.8723,.8799,.8869,.8934,.8992,.9047, 6720.
6712 4 .9097,.9143,.9186,.9225,.9262,.9295,.9327,.9356,.9384,.9409, 6721.
6713 5 .9433,.9456,.9477,.9497,.9515,.9533,.9549,.9565,.9579,.9593/ 6722.
6714 C 6723.
6715 DATA C09T08/0.0, 6724.
6716 1 .1297,.2146,.2824,.3405,.3927,.4402,.4839,.5250,.5625,.5979, 6725.
6717 2 .6298,.6597,.6866,.7113,.7340,.7541,.7729,.7895,.8046,.8186, 6726.
6718 3 .8309,.8424,.8528,.8621,.8709,.8786,.8858,.8924,.8984,.9040, 6727.
6719 4 .9091,.9138,.9182,.9222,.9259,.9294,.9326,.9356,.9384,.9410, 6728.
6720 5 .9434,.9457,.9479,.9499,.9518,.9536,.9552,.9568,.9583,.9597/ 6729.
6721 C 6730.
6722 DATA C09T09/0.0, 6731.
6723 1 .1505,.2340,.2999,.3561,.4060,.4512,.4927,.5315,.5672,.6009, 6732.
6724 2 .6315,.6603,.6865,.7105,.7328,.7526,.7713,.7878,.8029,.8169, 6733.
6725 3 .8293,.8409,.8513,.8608,.8697,.8775,.8848,.8916,.8976,.9033, 6734.
6726 4 .9085,.9133,.9178,.9219,.9257,.9292,.9325,.9356,.9384,.9411, 6735.
6727 5 .9435,.9459,.9480,.9501,.9520,.9538,.9555,.9571,.9586,.9600/ 6736.
6728 C 6737.
6729 DATA C09T10/0.0, 6738.
6730 1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 6739.
6731 2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 6740.
6732 3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 6741.
6733 4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 6742.
6734 5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 6743.
6735 C 6744.
6736 C 6745.
6737 IF(TAU.GT.1.0) THEN 6746.
6738 CALL HGCLD1(XMU,TAU,G,GG) 6747.
6739 GO TO 130 6748.
6740 ENDIF 6749.
6741 C 6750.
6742 C ---------------------------------------------------------------- 6751.
6743 C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 6752.
6744 C FOR AEROSOL ALBEDOS FOR OPTICAL THICKNESSES OF (0.0 < TAU < 1.0) 6753.
6745 C ---------------------------------------------------------------- 6754.
6746 C 6755.
6747 C 6756.
6748 C ------------------------------------------- 6757.
6749 C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 6758.
6750 C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 6759.
6751 C ------------------------------------------- 6760.
6752 C 6761.
6753 XI=XMU*50.0+0.9999 6762.
6754 IX=XI 6763.
6755 IF(IX.LT.1) IX=1 6764.
6756 JX=IX+1 6765.
6757 WXJ=XI-IX 6766.
6758 WXI=1.0-WXJ 6767.
6759 C 6768.
6760 C ------------------------- 6769.
6761 C AEROSOL TAU INTERPOLATION 6770.
6762 C 0.10 ON (0.0 < XMU < 1.0) 6771.
6763 C ------------------------- 6772.
6764 C 6773.
6765 TI=TAU*10.0+0.9999 6774.
6766 IT=TI 6775.
6767 IF(IT.LT.1) IT=1 6776.
6768 IF(IT.GT.11) IT=11 6777.
6769 JT=IT+1 6778.
6770 IF(JT.GT.11) JT=11 6779.
6771 WTJ=TI-IT 6780.
6772 WTI=1.0-WTJ 6781.
6773 C 6782.
6774 C ------------------------------- 6783.
6775 C COSBAR DEPENDENCE INTERPOLATION 6784.
6776 C 0.10 ON (0.5 < COSBAR < 0.9) 6785.
6777 C LINEAR FOR (0.0 < COSBAR < 0.5) 6786.
6778 C ------------------------------- 6787.
6779 C 6788.
6780 GI=G*10.0 6789.
6781 IF(GI.GT.5.0) GO TO 110 6790.
6782 JG=1 6791.
6783 GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6792.
6784 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6793.
6785 GG=GG+GG 6794.
6786 GO TO 130 6795.
6787 C 6796.
6788 110 IG=GI 6797.
6789 WGJ=GI-IG 6798.
6790 WGI=1.0-WGJ 6799.
6791 IG=IG-4 6800.
6792 JG=IG+1 6801.
6793 IF(IG.GT.4) GO TO 120 6802.
6794 C 6803.
6795 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6804.
6796 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6805.
6797 + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 6806.
6798 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 6807.
6799 GO TO 130 6808.
6800 C 6809.
6801 120 IG=5 6810.
6802 C 6811.
6803 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 6812.
6804 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 6813.
6805 + +WGJ 6814.
6806 C 6815.
6807 130 CONTINUE 6816.
6808 C 6817.
6809 RETURN 6818.
6810 END 6819.
6811 SUBROUTINE HGCLD1(XMU,TAU,G,GG) 6820.
6812 C 6821.
6813 DIMENSION C05T01(51),C06T01(51),C07T01(51),C08T01(51),C09T01(51) 6822.
6814 DIMENSION C05T02(51),C06T02(51),C07T02(51),C08T02(51),C09T02(51) 6823.
6815 DIMENSION C05T03(51),C06T03(51),C07T03(51),C08T03(51),C09T03(51) 6824.
6816 DIMENSION C05T04(51),C06T04(51),C07T04(51),C08T04(51),C09T04(51) 6825.
6817 DIMENSION C05T05(51),C06T05(51),C07T05(51),C08T05(51),C09T05(51) 6826.
6818 DIMENSION C05T06(51),C06T06(51),C07T06(51),C08T06(51),C09T06(51) 6827.
6819 DIMENSION C05T07(51),C06T07(51),C07T07(51),C08T07(51),C09T07(51) 6828.
6820 DIMENSION C05T08(51),C06T08(51),C07T08(51),C08T08(51),C09T08(51) 6829.
6821 DIMENSION C05T09(51),C06T09(51),C07T09(51),C08T09(51),C09T09(51) 6830.
6822 DIMENSION C05T10(51),C06T10(51),C07T10(51),C08T10(51),C09T10(51) 6831.
6823 DIMENSION C05T99(51),C06T99(51),C07T99(51),C08T99(51),C09T99(51) 6832.
6824 C 6833.
6825 DIMENSION C05TAU(51,11),C06TAU(51,11),C07TAU(51,11),C08TAU(51,11) 6834.
6826 DIMENSION C09TAU(51,11) 6835.
6827 C 6836.
6828 DIMENSION GTAU(51,11,5) 6837.
6829 C 6838.
6830 EQUIVALENCE (C05TAU(1, 1),C05T01(1)),(C05TAU(1, 2),C05T02(1)) 6839.
6831 EQUIVALENCE (C05TAU(1, 3),C05T03(1)),(C05TAU(1, 4),C05T04(1)) 6840.
6832 EQUIVALENCE (C05TAU(1, 5),C05T05(1)),(C05TAU(1, 6),C05T06(1)) 6841.
6833 EQUIVALENCE (C05TAU(1, 7),C05T07(1)),(C05TAU(1, 8),C05T08(1)) 6842.
6834 EQUIVALENCE (C05TAU(1, 9),C05T09(1)),(C05TAU(1,10),C05T10(1)) 6843.
6835 EQUIVALENCE (C05TAU(1,11),C05T99(1)) 6844.
6836 C 6845.
6837 EQUIVALENCE (C06TAU(1, 1),C06T01(1)),(C06TAU(1, 2),C06T02(1)) 6846.
6838 EQUIVALENCE (C06TAU(1, 3),C06T03(1)),(C06TAU(1, 4),C06T04(1)) 6847.
6839 EQUIVALENCE (C06TAU(1, 5),C06T05(1)),(C06TAU(1, 6),C06T06(1)) 6848.
6840 EQUIVALENCE (C06TAU(1, 7),C06T07(1)),(C06TAU(1, 8),C06T08(1)) 6849.
6841 EQUIVALENCE (C06TAU(1, 9),C06T09(1)),(C06TAU(1,10),C06T10(1)) 6850.
6842 EQUIVALENCE (C06TAU(1,11),C06T99(1)) 6851.
6843 C 6852.
6844 EQUIVALENCE (C07TAU(1, 1),C07T01(1)),(C07TAU(1, 2),C07T02(1)) 6853.
6845 EQUIVALENCE (C07TAU(1, 3),C07T03(1)),(C07TAU(1, 4),C07T04(1)) 6854.
6846 EQUIVALENCE (C07TAU(1, 5),C07T05(1)),(C07TAU(1, 6),C07T06(1)) 6855.
6847 EQUIVALENCE (C07TAU(1, 7),C07T07(1)),(C07TAU(1, 8),C07T08(1)) 6856.
6848 EQUIVALENCE (C07TAU(1, 9),C07T09(1)),(C07TAU(1,10),C07T10(1)) 6857.
6849 EQUIVALENCE (C07TAU(1,11),C07T99(1)) 6858.
6850 C 6859.
6851 EQUIVALENCE (C08TAU(1, 1),C08T01(1)),(C08TAU(1, 2),C08T02(1)) 6860.
6852 EQUIVALENCE (C08TAU(1, 3),C08T03(1)),(C08TAU(1, 4),C08T04(1)) 6861.
6853 EQUIVALENCE (C08TAU(1, 5),C08T05(1)),(C08TAU(1, 6),C08T06(1)) 6862.
6854 EQUIVALENCE (C08TAU(1, 7),C08T07(1)),(C08TAU(1, 8),C08T08(1)) 6863.
6855 EQUIVALENCE (C08TAU(1, 9),C08T09(1)),(C08TAU(1,10),C08T10(1)) 6864.
6856 EQUIVALENCE (C08TAU(1,11),C08T99(1)) 6865.
6857 C 6866.
6858 EQUIVALENCE (C09TAU(1, 1),C09T01(1)),(C09TAU(1, 2),C09T02(1)) 6867.
6859 EQUIVALENCE (C09TAU(1, 3),C09T03(1)),(C09TAU(1, 4),C09T04(1)) 6868.
6860 EQUIVALENCE (C09TAU(1, 5),C09T05(1)),(C09TAU(1, 6),C09T06(1)) 6869.
6861 EQUIVALENCE (C09TAU(1, 7),C09T07(1)),(C09TAU(1, 8),C09T08(1)) 6870.
6862 EQUIVALENCE (C09TAU(1, 9),C09T09(1)),(C09TAU(1,10),C09T10(1)) 6871.
6863 EQUIVALENCE (C09TAU(1,11),C09T99(1)) 6872.
6864 C 6873.
6865 EQUIVALENCE (C05TAU(1,1),GTAU(1,1,1)),(C06TAU(1,1),GTAU(1,1,2)) 6874.
6866 EQUIVALENCE (C07TAU(1,1),GTAU(1,1,3)),(C08TAU(1,1),GTAU(1,1,4)) 6875.
6867 EQUIVALENCE (C09TAU(1,1),GTAU(1,1,5)) 6876.
6868 C 6877.
6869 C 6878.
6870 DATA C05T01/0.0, 6879.
6871 1 .1139,.1346,.1518,.1673,.1817,.1953,.2086,.2216,.2344,.2472, 6880.
6872 2 .2600,.2728,.2857,.2985,.3113,.3240,.3367,.3492,.3617,.3740, 6881.
6873 3 .3862,.3982,.4100,.4217,.4332,.4444,.4554,.4663,.4769,.4873, 6882.
6874 4 .4975,.5075,.5173,.5268,.5362,.5453,.5543,.5630,.5715,.5799, 6883.
6875 5 .5880,.5960,.6037,.6113,.6187,.6259,.6330,.6399,.6466,.6532/ 6884.
6876 C 6885.
6877 DATA C05T02/0.0, 6886.
6878 1 .1981,.2188,.2361,.2514,.2656,.2788,.2912,.3031,.3145,.3255, 6887.
6879 2 .3362,.3466,.3569,.3669,.3768,.3865,.3962,.4057,.4151,.4244, 6888.
6880 3 .4337,.4428,.4519,.4609,.4698,.4785,.4872,.4958,.5043,.5127, 6889.
6881 4 .5209,.5290,.5371,.5450,.5528,.5604,.5679,.5753,.5826,.5898, 6890.
6882 5 .5968,.6037,.6105,.6171,.6237,.6301,.6364,.6425,.6486,.6545/ 6891.
6883 C 6892.
6884 DATA C05T03/0.0, 6893.
6885 1 .2435,.2639,.2809,.2960,.3099,.3227,.3348,.3463,.3571,.3676, 6894.
6886 2 .3777,.3874,.3969,.4060,.4150,.4237,.4323,.4407,.4489,.4570, 6895.
6887 3 .4650,.4728,.4806,.4882,.4957,.5031,.5104,.5177,.5248,.5319, 6896.
6888 4 .5388,.5457,.5525,.5592,.5659,.5724,.5788,.5852,.5915,.5977, 6897.
6889 5 .6038,.6098,.6157,.6215,.6273,.6330,.6385,.6440,.6494,.6547/ 6898.
6890 C 6899.
6891 DATA C05T04/0.0, 6900.
6892 1 .2714,.2914,.3081,.3229,.3365,.3491,.3608,.3719,.3824,.3925, 6901.
6893 2 .4022,.4115,.4205,.4292,.4377,.4459,.4540,.4618,.4694,.4769, 6902.
6894 3 .4842,.4914,.4985,.5054,.5122,.5189,.5255,.5320,.5384,.5447, 6903.
6895 4 .5509,.5570,.5631,.5690,.5749,.5807,.5865,.5921,.5977,.6033, 6904.
6896 5 .6087,.6141,.6194,.6246,.6298,.6349,.6399,.6448,.6497,.6545/ 6905.
6897 C 6906.
6898 DATA C05T05/0.0, 6907.
6899 1 .2900,.3097,.3262,.3408,.3541,.3664,.3778,.3887,.3989,.4088, 6908.
6900 2 .4181,.4272,.4358,.4442,.4524,.4602,.4680,.4754,.4827,.4898, 6909.
6901 3 .4967,.5035,.5101,.5166,.5230,.5293,.5354,.5415,.5474,.5533, 6910.
6902 4 .5590,.5647,.5703,.5757,.5812,.5865,.5918,.5970,.6021,.6071, 6911.
6903 5 .6121,.6171,.6219,.6267,.6315,.6361,.6407,.6453,.6498,.6542/ 6912.
6904 C 6913.
6905 DATA C05T06/0.0, 6914.
6906 1 .3033,.3228,.3390,.3534,.3665,.3786,.3898,.4005,.4105,.4201, 6915.
6907 2 .4292,.4380,.4465,.4546,.4625,.4701,.4776,.4848,.4918,.4986, 6916.
6908 3 .5053,.5118,.5182,.5244,.5305,.5364,.5423,.5480,.5537,.5592, 6917.
6909 4 .5646,.5700,.5753,.5804,.5855,.5905,.5955,.6004,.6052,.6099, 6918.
6910 5 .6146,.6192,.6237,.6282,.6326,.6370,.6413,.6456,.6498,.6539/ 6919.
6911 C 6920.
6912 DATA C05T07/0.0, 6921.
6913 1 .3133,.3325,.3485,.3627,.3757,.3876,.3987,.4092,.4190,.4284, 6922.
6914 2 .4374,.4460,.4543,.4622,.4700,.4774,.4846,.4916,.4984,.5051, 6923.
6915 3 .5115,.5178,.5240,.5300,.5359,.5416,.5472,.5528,.5582,.5635, 6924.
6916 4 .5687,.5738,.5789,.5838,.5887,.5935,.5982,.6029,.6074,.6119, 6925.
6917 5 .6164,.6208,.6251,.6293,.6335,.6377,.6418,.6458,.6498,.6537/ 6926.
6918 C 6927.
6919 DATA C05T08/0.0, 6928.
6920 1 .3210,.3400,.3559,.3699,.3827,.3945,.4054,.4158,.4255,.4348, 6929.
6921 2 .4436,.4521,.4602,.4680,.4756,.4829,.4900,.4968,.5034,.5099, 6930.
6922 3 .5162,.5224,.5284,.5342,.5400,.5455,.5510,.5564,.5616,.5667, 6931.
6923 4 .5718,.5767,.5816,.5864,.5911,.5957,.6003,.6047,.6091,.6135, 6932.
6924 5 .6177,.6219,.6261,.6302,.6342,.6381,.6421,.6459,.6497,.6535/ 6933.
6925 C 6934.
6926 DATA C05T09/0.0, 6935.
6927 1 .3271,.3460,.3618,.3757,.3883,.4000,.4108,.4211,.4306,.4398, 6936.
6928 2 .4485,.4569,.4649,.4726,.4800,.4872,.4941,.5008,.5074,.5137, 6937.
6929 3 .5199,.5259,.5318,.5375,.5431,.5486,.5539,.5591,.5642,.5693, 6938.
6930 4 .5742,.5790,.5837,.5884,.5930,.5974,.6018,.6062,.6104,.6146, 6939.
6931 5 .6188,.6228,.6268,.6308,.6347,.6385,.6423,.6460,.6497,.6533/ 6940.
6932 C 6941.
6933 DATA C05T10/0.0, 6942.
6934 1 .3321,.3509,.3665,.3803,.3929,.4045,.4152,.4253,.4348,.4439, 6943.
6935 2 .4525,.4607,.4686,.4762,.4836,.4906,.4975,.5041,.5105,.5168, 6944.
6936 3 .5229,.5288,.5345,.5401,.5457,.5510,.5562,.5614,.5664,.5713, 6945.
6937 4 .5761,.5808,.5854,.5900,.5944,.5988,.6031,.6073,.6115,.6156, 6946.
6938 5 .6196,.6236,.6275,.6313,.6351,.6388,.6425,.6461,.6497,.6532/ 6947.
6939 C 6948.
6940 DATA C05T99/0.0, 6949.
6941 1 .3759,.3933,.4078,.4204,.4320,.4425,.4522,.4614,.4699,.4781, 6950.
6942 2 .4857,.4930,.5000,.5067,.5131,.5192,.5252,.5309,.5364,.5417, 6951.
6943 3 .5469,.5519,.5568,.5615,.5661,.5705,.5749,.5791,.5832,.5873, 6952.
6944 4 .5912,.5950,.5988,.6024,.6060,.6095,.6130,.6164,.6196,.6229, 6953.
6945 5 .6260,.6292,.6322,.6352,.6381,.6410,.6439,.6467,.6494,.6521/ 6954.
6946 C 6955.
6947 DATA C06T01/0.0, 6956.
6948 1 .1314,.1581,.1806,.2009,.2199,.2379,.2553,.2722,.2889,.3055, 6957.
6949 2 .3218,.3381,.3541,.3700,.3858,.4012,.4165,.4315,.4462,.4606, 6958.
6950 3 .4746,.4884,.5018,.5148,.5277,.5400,.5520,.5638,.5751,.5862, 6959.
6951 4 .5969,.6073,.6175,.6272,.6367,.6459,.6548,.6635,.6719,.6800, 6960.
6952 5 .6879,.6955,.7029,.7101,.7170,.7237,.7303,.7366,.7427,.7487/ 6961.
6953 C 6962.
6954 DATA C06T02/0.0, 6963.
6955 1 .2301,.2561,.2779,.2973,.3151,.3317,.3472,.3620,.3761,.3897, 6964.
6956 2 .4028,.4155,.4279,.4399,.4518,.4633,.4747,.4858,.4968,.5076, 6965.
6957 3 .5182,.5287,.5389,.5490,.5589,.5686,.5781,.5875,.5967,.6057, 6966.
6958 4 .6144,.6230,.6315,.6397,.6478,.6556,.6633,.6708,.6781,.6853, 6967.
6959 5 .6922,.6991,.7057,.7121,.7184,.7246,.7306,.7364,.7421,.7476/ 6968.
6960 C 6969.
6961 DATA C06T03/0.0, 6970.
6962 1 .2848,.3100,.3311,.3497,.3668,.3825,.3971,.4110,.4240,.4365, 6971.
6963 2 .4484,.4599,.4710,.4816,.4921,.5021,.5119,.5214,.5308,.5399, 6972.
6964 3 .5488,.5575,.5661,.5745,.5828,.5908,.5988,.6066,.6142,.6217, 6973.
6965 4 .6291,.6364,.6435,.6505,.6574,.6641,.6707,.6772,.6835,.6898, 6974.
6966 5 .6959,.7019,.7077,.7135,.7191,.7246,.7300,.7353,.7404,.7455/ 6975.
6967 C 6976.
6968 DATA C06T04/0.0, 6977.
6969 1 .3189,.3434,.3639,.3819,.3983,.4134,.4273,.4406,.4529,.4647, 6978.
6970 2 .4759,.4867,.4970,.5069,.5165,.5258,.5348,.5435,.5519,.5602, 6979.
6971 3 .5682,.5761,.5837,.5912,.5985,.6057,.6127,.6196,.6263,.6330, 6980.
6972 4 .6395,.6459,.6521,.6583,.6644,.6703,.6761,.6819,.6875,.6931, 6981.
6973 5 .6985,.7039,.7091,.7143,.7194,.7243,.7292,.7340,.7387,.7433/ 6982.
6974 C 6983.
6975 DATA C06T05/0.0, 6984.
6976 1 .3420,.3660,.3859,.4034,.4193,.4339,.4474,.4601,.4720,.4833, 6985.
6977 2 .4940,.5043,.5141,.5235,.5326,.5413,.5498,.5579,.5658,.5736, 6986.
6978 3 .5810,.5883,.5954,.6023,.6091,.6157,.6221,.6285,.6346,.6407, 6987.
6979 4 .6466,.6525,.6582,.6638,.6693,.6747,.6800,.6853,.6904,.6955, 6988.
6980 5 .7004,.7053,.7101,.7148,.7194,.7240,.7285,.7329,.7372,.7415/ 6989.
6981 C 6990.
6982 DATA C06T06/0.0, 6991.
6983 1 .3586,.3821,.4016,.4187,.4342,.4484,.4615,.4739,.4854,.4964, 6992.
6984 2 .5067,.5166,.5260,.5350,.5438,.5521,.5602,.5680,.5755,.5829, 6993.
6985 3 .5899,.5968,.6036,.6101,.6165,.6227,.6287,.6347,.6405,.6462, 6994.
6986 4 .6517,.6571,.6625,.6677,.6729,.6779,.6828,.6877,.6925,.6972, 6995.
6987 5 .7018,.7063,.7108,.7152,.7195,.7237,.7279,.7320,.7360,.7400/ 6996.
6988 C 6997.
6989 DATA C06T07/0.0, 6998.
6990 1 .3711,.3942,.4133,.4301,.4453,.4592,.4720,.4841,.4953,.5060, 6999.
6991 2 .5160,.5256,.5348,.5435,.5520,.5600,.5678,.5753,.5826,.5896, 7000.
6992 3 .5964,.6031,.6095,.6157,.6219,.6278,.6336,.6392,.6447,.6501, 7001.
6993 4 .6554,.6606,.6657,.6706,.6755,.6802,.6849,.6895,.6940,.6985, 7002.
6994 5 .7028,.7071,.7113,.7154,.7195,.7235,.7274,.7313,.7351,.7388/ 7003.
6995 C 7004.
6996 DATA C06T08/0.0, 7005.
6997 1 .3808,.4036,.4224,.4390,.4539,.4676,.4801,.4920,.5029,.5134, 7006.
6998 2 .5232,.5326,.5415,.5500,.5582,.5660,.5736,.5809,.5880,.5948, 7007.
6999 3 .6014,.6078,.6140,.6200,.6259,.6316,.6372,.6427,.6480,.6532, 7008.
7000 4 .6582,.6632,.6681,.6728,.6775,.6820,.6865,.6909,.6952,.6994, 7009.
7001 5 .7036,.7077,.7117,.7156,.7195,.7233,.7270,.7307,.7343,.7379/ 7010.
7002 C 7011.
7003 DATA C06T09/0.0, 7012.
7004 1 .3886,.4111,.4297,.4460,.4607,.4742,.4865,.4982,.5089,.5192, 7013.
7005 2 .5288,.5380,.5467,.5551,.5631,.5708,.5782,.5853,.5922,.5988, 7014.
7006 3 .6052,.6115,.6175,.6234,.6291,.6347,.6401,.6454,.6505,.6555, 7015.
7007 4 .6604,.6652,.6699,.6745,.6790,.6834,.6877,.6920,.6961,.7002, 7016.
7008 5 .7042,.7081,.7119,.7157,.7195,.7231,.7267,.7303,.7337,.7372/ 7017.
7009 C 7018.
7010 DATA C06T10/0.0, 7019.
7011 1 .3949,.4172,.4356,.4517,.4663,.4796,.4917,.5032,.5138,.5239, 7020.
7012 2 .5334,.5424,.5510,.5592,.5671,.5746,.5819,.5888,.5955,.6021, 7021.
7013 3 .6083,.6144,.6203,.6261,.6317,.6371,.6424,.6475,.6525,.6574, 7022.
7014 4 .6622,.6668,.6714,.6759,.6802,.6845,.6887,.6928,.6968,.7008, 7023.
7015 5 .7046,.7085,.7122,.7159,.7195,.7230,.7265,.7299,.7333,.7366/ 7024.
7016 C 7025.
7017 DATA C06T99/0.0, 7026.
7018 1 .4509,.4707,.4871,.5013,.5141,.5256,.5362,.5461,.5551,.5638, 7027.
7019 2 .5718,.5794,.5866,.5934,.6000,.6062,.6122,.6178,.6233,.6286, 7028.
7020 3 .6336,.6386,.6433,.6478,.6523,.6565,.6607,.6647,.6686,.6724, 7029.
7021 4 .6761,.6797,.6832,.6866,.6900,.6932,.6964,.6995,.7025,.7055, 7030.
7022 5 .7084,.7112,.7140,.7167,.7194,.7220,.7245,.7270,.7295,.7319/ 7031.
7023 C 7032.
7024 DATA C07T01/0.0, 7033.
7025 1 .1456,.1813,.2114,.2384,.2635,.2872,.3099,.3319,.3532,.3742, 7034.
7026 2 .3946,.4147,.4342,.4533,.4720,.4901,.5078,.5248,.5413,.5573, 7035.
7027 3 .5727,.5876,.6019,.6156,.6290,.6417,.6539,.6657,.6770,.6879, 7036.
7028 4 .6982,.7082,.7178,.7270,.7358,.7442,.7523,.7602,.7676,.7748, 7037.
7029 5 .7816,.7883,.7946,.8007,.8066,.8122,.8176,.8228,.8278,.8326/ 7038.
7030 C 7039.
7031 DATA C07T02/0.0, 7040.
7032 1 .2601,.2939,.3219,.3466,.3691,.3898,.4090,.4272,.4442,.4606, 7041.
7033 2 .4762,.4912,.5057,.5198,.5334,.5466,.5596,.5721,.5843,.5963, 7042.
7034 3 .6078,.6192,.6302,.6410,.6515,.6616,.6715,.6811,.6904,.6995, 7043.
7035 4 .7083,.7168,.7251,.7331,.7409,.7483,.7556,.7626,.7694,.7760, 7044.
7036 5 .7824,.7885,.7945,.8002,.8058,.8111,.8163,.8214,.8262,.8309/ 7045.
7037 C 7046.
7038 DATA C07T03/0.0, 7047.
7039 1 .3256,.3578,.3842,.4074,.4283,.4473,.4648,.4813,.4966,.5111, 7048.
7040 2 .5248,.5379,.5504,.5624,.5740,.5851,.5959,.6063,.6163,.6262, 7049.
7041 3 .6357,.6450,.6540,.6628,.6715,.6798,.6880,.6960,.7037,.7113, 7050.
7042 4 .7187,.7259,.7330,.7398,.7465,.7530,.7594,.7656,.7716,.7774, 7051.
7043 5 .7831,.7887,.7940,.7993,.8044,.8093,.8141,.8188,.8233,.8278/ 7052.
7044 C 7053.
7045 DATA C07T04/0.0, 7054.
7046 1 .3675,.3983,.4235,.4455,.4652,.4831,.4995,.5149,.5290,.5424, 7055.
7047 2 .5550,.5670,.5783,.5892,.5996,.6096,.6192,.6284,.6374,.6461, 7056.
7048 3 .6544,.6626,.6705,.6781,.6857,.6929,.7000,.7070,.7137,.7204, 7057.
7049 4 .7268,.7331,.7393,.7453,.7512,.7569,.7625,.7680,.7734,.7786, 7058.
7050 5 .7837,.7887,.7936,.7983,.8030,.8075,.8119,.8163,.8205,.8246/ 7059.
7051 C 7060.
7052 DATA C07T05/0.0, 7061.
7053 1 .3963,.4260,.4503,.4714,.4902,.5073,.5228,.5374,.5507,.5634, 7062.
7054 2 .5752,.5864,.5970,.6071,.6168,.6260,.6349,.6434,.6516,.6596, 7063.
7055 3 .6672,.6746,.6818,.6888,.6956,.7022,.7086,.7149,.7210,.7270, 7064.
7056 4 .7328,.7384,.7440,.7494,.7547,.7599,.7650,.7699,.7748,.7796, 7065.
7057 5 .7842,.7887,.7932,.7976,.8018,.8060,.8101,.8141,.8180,.8218/ 7066.
7058 C 7067.
7059 DATA C07T06/0.0, 7068.
7060 1 .4172,.4461,.4696,.4900,.5082,.5246,.5395,.5535,.5662,.5783, 7069.
7061 2 .5895,.6001,.6102,.6198,.6289,.6376,.6460,.6540,.6617,.6691, 7070.
7062 3 .6763,.6832,.6899,.6964,.7028,.7089,.7148,.7206,.7263,.7318, 7071.
7063 4 .7371,.7424,.7475,.7525,.7574,.7622,.7668,.7714,.7759,.7803, 7072.
7064 5 .7846,.7888,.7929,.7969,.8009,.8048,.8086,.8123,.8159,.8195/ 7073.
7065 C 7074.
7066 DATA C07T07/0.0, 7075.
7067 1 .4331,.4613,.4842,.5040,.5216,.5375,.5520,.5654,.5777,.5893, 7076.
7068 2 .6001,.6104,.6200,.6291,.6379,.6462,.6542,.6618,.6691,.6762, 7077.
7069 3 .6830,.6896,.6959,.7021,.7081,.7138,.7194,.7249,.7302,.7354, 7078.
7070 4 .7404,.7453,.7502,.7548,.7594,.7639,.7683,.7726,.7768,.7809, 7079.
7071 5 .7849,.7888,.7927,.7965,.8002,.8038,.8074,.8109,.8143,.8177/ 7080.
7072 C 7081.
7073 DATA C07T08/0.0, 7082.
7074 1 .4455,.4731,.4955,.5148,.5320,.5475,.5616,.5747,.5866,.5979, 7083.
7075 2 .6083,.6182,.6275,.6363,.6448,.6528,.6605,.6678,.6748,.6816, 7084.
7076 3 .6881,.6944,.7005,.7064,.7121,.7176,.7230,.7282,.7332,.7382, 7085.
7077 4 .7430,.7476,.7522,.7566,.7610,.7652,.7694,.7735,.7774,.7813, 7086.
7078 5 .7851,.7889,.7925,.7961,.7996,.8030,.8064,.8097,.8130,.8162/ 7087.
7079 C 7088.
7080 DATA C07T09/0.0, 7089.
7081 1 .4555,.4826,.5046,.5235,.5404,.5555,.5692,.5820,.5936,.6046, 7090.
7082 2 .6147,.6244,.6334,.6420,.6502,.6579,.6654,.6725,.6793,.6859, 7091.
7083 3 .6921,.6982,.7041,.7098,.7153,.7206,.7257,.7308,.7356,.7404, 7092.
7084 4 .7449,.7494,.7538,.7581,.7622,.7663,.7703,.7742,.7780,.7817, 7093.
7085 5 .7853,.7889,.7924,.7958,.7992,.8024,.8057,.8088,.8119,.8150/ 7094.
7086 C 7095.
7087 DATA C07T10/0.0, 7096.
7088 1 .4637,.4903,.5120,.5306,.5471,.5620,.5754,.5879,.5993,.6101, 7097.
7089 2 .6200,.6294,.6382,.6466,.6546,.6621,.6694,.6763,.6829,.6893, 7098.
7090 3 .6954,.7013,.7070,.7125,.7179,.7230,.7280,.7328,.7375,.7421, 7099.
7091 4 .7465,.7509,.7551,.7592,.7632,.7672,.7710,.7747,.7784,.7820, 7100.
7092 5 .7855,.7889,.7923,.7956,.7988,.8020,.8051,.8081,.8111,.8140/ 7101.
7093 C 7102.
7094 DATA C07T99/0.0, 7103.
7095 1 .5366,.5590,.5770,.5924,.6060,.6180,.6289,.6389,.6480,.6565, 7104.
7096 2 .6643,.6717,.6785,.6850,.6912,.6969,.7025,.7077,.7127,.7175, 7105.
7097 3 .7220,.7264,.7306,.7347,.7386,.7423,.7460,.7495,.7529,.7562, 7106.
7098 4 .7594,.7625,.7655,.7684,.7712,.7740,.7767,.7793,.7818,.7843, 7107.
7099 5 .7867,.7891,.7914,.7937,.7959,.7981,.8002,.8022,.8043,.8062/ 7108.
7100 C 7109.
7101 DATA C08T01/0.0, 7110.
7102 1 .1567,.2073,.2493,.2865,.3206,.3522,.3819,.4104,.4374,.4636, 7111.
7103 2 .4886,.5128,.5359,.5580,.5793,.5994,.6188,.6370,.6544,.6710, 7112.
7104 3 .6864,.7013,.7152,.7283,.7410,.7526,.7637,.7742,.7840,.7935, 7113.
7105 4 .8023,.8106,.8185,.8259,.8330,.8396,.8459,.8519,.8576,.8630, 7114.
7106 5 .8680,.8729,.8774,.8818,.8859,.8899,.8936,.8972,.9006,.9038/ 7115.
7107 C 7116.
7108 DATA C08T02/0.0, 7117.
7109 1 .2878,.3342,.3718,.4041,.4329,.4588,.4824,.5045,.5249,.5442, 7118.
7110 2 .5623,.5797,.5962,.6120,.6272,.6417,.6559,.6693,.6823,.6949, 7119.
7111 3 .7069,.7186,.7298,.7405,.7509,.7606,.7701,.7792,.7879,.7963, 7120.
7112 4 .8042,.8118,.8191,.8260,.8327,.8390,.8451,.8509,.8564,.8617, 7121.
7113 5 .8667,.8716,.8762,.8806,.8848,.8888,.8926,.8963,.8998,.9032/ 7122.
7114 C 7123.
7115 DATA C08T03/0.0, 7124.
7116 1 .3656,.4087,.4432,.4725,.4984,.5215,.5422,.5614,.5789,.5954, 7125.
7117 2 .6106,.6251,.6387,.6517,.6641,.6758,.6872,.6981,.7085,.7187, 7126.
7118 3 .7283,.7378,.7468,.7555,.7641,.7722,.7801,.7878,.7951,.8022, 7127.
7119 4 .8091,.8157,.8221,.8282,.8342,.8399,.8454,.8507,.8558,.8608, 7128.
7120 5 .8655,.8700,.8744,.8786,.8826,.8865,.8903,.8939,.8973,.9006/ 7129.
7121 C 7130.
7122 DATA C08T04/0.0, 7131.
7123 1 .4167,.4573,.4895,.5167,.5405,.5616,.5805,.5979,.6136,.6283, 7132.
7124 2 .6419,.6547,.6668,.6781,.6890,.6992,.7091,.7184,.7274,.7361, 7133.
7125 3 .7444,.7525,.7602,.7677,.7750,.7820,.7888,.7954,.8018,.8080, 7134.
7126 4 .8139,.8197,.8254,.8308,.8361,.8412,.8462,.8510,.8556,.8601, 7135.
7127 5 .8645,.8687,.8728,.8767,.8805,.8842,.8877,.8912,.8945,.8977/ 7136.
7128 C 7137.
7129 DATA C08T05/0.0, 7138.
7130 1 .4528,.4913,.5218,.5473,.5696,.5893,.6069,.6230,.6375,.6511, 7139.
7131 2 .6635,.6752,.6862,.6965,.7063,.7156,.7245,.7329,.7409,.7487, 7140.
7132 3 .7561,.7633,.7703,.7769,.7834,.7896,.7957,.8015,.8072,.8127, 7141.
7133 4 .8180,.8232,.8283,.8332,.8379,.8426,.8470,.8514,.8556,.8598, 7142.
7134 5 .8638,.8677,.8714,.8751,.8787,.8821,.8855,.8887,.8919,.8950/ 7143.
7135 C 7144.
7136 DATA C08T06/0.0, 7145.
7137 1 .4795,.5164,.5454,.5697,.5909,.6095,.6261,.6412,.6548,.6675, 7146.
7138 2 .6791,.6901,.7003,.7098,.7190,.7275,.7357,.7435,.7509,.7581, 7147.
7139 3 .7648,.7714,.7778,.7838,.7898,.7954,.8009,.8063,.8115,.8165, 7148.
7140 4 .8214,.8261,.8307,.8352,.8395,.8437,.8479,.8519,.8558,.8596, 7149.
7141 5 .8633,.8669,.8704,.8738,.8772,.8804,.8836,.8866,.8896,.8925/ 7150.
7142 C 7151.
7143 DATA C08T07/0.0, 7152.
7144 1 .5000,.5356,.5635,.5868,.6070,.6248,.6406,.6550,.6679,.6800, 7153.
7145 2 .6909,.7013,.7109,.7199,.7285,.7365,.7442,.7515,.7584,.7651, 7154.
7146 3 .7715,.7776,.7835,.7892,.7947,.7999,.8051,.8100,.8148,.8195, 7155.
7147 4 .8240,.8284,.8327,.8368,.8408,.8448,.8486,.8523,.8560,.8595, 7156.
7148 5 .8630,.8663,.8696,.8728,.8759,.8790,.8820,.8849,.8877,.8905/ 7157.
7149 C 7158.
7150 DATA C08T08/0.0, 7159.
7151 1 .5162,.5507,.5777,.6002,.6197,.6368,.6519,.6657,.6781,.6896, 7160.
7152 2 .7001,.7100,.7191,.7277,.7359,.7435,.7508,.7577,.7643,.7706, 7161.
7153 3 .7766,.7824,.7880,.7933,.7986,.8035,.8083,.8130,.8175,.8219, 7162.
7154 4 .8261,.8302,.8343,.8381,.8419,.8456,.8492,.8527,.8561,.8595, 7163.
7155 5 .8627,.8659,.8690,.8720,.8750,.8778,.8806,.8834,.8861,.8887/ 7164.
7156 C 7165.
7157 DATA C08T09/0.0, 7166.
7158 1 .5293,.5629,.5891,.6109,.6298,.6464,.6610,.6743,.6862,.6974, 7167.
7159 2 .7074,.7169,.7257,.7340,.7418,.7491,.7561,.7627,.7690,.7750, 7168.
7160 3 .7807,.7863,.7916,.7967,.8016,.8063,.8109,.8154,.8196,.8238, 7169.
7161 4 .8278,.8317,.8356,.8392,.8428,.8463,.8497,.8531,.8563,.8595, 7170.
7162 5 .8625,.8656,.8685,.8714,.8742,.8769,.8796,.8822,.8847,.8872/ 7171.
7163 C 7172.
7164 DATA C08T10/0.0, 7173.
7165 1 .5401,.5729,.5985,.6197,.6381,.6542,.6684,.6813,.6929,.7036, 7174.
7166 2 .7134,.7226,.7311,.7390,.7466,.7536,.7604,.7667,.7728,.7786, 7175.
7167 3 .7841,.7894,.7945,.7994,.8042,.8087,.8131,.8173,.8214,.8254, 7176.
7168 4 .8292,.8330,.8366,.8401,.8436,.8469,.8502,.8534,.8564,.8595, 7177.
7169 5 .8624,.8653,.8681,.8708,.8735,.8761,.8787,.8812,.8836,.8860/ 7178.
7170 C 7179.
7171 DATA C08T99/0.0, 7180.
7172 1 .6384,.6631,.6821,.6978,.7111,.7227,.7328,.7420,.7501,.7576, 7181.
7173 2 .7644,.7707,.7765,.7819,.7870,.7918,.7963,.8005,.8045,.8084, 7182.
7174 3 .8120,.8154,.8187,.8219,.8250,.8278,.8307,.8334,.8360,.8385, 7183.
7175 4 .8409,.8432,.8455,.8477,.8498,.8519,.8539,.8559,.8578,.8596, 7184.
7176 5 .8614,.8632,.8648,.8665,.8681,.8697,.8712,.8728,.8742,.8757/ 7185.
7177 C 7186.
7178 DATA C09T01/0.0, 7187.
7179 1 .1702,.2523,.3168,.3712,.4193,.4625,.5020,.5390,.5729,.6050, 7188.
7180 2 .6344,.6620,.6873,.7108,.7325,.7520,.7703,.7867,.8017,.8157, 7189.
7181 3 .8281,.8397,.8502,.8597,.8687,.8766,.8840,.8908,.8970,.9028, 7190.
7182 4 .9080,.9129,.9174,.9216,.9254,.9290,.9324,.9355,.9384,.9411, 7191.
7183 5 .9436,.9460,.9482,.9502,.9522,.9540,.9557,.9574,.9589,.9603/ 7192.
7184 C 7193.
7185 DATA C09T02/0.0, 7194.
7186 1 .3174,.3895,.4438,.4879,.5256,.5583,.5872,.6136,.6374,.6597, 7195.
7187 2 .6802,.6995,.7175,.7345,.7506,.7655,.7798,.7930,.8055,.8173, 7196.
7188 3 .8281,.8385,.8481,.8570,.8655,.8731,.8804,.8872,.8935,.8994, 7197.
7189 4 .9049,.9099,.9148,.9191,.9233,.9271,.9307,.9341,.9373,.9402, 7198.
7190 5 .9430,.9456,.9480,.9503,.9524,.9544,.9563,.9581,.9598,.9613/ 7199.
7191 C 7200.
7192 DATA C09T03/0.0, 7201.
7193 1 .4078,.4729,.5209,.5592,.5915,.6191,.6431,.6649,.6842,.7022, 7202.
7194 2 .7185,.7339,.7481,.7614,.7741,.7859,.7972,.8078,.8178,.8274, 7203.
7195 3 .8364,.8451,.8532,.8608,.8682,.8750,.8815,.8877,.8934,.8989, 7204.
7196 4 .9040,.9089,.9135,.9177,.9218,.9256,.9292,.9326,.9358,.9388, 7205.
7197 5 .9416,.9443,.9468,.9491,.9514,.9535,.9554,.9573,.9591,.9607/ 7206.
7198 C 7207.
7199 DATA C09T04/0.0, 7208.
7200 1 .4692,.5288,.5723,.6066,.6353,.6597,.6807,.6997,.7163,.7318, 7209.
7201 2 .7457,.7588,.7708,.7821,.7927,.8026,.8121,.8210,.8295,.8376, 7210.
7202 3 .8452,.8525,.8595,.8661,.8724,.8784,.8841,.8896,.8948,.8998, 7211.
7203 4 .9044,.9089,.9132,.9172,.9210,.9247,.9281,.9314,.9345,.9374, 7212.
7204 5 .9402,.9429,.9453,.9477,.9500,.9521,.9541,.9560,.9579,.9596/ 7213.
7205 C 7214.
7206 DATA C09T05/0.0, 7215.
7207 1 .5136,.5690,.6090,.6404,.6666,.6886,.7076,.7246,.7394,.7532, 7216.
7208 2 .7655,.7771,.7877,.7976,.8069,.8156,.8239,.8316,.8390,.8461, 7217.
7209 3 .8528,.8592,.8653,.8711,.8767,.8820,.8871,.8920,.8967,.9012, 7218.
7210 4 .9054,.9095,.9134,.9171,.9207,.9241,.9274,.9305,.9335,.9363, 7219.
7211 5 .9390,.9416,.9440,.9464,.9486,.9507,.9527,.9546,.9565,.9582/ 7220.
7212 C 7221.
7213 DATA C09T06/0.0, 7222.
7214 1 .5473,.5993,.6366,.6658,.6900,.7102,.7277,.7432,.7568,.7693, 7223.
7215 2 .7805,.7910,.8006,.8095,.8179,.8257,.8332,.8401,.8468,.8531, 7224.
7216 3 .8591,.8648,.8703,.8755,.8806,.8853,.8899,.8944,.8986,.9027, 7225.
7217 4 .9066,.9103,.9140,.9174,.9207,.9239,.9270,.9299,.9327,.9354, 7226.
7218 5 .9380,.9405,.9429,.9451,.9473,.9494,.9514,.9533,.9551,.9568/ 7227.
7219 C 7228.
7220 DATA C09T07/0.0, 7229.
7221 1 .5737,.6230,.6581,.6855,.7081,.7271,.7433,.7577,.7703,.7819, 7230.
7222 2 .7922,.8019,.8107,.8189,.8266,.8338,.8406,.8470,.8530,.8588, 7231.
7223 3 .8643,.8695,.8745,.8793,.8839,.8883,.8925,.8966,.9004,.9042, 7232.
7224 4 .9078,.9113,.9146,.9178,.9209,.9239,.9268,.9295,.9322,.9348, 7233.
7225 5 .9372,.9396,.9419,.9441,.9462,.9482,.9502,.9520,.9538,.9555/ 7234.
7226 C 7235.
7227 DATA C09T08/0.0, 7236.
7228 1 .5950,.6420,.6754,.7013,.7226,.7405,.7557,.7693,.7811,.7919, 7237.
7229 2 .8016,.8106,.8188,.8265,.8337,.8403,.8466,.8525,.8582,.8635, 7238.
7230 3 .8686,.8734,.8781,.8825,.8868,.8908,.8947,.8985,.9021,.9056, 7239.
7231 4 .9089,.9121,.9153,.9183,.9212,.9240,.9267,.9293,.9318,.9343, 7240.
7232 5 .9366,.9389,.9411,.9432,.9452,.9472,.9490,.9509,.9526,.9543/ 7241.
7233 C 7242.
7234 DATA C09T09/0.0, 7243.
7235 1 .6125,.6576,.6894,.7142,.7345,.7514,.7659,.7787,.7899,.8001, 7244.
7236 2 .8093,.8177,.8255,.8327,.8394,.8457,.8516,.8572,.8624,.8675, 7245.
7237 3 .8722,.8767,.8811,.8852,.8892,.8930,.8966,.9002,.9035,.9068, 7246.
7238 4 .9100,.9130,.9159,.9187,.9215,.9241,.9267,.9292,.9316,.9339, 7247.
7239 5 .9361,.9383,.9404,.9424,.9443,.9462,.9481,.9498,.9515,.9532/ 7248.
7240 C 7249.
7241 DATA C09T10/0.0, 7250.
7242 1 .6272,.6706,.7012,.7249,.7443,.7605,.7743,.7866,.7972,.8069, 7251.
7243 2 .8156,.8236,.8310,.8378,.8442,.8501,.8558,.8610,.8660,.8708, 7252.
7244 3 .8752,.8795,.8836,.8875,.8913,.8949,.8983,.9016,.9048,.9079, 7253.
7245 4 .9109,.9137,.9165,.9192,.9218,.9243,.9267,.9291,.9314,.9336, 7254.
7246 5 .9357,.9378,.9398,.9417,.9436,.9454,.9472,.9489,.9506,.9522/ 7255.
7247 C 7256.
7248 DATA C09T99/0.0, 7257.
7249 1 .7681,.7934,.8109,.8243,.8350,.8439,.8514,.8579,.8636,.8687, 7258.
7250 2 .8732,.8774,.8812,.8847,.8880,.8910,.8938,.8964,.8989,.9013, 7259.
7251 3 .9035,.9056,.9076,.9095,.9113,.9130,.9147,.9163,.9178,.9193, 7260.
7252 4 .9207,.9221,.9234,.9247,.9260,.9271,.9283,.9294,.9305,.9316, 7261.
7253 5 .9326,.9336,.9346,.9355,.9364,.9373,.9382,.9390,.9398,.9406/ 7262.
7254 C 7263.
7255 C 7264.
7256 C ---------------------------------------------------------------- 7265.
7257 C COSBAR ADJUSTMENT TO REPRODUCE THE SOLAR ZENITH ANGLE DEPENDENCE 7266.
7258 C FOR CLOUD ALBEDOS FOR OPTICAL THICKNESS FROM (1.0 < TAU < 99.0) 7267.
7259 C ---------------------------------------------------------------- 7268.
7260 C 7269.
7261 C 7270.
7262 C ------------------------------------------- 7271.
7263 C XMU (COSZ) SOLAR ZENITH ANGLE INTERPOLATION 7272.
7264 C DATA INTERVAL: 0.02 ON (0.0 < XMU < 1.0) 7273.
7265 C ------------------------------------------- 7274.
7266 C 7275.
7267 XI=XMU*50.0+0.9999 7276.
7268 IX=XI 7277.
7269 IF(IX.LT.1) IX=1 7278.
7270 JX=IX+1 7279.
7271 WXJ=XI-IX 7280.
7272 WXI=1.0-WXJ 7281.
7273 C 7282.
7274 C ----------------------- 7283.
7275 C CLOUD TAU INTERPOLATION 7284.
7276 C 1.0 OVER (1 < TAU < 10) 7285.
7277 C LINEAR (10 < TAU < 100) 7286.
7278 C ----------------------- 7287.
7279 C 7288.
7280 TI=TAU 7289.
7281 IT=TI 7290.
7282 IF(IT.LT.1) IT=1 7291.
7283 WTJ=TI-IT 7292.
7284 IF(IT.GT.9) THEN 7293.
7285 WTJ=(TAU-10.0)/90.0 7294.
7286 IT=10 7295.
7287 ENDIF 7296.
7288 WTI=1.0-WTJ 7297.
7289 JT=IT+1 7298.
7290 C 7299.
7291 C ------------------------------- 7300.
7292 C COSBAR DEPENDENCE INTERPOLATION 7301.
7293 C 0.10 ON (0.5 < COSBAR < 0.9) 7302.
7294 C LINEAR FOR (0.0 < COSBAR < 0.5) 7303.
7295 C ------------------------------- 7304.
7296 C 7305.
7297 GI=G*10.0 7306.
7298 IF(GI.GT.5.0) GO TO 110 7307.
7299 JG=1 7308.
7300 GG=G*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7309.
7301 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7310.
7302 GG=GG+GG 7311.
7303 GO TO 130 7312.
7304 C 7313.
7305 110 IG=GI 7314.
7306 WGJ=GI-IG 7315.
7307 WGI=1.0-WGJ 7316.
7308 IG=IG-4 7317.
7309 JG=IG+1 7318.
7310 IF(IG.GT.4) GO TO 120 7319.
7311 C 7320.
7312 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7321.
7313 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7322.
7314 + +WGJ*(WTI*(WXI*GTAU(IX,IT,JG)+WXJ*GTAU(JX,IT,JG)) 7323.
7315 + + WTJ*(WXI*GTAU(IX,JT,JG)+WXJ*GTAU(JX,JT,JG))) 7324.
7316 GO TO 130 7325.
7317 C 7326.
7318 120 IG=5 7327.
7319 C 7328.
7320 GG=WGI*(WTI*(WXI*GTAU(IX,IT,IG)+WXJ*GTAU(JX,IT,IG)) 7329.
7321 + + WTJ*(WXI*GTAU(IX,JT,IG)+WXJ*GTAU(JX,JT,IG))) 7330.
7322 + +WGJ 7331.
7323 C 7332.
7324 130 CONTINUE 7333.
7325 C 7334.
7326 RETURN 7335.
7327 END 7336.
  ViewVC Help
Powered by ViewVC 1.1.22