! SUBROUTINE SSFLUX (ISCALE, F107, F107A, HLYBR, FEXVIR, HLYA, > HEIEW, XUVFAC, WAVE1, WAVE2, SFLUX) implicit none integer,parameter :: lmax=59 ! ! Args: integer,intent(in) :: iscale real,intent(in) :: f107,f107a,hlybr,fexvir,hlya,heiew,xuvfac real,intent(out) :: wave1(lmax),wave2(lmax),sflux(lmax) ! ! Local: real :: > WAVEL(LMAX), WAVES(LMAX), RFLUX(LMAX), XFLUX(LMAX), > SCALE1(LMAX), SCALE2(LMAX), > TCHR0(LMAX), TCHR1(LMAX), TCHR2(LMAX), > TCOR0(LMAX), TCOR1(LMAX), TCOR2(LMAX), > WAR1(LMAX), WAR2(LMAX), > B1(3), B2(3) real :: frat,r1,r2,hlymod,heimod,xuvf integer :: l C C regression coefficients which reduce to solar min. spectrum: DATA B1/1.0, 0.0138, 0.005/, B2/1.0, 0.59425, 0.3811/ C C 'best fit' regression coefficients, commented out, for reference: C DATA B1/1.31, 0.01106, 0.00492/, B2/-6.618, 0.66159, 0.38319/ C C DATA WAVEL/ 1750.00, 1700.00, 1650.00, 1600.00, 1550.00, 1500.00, > 1450.00, 1400.00, 1350.00, 1300.00, 1250.00, 1215.67, > 1200.00, 1150.00, 1100.00, 1050.00, 1031.91, 1025.72, > 1000.00, 977.02, 950.00, 900.00, 850.00, 800.00, > 789.36, 770.41, 765.15, 750.00, 703.31, 700.00, > 650.00, 629.73, 609.76, 600.00, 584.33, 554.37, > 550.00, 500.00, 465.22, 450.00, 400.00, 368.07, > 350.00, 303.78, 303.31, 300.00, 284.15, 256.30, > 250.00, 200.00, 150.00, 100.00, 50.00, 32.00, > 23.00, 16.00, 8.00, 4.00, 2.00/ DATA WAVES/ 1700.00, 1650.00, 1600.00, 1550.00, 1500.00, 1450.00, > 1400.00, 1350.00, 1300.00, 1250.00, 1200.00, 1215.67, > 1150.00, 1100.00, 1050.00, 1000.00, 1031.91, 1025.72, > 950.00, 977.02, 900.00, 850.00, 800.00, 750.00, > 789.36, 770.41, 765.15, 700.00, 703.31, 650.00, > 600.00, 629.73, 609.76, 550.00, 584.33, 554.37, > 500.00, 450.00, 465.22, 400.00, 350.00, 368.07, > 300.00, 303.78, 303.31, 250.00, 284.15, 256.30, > 200.00, 150.00, 100.00, 50.00, 32.00, 23.00, > 16.00, 8.00, 4.00, 2.00, 1.00/ DATA RFLUX/ 322.00, 168.00, 95.00, 62.00, 44.00, 25.00, > 16.90, 11.80, 19.50, 4.10, 11.10, 249.00, > 2.78, 0.70, 3.07, 3.64, 3.18, 4.38, > 1.78, 5.96, 4.22, 4.43, 1.93, 0.87, > 0.79, 0.24, 0.20, 0.17, 0.39, 0.22, > 0.17, 1.50, 0.45, 0.48, 1.58, 0.80, > 0.51, 0.31, 0.18, 0.39, 0.21, 0.74, > 0.87, 6.00, 0.24, 0.84, 0.10, 0.27, > 0.92, 1.84, 0.13, 0.38, 0.0215, 0.0067, > 1.E-3, 2.E-3, 1.E-5, 5.E-8, 1.E-10/ DATA XFLUX/ 354.00, 191.00, 110.00, 76.00, 55.00, 28.00, > 19.60, 14.30, 25.30, 5.00, 17.20, 401.00, > 6.26, 1.51, 6.11, 8.66, 9.04, 13.12, > 4.42, 13.18, 12.03, 13.29, 5.01, 2.18, > 1.59, 0.67, 0.43, 0.43, 0.72, 0.46, > 0.48, 3.02, 1.46, 1.02, 4.86, 1.59, > 1.57, 1.67, 0.36, 0.99, 2.20, 1.39, > 5.63, 11.28, 2.50, 4.14, 3.16, 0.59, > 3.70, 4.85, 0.34, 1.15, 0.18, 0.08, > 2.5E-2, 5.E-2, 8.E-4, 3.E-5, 5.E-7/ DATA SCALE1/ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 1692.09, 405.95, 1516.20, 2731.70, 3314.57, 4375.00, > 1316.91, 3621.91, 3908.56, 4432.54, 1541.21, 531.73, > 364.83, 0.00, 116.00, 129.41, 162.48, 94.07, > 41.29, 709.50, 0.00, 268.47, 1561.05, 367.64, > 290.06, 184.36, 0.00, 86.15, 7.50, 0.00, > 0.00, 2220.00, 0.00, 61.00, 0.00, 86.95, > 206.00, 135.89, 60.35, 157.12, 7.06, 0.75, > 0.00, 0.00, 0.00, 0.00, 0.00/ DATA SCALE2/ 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 5.34, 0.00, 0.00, 0.00, 0.54, > 3.30, 0.00, 12.60, 0.00, 0.00, 0.00, > 5.34, 11.63, 2.28, 5.56, 24.93, 8.16, > 60.69, 0.00, 28.20, 45.90, 40.80, 1.27, > 35.47, 42.80, 1.12, 6.19, 1.26, 0.69, > 0.23, 0.46, 7.6E-3, 2.9E-4, 4.8E-6/ DATA TCHR0/ > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0,-4.290E+00,-5.709E+00,-8.493E+00, >-1.161E+00,-3.429E+00,-5.464E+00,-6.502E+00,-1.912E+00,-4.034E-01, >-1.448E-01, 0.000E+00,-9.702E-02,-6.591E-02,-2.338E-02,-1.273E-01, >-2.406E-01,-3.351E-01, 0.000E+00,-1.465E+00,-2.405E+00,-7.975E-02, >-4.197E-01,-1.971E-01, 0.000E+00,-5.895E-02,-5.815E-03, 0.000E+00, > 0.000E+00, 2.138E-01, 0.000E+00,-7.713E-02, 0.000E+00,-3.035E-02, >-2.039E-01,-1.749E-01,-1.041E-01,-2.638E-01,-1.094E-02, 0.000E+00, > 0.0, 0.0, 0.0, 0.0, 0.0/ DATA TCHR1/ > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0,-3.023E-13,-3.745E-13,-5.385E-13, >-1.211E-13,-3.868E-13,-3.646E-13,-4.125E-13,-1.527E-13,-4.753E-14, >-3.411E-14, 0.000E+00,-1.190E-14,-1.034E-14,-1.343E-14,-1.539E-14, >-5.174E-14,-6.934E-14, 0.000E+00,-1.215E-13,-1.537E-13,-2.024E-14, >-4.596E-14,-1.562E-14, 0.000E+00,-1.221E-14,-1.123E-15, 0.000E+00, > 0.000E+00,-2.263E-13, 0.000E+00,-1.508E-14, 0.000E+00,-1.744E-14, >-2.100E-14,-1.805E-14,-8.224E-15,-1.919E-14,-7.944E-16, 0.000E+00, > 0.0, 0.0, 0.0, 0.0, 0.0/ DATA TCHR2/ > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 3.275E-11, 4.057E-11, 6.160E-11, > 1.312E-11, 4.189E-11, 4.167E-11, 4.716E-11, 1.654E-11, 5.150E-12, > 3.901E-12, 0.000E+00, 1.289E-12, 1.120E-12, 1.455E-12, 1.667E-12, > 5.604E-12, 7.931E-12, 0.000E+00, 1.317E-11, 1.757E-11, 2.194E-12, > 4.978E-12, 1.693E-12, 0.000E+00, 1.324E-12, 1.285E-13, 0.000E+00, > 0.000E+00, 2.586E-11, 0.000E+00, 1.724E-12, 0.000E+00, 1.889E-12, > 2.400E-12, 2.063E-12, 8.911E-13, 2.193E-12, 9.090E-14, 0.000E+00, > 0.0, 0.0, 0.0, 0.0, 0.0/ DATA TCOR0/ > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.000E+00, 0.000E+00, 0.000E+00, > 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00,-6.060E-02, > 0.000E+00,-3.399E-02, 0.000E+00, 0.000E+00, 0.000E+00, 4.866E-02, >-1.762E-01, 0.000E+00,-2.412E-01, 0.000E+00, 0.000E+00, 0.000E+00, >-4.743E-01,-9.713E-01, 5.891E-02,-1.263E-01,-1.246E+00, 2.870E-01, >-4.659E+00, 0.000E+00,-1.058E+00,-3.821E+00,-1.874E+00, 0.000E+00, >-1.896E+00,-8.505E-01,-2.101E-04,-2.012E-01,-6.097E-02,-2.925E-02, >-4.875E-03, 0.0, 0.0, 0.0, 0.0/ DATA TCOR1/ > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.000E+00, 0.000E+00, 0.000E+00, > 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 2.877E-03, > 0.000E+00, 1.760E-03, 0.000E+00, 0.000E+00, 0.000E+00, 3.313E-04, > 3.643E-03, 0.000E+00, 5.225E-03, 0.000E+00, 0.000E+00, 0.000E+00, > 4.085E-03, 1.088E-02, 8.447E-04, 3.237E-03, 1.907E-02, 2.796E-03, > 4.460E-02, 0.000E+00, 1.007E-02, 3.481E-02, 1.604E-02, 0.000E+00, > 2.029E-02, 2.160E-02, 6.342E-04, 3.594E-03, 5.503E-04, 2.687E-04, > 4.479E-05, 0.0, 0.0, 0.0, 0.0/ DATA TCOR2/ > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, > 0.0, 0.0, 0.0, 0.000E+00, 0.000E+00, 0.000E+00, > 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 1.846E-03, > 0.000E+00, 1.127E-03, 0.000E+00, 0.000E+00, 0.000E+00, 1.891E-04, > 2.326E-03, 0.000E+00, 2.801E-03, 0.000E+00, 0.000E+00, 0.000E+00, > 2.446E-03, 7.121E-03, 5.204E-04, 1.983E-03, 1.204E-02, 1.721E-03, > 2.911E-02, 0.000E+00, 7.177E-03, 2.272E-02, 9.436E-03, 0.000E+00, > 1.316E-02, 1.398E-02, 4.098E-04, 2.328E-03, 3.574E-04, 1.745E-04, > 2.909E-05, 0.0, 0.0, 0.0, 0.0/ DATA WAR1/ 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 0.00, 3.80, 6.25, 4.93, 6.06, > 2.70, 7.07, 8.62, 9.60, 4.54, 2.37, > 0.82, 0.33, 0.24, 0.67, 0.28, 0.55, > 1.56, 1.11, 0.77, 1.32, 1.71, 0.44, > 1.11, 0.95, 0.39, 0.81, 2.00, 1.49, > 6.81, 5.07, 1.63, 5.62, 2.08, 0.59, > 3.89, 5.19, 0.35, 1.18, 0.099, 0.04, > 0.007, 0.00, 0.00, 0.00, 0.00/ DATA WAR2/ 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, > 0.00, 0.00, 20.80, 17.90, 9.30, 14.30, > 6.90, 12.00, 15.60, 18.60, 10.10, 4.30, > 12.40, 8.00, 3.60, 1.80, 0.50, 1.40, > 3.90, 2.60, 1.60, 3.40, 4.10, 0.70, > 4.30, 4.30, 3.80, 2.60, 6.08, 1.35, > 12.60, 9.78, 2.96, 10.20, 4.11, 6.68, > 6.62, 8.07, 0.47, 1.73, 0.17, 0.075, > 0.012, 0.00, 0.00, 0.00, 0.00/ C C Linear Interpolation between SC#21REFW and F79050: C FRAT = (F107-68.) / (243.-68.) DO 200 L=1,LMAX SFLUX(L) = RFLUX(L) + (XFLUX(L)-RFLUX(L)) * FRAT 200 CONTINUE C C Hinteregger contrast ratio method: C IF (ISCALE .EQ. 0) THEN IF (HLYBR .GT. 0.001) THEN R1 = HLYBR ELSE R1 = B1(1) + B1(2)*(F107A-71.5) + B1(3)*(F107-F107A+3.9) ENDIF IF (FEXVIR .GT. 0.001) THEN R2 = FEXVIR ELSE R2 = B2(1) + B2(2)*(F107A-71.5) + B2(3)*(F107-F107A+3.9) ENDIF DO 100 L=13,LMAX SFLUX(L) = (RFLUX(L) + ((R1-1.)*SCALE1(L) > + (R2-1.)*SCALE2(L)) / 1000.) 100 CONTINUE ENDIF C C Tobiska EUV91 Method: C IF (ISCALE .EQ. 2) THEN IF (HLYA .GT. 0.001) THEN HLYMOD = HLYA ELSE IF (HEIEW .GT. 0.001) THEN HLYMOD = HEIEW * 3.77847E9 + 8.40317E10 ELSE HLYMOD = 8.70E8 * F107 + 1.90E11 HLYMOD = 8.70E8 * F107 + 1.90E11 ENDIF ENDIF IF (HEIEW .GT. 0.001) THEN HEIMOD = HEIEW * 3.77847E9 + 8.40317E10 ELSE HEIMOD = HLYMOD ENDIF DO 500 L=16,55 SFLUX(L) = TCHR0(L) + TCHR1(L)*HLYMOD + TCHR2(L)*HEIMOD > + TCOR0(L) + TCOR1(L)*F107 + TCOR2(L)*F107A 500 CONTINUE ENDIF C C Woods and Rottman (10 Nov. 1988) spectrum: C IF (ISCALE .EQ. 3) THEN DO 550 L=15,55 SFLUX(L) = WAR1(L) 550 CONTINUE ENDIF C C Woods and Rottman (20 June 1989) spectrum: C IF (ISCALE .EQ. 4) THEN DO 560 L=15,55 SFLUX(L) = WAR2(L) 560 CONTINUE ENDIF C C Substitute in H Lyman-alpha and XUVFAC if provided: C IF (HLYA .GT. 0.001) SFLUX(12) = HLYA / 1.E9 IF (XUVFAC .GT. 0.001) THEN XUVF = XUVFAC ELSE XUVF = 1.0 ENDIF C C Convert from gigaphotons to photons, etc.: C DO 600 L=1,LMAX WAVE1(L) = WAVEL(L) WAVE2(L) = WAVES(L) IF (SFLUX(L) .LT. 0.0) SFLUX(L) = 0.0 IF (WAVEL(L).LT.251.0 .AND. WAVES(L).GT.15.0) > SFLUX(L)=SFLUX(L)*XUVF SFLUX(L) = SFLUX(L) * 1.E9 600 CONTINUE C RETURN END