PROGRAM READTAPE C C SOLAR FLUX ATLAS BY KURUCZ, FURENLID, BRAULT, AND TESTERMAN C C USE THIS PROGRAM AS A GUIDE TO CONVERTING THE DATA TO WHATEVER FORM C YOU REQUIRE. THIS PROGRAM READS TWO FILES, FIRST RESIDUAL FLUX, C WAVELENGTH PAIRS, AND SECOND, RESIDUAL FLUX INTERPOLATED TO UNIFORM C POINT SPACING. THERE IS CODE FOR CONVERTING FROM RESIDUAL FLUX TO C IRRADIANCE THAT CAN BE COMMENTED OUT. INTEGER*4 II(2,1138000) INTEGER*2 IR(1508000),IR10(150800) REAL*8 W C 78 N=1137795 READ(11,1)II 1 FORMAT(I6,I10,I6,I10,I6,I10,I6,I10,I6,I10) DO 4 I=1,N C W IS WAVELENGTH IN NM W=II(2,I)*1.D-6 C R IS PSEUDO-RESIDUAL FLUX R=II(1,I)*1.E-5 C C CALIB COMPUTES FACTOR TO CONVERT FROM PSEUDO-RESIDUAL FLUX TO C IRRADIANCE IN MICROW/CM**2/NM C COMMENT IT OUT IF NOT REQUIRED WAVE=W F=R*CALIB(WAVE) IF(MOD(I,1000).EQ.1)PRINT 2,I,II(2,I),W,II(1,I),R,F 2 FORMAT(I10,I12,F12.5,I10,F12.7,F10.2) WRITE(12)W,R 4 CONTINUE PRINT 2,N,II(2,N),W,II(1,N),R,F C C SECOND VERSION INTERPOLATED TO UNIFORM POINT SPACING 6 READ(11,7)IR 7 FORMAT(20I4) C C 4 POINTS WERE TRUNCATED FROM 10000 TO 9999 TO ALLOW AN I4 FORMAT C IF THIS MATTERS TO YOU, KEEP THE FOLLOWING CODE IR(45834)=10000 IR(300815)=10000 IR(300816)=10000 IR(300817)=10000 WRITE(13)IR C C SAMPLE POINTS DO 9 I=1,1508000,1000 IF(I.LE.1008000)W=296.D0+.0005D0*DFLOAT(I) IF(I.GT.1008000)W=800.D0+.001D0*DFLOAT(I-1008000) R=FLOAT(IR(I))*.0001 WAVE=W F=R*CALIB(WAVE) PRINT 8,I,W,IR(I),R,F 8 FORMAT(I10,F10.4,I6,F10.4,F10.2) 9 CONTINUE I=1508000 W=800.D0+.001D0*DFLOAT(I-1008000) R=FLOAT(IR(I))*.0001 WAVE=W F=R*CALIB(WAVE) PRINT 8,I,W,IR(I),R,F C C THIRD VERSION DEGRADED BY A FACTOR OF 10 AND INTERPOLATED TO UNIFORM C POINT SPACING READ(11,7)IR10 WRITE(14)IR10 C C SAMPLE POINTS DO 19 I=1,150800,1000 IF(I.LE.100800)W=296.D0+.005D0*DFLOAT(I) IF(I.GT.100800)W=800.D0+.01D0*DFLOAT(I-100800) R=FLOAT(IR10(I))*.0001 WAVE=W F=R*CALIB(WAVE) PRINT 8,I,W,IR10(I),R,F 19 CONTINUE I=150800 W=800.D0+.01D0*DFLOAT(I-100800) R=FLOAT(IR10(I))*.0001 WAVE=W F=R*CALIB(WAVE) PRINT 8,I,W,IR10(I),R,F CALL EXIT END FUNCTION CALIB(WAVE) C COMPUTES FACTOR TO CONVERT FROM PSEUDO-RESIDUAL FLUX TO C IRRADIANCE IN MICROW/CM**2/NM DIMENSION TAB(3,191) DIMENSION TAB1(3,17),TAB2(3,27),TAB3(3,27),TAB4(3,27) DIMENSION TAB5(3,27),TAB6(3,27),TAB7(3,27),TAB8(3,12) EQUIVALENCE (TAB(1),TAB1(1)),(TAB(52),TAB2(1)) EQUIVALENCE (TAB(133),TAB3(1)),(TAB(214),TAB4(1)) EQUIVALENCE (TAB(295),TAB5(1)),(TAB(376),TAB6(1)) EQUIVALENCE (TAB(457),TAB7(1)),(TAB(538),TAB8(1)) DATA TAB1/ 1 296.000,123.34,.0000, 298.000,111.44,.0000, 300.000, 97.61,.0000, 2 302.000,102.51,.0000, 304.000,119.21,.0000, 306.000,119.57,.0000, 3 308.000,115.37,.0000, 310.000,116.91,.0000, 312.000,129.58,.0000, 4 314.000,138.65,.0000, 316.000,142.42,.0000, 318.000,136.50,.0000, 5 320.000,139.53,.0000, 322.000,167.63,.0000, 324.000,121.92,.0000, 6 326.000,125.03,.0000, 328.000,161.34,.0000/ DATA TAB2/ 1 329.815,155.56,.0000, 331.765,156.09,.0000, 333.795,157.21,.0000, 2 335.855,160.69,.0000, 337.865,161.35,.0000, 339.825,158.82,.0000, 3 341.865,158.14,.0000, 343.795,158.19,.0000, 345.825,155.74,.0000, 4 347.855,159.21,.0000, 349.815,159.21,.0000, 351.855,164.86,.0000, 5 353.895,169.08,.0000, 355.905,173.01,.0000, 357.935,174.85,.0000, 6 359.955,180.75,.0000, 362.015,183.10,.0000, 364.055,186.14,.0000, 7 366.105,187.34,.0000, 367.775,187.19,.0000, 369.825,187.64,.0000, 8 371.865,193.15,.0000, 373.665,197.29,.0000, 375.475,197.80,.0000, 9 377.525,199.27,.0000, 379.435,200.20,.0000, 381.395,204.89,.0000/ DATA TAB3/ 1 383.355,207.44,.0000, 385.375,209.78,.0000, 387.375,208.95,.0000, 2 389.415,213.99,.0000, 391.195,215.25,.0000, 393.245,217.98,.0000, 3 395.025,221.64,.0000, 396.925,219.33,.0000, 398.925,224.29,.0000, 4 400.105,227.94,.0000, 402.000,228.28,.0000, 404.000,230.92,.0000, 5 406.000,232.82,.0000, 407.880,233.22,.0000, 409.880,231.45,.0000, 6 411.710,234.13,.0000, 413.710,233.55,.0000, 415.650,232.98,.0000, 7 417.590,233.26,.0000, 419.120,232.91,.0000, 421.120,239.22,.0000, 8 423.100,239.04,.0000, 424.750,240.13,.0000, 426.790,239.14,.0000, 9 428.640,238.32,.0000, 430.640,236.36,.0000, 432.640,237.09,.0000/ DATA TAB4/ 1 433.970,236.22,.0000, 435.920,235.28,.0000, 437.190,236.67,.0000, 2 439.190,237.31,.0000, 440.900,236.01,.0000, 442.800,238.76,.0000, 3 444.720,238.11,.0000, 446.400,235.11,.0000, 448.320,236.05,.0000, 4 450.320,238.75,.0000, 452.360,237.91,.0000, 454.360,237.82,.0000, 5 456.360,234.98,.0000, 458.370,233.07,.0000, 460.370,231.87,.0000, 6 462.360,232.08,.0000, 464.360,228.29,.0000, 466.360,227.89,.0000, 7 468.350,228.61,.0000, 470.350,226.90,.0000, 472.330,225.19,.0000, 8 474.330,224.81,.0000, 476.330,224.38,.0000, 478.330,224.33,.0000, 9 480.330,222.81,.0000, 482.330,221.91,.0000, 484.310,222.78,.0000/ DATA TAB5/ 1 486.310,222.61,.0000, 488.310,219.39,.0000, 489.290,219.66,.0000, 2 491.290,219.63,.0000, 493.290,219.02,.0000, 495.150,219.91,.0000, 3 497.070,218.44,.0000, 498.890,218.79,.0000, 500.890,218.37,.0000, 4 502.890,217.24,.0000, 504.890,217.42,.0000, 506.830,216.53,.0000, 5 508.830,216.75,.0000, 510.830,215.12,.0000, 512.830,213.17,.0000, 6 514.830,212.45,.0000, 516.830,211.31,.0000, 518.830,211.27,.0000, 7 519.950,210.53,.0000, 521.930,211.71,.0000, 523.880,209.39,.0000, 8 525.800,207.98,.0000, 527.800,209.29,.0000, 529.800,209.79,.0000, 9 531.650,207.97,.0000, 533.520,205.97,.0000, 535.390,205.09,.0000/ DATA TAB6/ 1 537.200,202.60,.0000, 539.150,201.96,.0000, 541.000,201.64,.0003, 2 543.000,204.09,.0003, 545.000,203.06,.0004, 547.000,201.30,.0002, 3 549.000,199.93,.0000, 550.800,199.35,.0000, 552.730,197.99,.0000, 4 554.700,197.55,.0000, 556.690,196.22,.0000, 558.690,197.12,.0000, 5 560.690,195.76,.0000, 562.690,196.67,.0000, 564.600,195.72,.0000, 6 566.600,196.57,.0001, 568.600,196.72,.0011, 570.600,195.22,.0008, 7 572.600,195.93,.0010, 574.600,194.86,.0010, 576.600,194.31,.0013, 8 578.450,194.71,.0012, 580.450,193.15,.0012, 582.450,191.47,.0010, 9 584.450,190.52,.0005, 586.450,188.01,.0011, 588.400,190.17,.0058/ DATA TAB7/ 1 590.370,187.54,.0049, 592.350,187.10,.0030, 594.350,186.24,.0034, 2 596.350,185.45,.0027, 598.300,182.71,.0018, 600.300,180.89,.0017, 3 602.300,180.37,.0009, 604.300,179.54,.0002, 606.300,178.92,.0000, 4 608.000,178.78,.0000, 610.000,179.43,.0000, 612.000,180.60,.0000, 5 614.000,179.34,.0000, 616.000,179.37,.0000, 618.000,178.80,.0000, 6 620.000,177.40,.0000, 621.970,175.80,.0000, 623.900,175.55,.0000, 7 625.900,174.77,.0001, 627.900,178.10,.0250, 629.900,174.06,.0158, 8 631.900,173.36,.0039, 633.900,172.07,.0008, 635.900,171.74,.0008, 9 637.900,169.01,.0003, 639.900,169.23,.0004, 641.900,166.92,.0002/ DATA TAB8/ 1 643.900,167.32,.0005, 645.900,167.67,.0009, 647.900,166.30,.0012, 2 649.900,164.87,.0016, 651.900,164.55,.0017, 653.900,164.60,.0022, 3 655.900,161.76,.0021, 662.100,159.72,.0002, 666.300,158.42,.0003, 4 679.000,150.01,.0001, 709.000,142.34,.0013, 746.500,131.64,.0000/ DATA IOLD/2/,OLDWAVE/0./,ISTART/0/ IF(ISTART.EQ.1)GO TO 5 C APPROXIMATE CORRECTION FOR ATMOSPHERIC BLOCKING DO 3 I=1,191 3 TAB(2,I)=TAB(2,I)*(1.-TAB(3,I)) ISTART=1 5 IF(WAVE.LT.746.5)GO TO 10 C ASSUME VALID TO 1300 CALIB=.80933E18/WAVE**5/(EXP(1.4384E7/WAVE/ 1(6892.094-2.691159*WAVE+.001669325*WAVE**2))-1.) RETURN 10 IF(WAVE.LT.OLDWAVE)IOLD=2 DO 20 I=IOLD,191 IF(WAVE.LT.TAB(1,I))GO TO 30 20 CONTINUE 30 IOLD=I OLDWAVE=WAVE CALIB=TAB(2,I-1)+(TAB(2,I)-TAB(2,I-1))/(TAB(1,I)-TAB(1,I-1))* 1(WAVE-TAB(1,I-1)) RETURN END FUNCTION AIRVAC(W) C CONVERTS AIR WAVELENGTHS TO VACUUM IMPLICIT REAL*8 (A-H,O-Z) C W IS AIR WAVELENGTH IN NM C WAVEN IS AIR WAVENUMBER WHICH IS USUALLY GOOD ENOUGH C MUST ITERATE FOR EXACT SOLUTION WAVEN=1.D7/W WNEW=W*(1.0000834213D0+ 1 2406030.D0/(1.30D10-WAVEN**2)+15997.D0/(3.89D9-WAVEN**2)) WAVEN=1.D7/WNEW WNEW=W*(1.0000834213D0+ 1 2406030.D0/(1.30D10-WAVEN**2)+15997.D0/(3.89D9-WAVEN**2)) WAVEN=1.D7/WNEW AIRVAC=W*(1.0000834213D0+ 1 2406030.D0/(1.30D10-WAVEN**2)+15997.D0/(3.89D9-WAVEN**2)) RETURN END FUNCTION VACAIR(W) C CONVERTS VACUUM WAVELENGTHS TO AIR IMPLICIT REAL*8 (A-H,O-Z) C W IS VACUUM WAVELENGTH IN NM WAVEN=1.E7/W VACAIR=W/(1.0000834213D0+ 1 2406030.D0/(1.30D10-WAVEN**2)+15997.D0/(3.89D9-WAVEN**2)) C 1(1.000064328+2949810./(1.46E10-WAVEN**2)+25540./(4.1E9-WAVEN**2)) RETURN END