! block data init_euvac implicit none real :: wleuv1,wleuv2,sigao,sigao2,sigan2,sigio,sigio2, | sigin2,brop4s,brop2d,brop2p,sigop2p,sigop2d,sigop4s, | sigin,brn2np,bro2op COMMON/EUV/ WLEUV1(37),WLEUV2(37),SIGAO(37),SIGAO2(37), 1 SIGAN2(37),SIGIO(37),SIGIO2(37),SIGIN2(37), 2 BROP4S(37),BROP2D(37),BROP2P(37), 3 SIGOP2P(37),SIGOP2D(37),SIGOP4S(37), 4 SIGIN(37),BRN2NP(37),BRO2OP(37) c lambdas: data wleuv1 + /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.36, 650.00, 600.00, 629.73, 609.76, + 550.00, 584.33, 554.31, 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/ data wleuv2 + /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.36, 700.00, 650.00, 629.73, 609.76, + 600.00, 584.33, 554.31, 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/ c c sigao data sigao + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 1.32e-18, + 4.55e-18, 3.50e-18, 5.09e-18, 3.75e-18, 3.89e-18, 4.00e-18, + 1.07e-17, 1.15e-17, 1.72e-17, 1.34e-17, 1.34e-17, 1.34e-17, + 1.30e-17, 1.31e-17, 1.26e-17, 1.21e-17, 1.21e-17, 1.19e-17, + 1.15e-17, 9.69e-18, 9.84e-18, 8.69e-18, 7.70e-18, 7.68e-18, + 6.46e-18, 7.08e-18, 6.05e-18, 5.20e-18, 3.73e-18, 1.84e-18, + 7.30e-19/ c c sigao2 data sigao2 + /1.35e-18, 1.00e-18, 1.63e-18, 2.11e-17, 1.87e-17, 1.28e-17, + 8.56e-18, 1.66e-17, 2.21e-17, 2.67e-17, 1.89e-17, 2.08e-17, + 2.85e-17, 2.74e-17, 2.19e-17, 2.60e-17, 3.21e-17, 2.81e-17, + 2.66e-17, 2.28e-17, 2.60e-17, 2.46e-17, 2.31e-17, 2.19e-17, + 2.03e-17, 1.81e-17, 1.83e-17, 1.74e-17, 1.68e-17, 1.68e-17, + 1.44e-17, 1.58e-17, 1.34e-17, 1.09e-17, 7.51e-18, 3.81e-18, + 1.32e-18/ c c sigan2 data sigan2 + /0.00e+00, 0.00e+00, 0.00e+00, 5.10e-17, 2.24e-18, 9.68e-18, + 2.02e-17, 1.70e-17, 3.36e-17, 1.65e-17, 1.42e-17, 1.20e-16, + 2.47e-17, 2.65e-17, 3.18e-17, 2.33e-17, 2.34e-17, 2.28e-17, + 2.28e-17, 2.24e-17, 2.41e-17, 2.45e-17, 2.35e-17, 2.32e-17, + 2.17e-17, 1.64e-17, 1.69e-17, 1.39e-17, 1.17e-17, 1.17e-17, + 1.05e-17, 1.09e-17, 1.02e-17, 8.39e-18, 4.96e-18, 2.26e-18, + 7.20e-19/ c c sigio data sigio + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 1.32e-18, + 4.55e-18, 3.50e-18, 5.09e-18, 3.75e-18, 3.89e-18, 4.00e-18, + 1.07e-17, 1.15e-17, 1.72e-17, 1.34e-17, 1.34e-17, 1.34e-17, + 1.30e-17, 1.31e-17, 1.26e-17, 1.21e-17, 1.21e-17, 1.19e-17, + 1.15e-17, 9.69e-18, 9.84e-18, 8.69e-18, 7.70e-18, 7.68e-18, + 6.46e-18, 7.08e-18, 6.05e-18, 5.20e-18, 3.73e-18, 1.84e-18, + 7.30e-19/ c c sigio2 data sigio2 + /2.59e-19, 0.00e+00, 1.05e-18, 1.39e-17, 1.55e-17, 9.37e-18, + 5.49e-18, 6.41e-18, 1.06e-17, 1.02e-17, 8.47e-18, 1.17e-17, + 2.38e-17, 2.38e-17, 2.13e-17, 2.49e-17, 3.11e-17, 2.64e-17, + 2.66e-17, 2.28e-17, 2.60e-17, 2.46e-17, 2.31e-17, 2.19e-17, + 2.03e-17, 1.81e-17, 1.83e-17, 1.74e-17, 1.68e-17, 1.68e-17, + 1.44e-17, 1.58e-17, 1.34e-17, 1.09e-17, 7.51e-18, 3.81e-18, + 1.32e-18/ c c sigin2 data sigin2 + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.00e+00, 0.00e+00, 1.43e-17, 8.86e-18, 8.50e-18, 6.58e-17, + 1.51e-17, 2.55e-17, 2.92e-17, 2.33e-17, 2.34e-17, 2.28e-17, + 2.28e-17, 2.24e-17, 2.41e-17, 2.45e-17, 2.35e-17, 2.32e-17, + 2.17e-17, 1.64e-17, 1.69e-17, 1.39e-17, 1.17e-17, 1.17e-17, + 1.05e-17, 1.09e-17, 1.02e-17, 8.39e-18, 4.96e-18, 2.26e-18, + 7.20e-19/ c c sigin data sigin + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.21e-18,10.29e-18,11.71e-18,10.96e-18,11.24e-18,11.32e-18, + 12.10e-18,13.26e-18,12.42e-18,11.95e-18,11.21e-18,11.80e-18, + 11.76e-18,11.78e-18,11.77e-18,11.50e-18,11.02e-18,10.58e-18, + 9.56e-18, 8.15e-18, 8.30e-18, 7.30e-18, 6.41e-18, 6.40e-18, + 5.24e-18, 5.73e-18, 4.87e-18, 3.95e-18, 2.49e-18, 0.99e-18, + 0.33e-18/ c c O 4S data brop4s + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 1.00e+00, + 1.00e+00, 1.00e+00, 1.00e+00, 1.00e+00, 1.00e+00, 1.00e+00, + 6.30e-01, 4.30e-01, 3.00e-01, 3.20e-01, 2.90e-01, 2.70e-01, + 2.80e-01, 3.00e-01, 2.90e-01, 2.80e-01, 2.80e-01, 2.80e-01, + 2.70e-01, 2.60e-01, 2.60e-01, 2.60e-01, 2.50e-01, 2.50e-01, + 2.50e-01, 2.50e-01, 2.50e-01, 2.60e-01, 2.70e-01, 2.90e-01, + 3.00e-01/ c O 2D data brop2d + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 3.70e-01, 5.70e-01, 6.60e-01, 4.60e-01, 4.70e-01, 4.60e-01, + 4.50e-01, 4.60e-01, 4.50e-01, 4.50e-01, 4.50e-01, 4.50e-01, + 4.30e-01, 4.00e-01, 4.00e-01, 4.00e-01, 3.70e-01, 3.70e-01, + 3.60e-01, 3.70e-01, 3.50e-01, 3.50e-01, 3.30e-01, 3.20e-01, + 3.20e-01/ c O 2P c data brop2p c + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, c + 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, c + 0.00e+00, 0.00e+00, 4.00e-02, 2.20e-01, 2.40e-01, 2.70e-01, c + 2.70e-01, 2.40e-01, 2.60e-01, 2.70e-01, 2.70e-01, 2.70e-01, c + 2.60e-01, 2.50e-01, 2.60e-01, 2.50e-01, 2.50e-01, 2.50e-01, c + 2.30e-01, 2.30e-01, 2.30e-01, 2.20e-01, 2.20e-01, 2.10e-01, c + 2.10e-01/ c N2 -> N+ data brn2np + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.00e+00, 0.00e+00, 0.00e+00, 1.30e-03, 3.00e-02, 4.60e-02, + 4.50e-02, 1.05e-01, 9.00e-02, 1.63e-01, 2.13e-01, 2.13e-01, + 3.00e-01, 2.57e-01, 3.35e-01, 3.77e-01, 3.64e-01, 3.46e-01, + 3.85e-01/ c O2 -> O+ data bro2op + /0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, 0.00e+00, + 0.00e+00, 0.00e+00, 8.91e-03, 3.86e-02, 3.31e-02, 7.01e-02, + 1.44e-01, 1.71e-01, 1.71e-01, 2.08e-01, 2.31e-01, 2.25e-01, + 2.37e-01, 2.59e-01, 2.49e-01, 2.99e-01, 3.53e-01, 3.53e-01, + 3.71e-01, 3.73e-01, 3.66e-01, 3.93e-01, 4.48e-01, 3.84e-01, + 0.00e+00/ end !----------------------------------------------------------------------- SUBROUTINE EUVAC(F107,F107A,EUVFLX) implicit none C:::::::::::::::::::::::::::::::: EUVAC ::::::::::::::::::::::: C------ This EUV flux model uses the F74113 solar reference spectrum and C------ ratios determined from Hinteregger's SERF1 model. It uses the daily C------ F10.7 flux (F107) and the 81 day mean (F107A) as a proxy for scaling C------ The fluxes are returned in EUVFLX and correspond to the 37 wavelength C------ bins of Torr et al. [1979] Geophys. Res. Lett. p771. C------ See Richards et al. [1994] J. Geophys. Res. p8981 for details. C C...... F107 = input daily 10.7 cm flux index. (e.g. 74) C...... F107A = input 81 day average of daily F10.7 centered on current day C...... EUVFLX = output array for EUV flux in units of photons/cm2/sec. real :: wleuv1,wleuv2,sigao,sigao2,sigan2,sigio,sigio2, | sigin2,brop4s,brop2d,brop2p,sigop2p,sigop2d,sigop4s, | sigin,brn2np,bro2op COMMON/EUV/ WLEUV1(37),WLEUV2(37),SIGAO(37),SIGAO2(37), 1 SIGAN2(37),SIGIO(37),SIGIO2(37),SIGIN2(37), 2 BROP4S(37),BROP2D(37),BROP2P(37), 3 SIGOP2P(37),SIGOP2D(37),SIGOP4S(37), 4 SIGIN(37),BRN2NP(37),BRO2OP(37) ! ! Args: real,intent(in) :: f107,f107a real,intent(out) :: euvflx(37) ! ! Local: integer :: i real :: AFAC(37),F74113(37),flxfac C C------ F74113 reference spectrum (doubled below 150-250 A, tripled <150) C------ Will be multiplied by 1.0E9 later C ! DATA F74113/1.20,0.450,4.800,3.100,0.460,0.210,1.679,0.8 ! > ,6.900,0.965,0.650,0.314,0.383,0.290,0.285,0.452,0.720 ! > ,1.270,0.357,0.530,1.590,0.342,0.230,0.360,0.141,0.170 ! > ,0.260,0.702,0.758,1.625,3.537,3.000,4.400,1.475,3.500 ! > ,2.100,2.467/ ! F74113 = (/1.20,0.450,4.800,3.100,0.460,0.210,1.679,0.8 > ,6.900,0.965,0.650,0.314,0.383,0.290,0.285,0.452,0.720 > ,1.270,0.357,0.530,1.590,0.342,0.230,0.360,0.141,0.170 > ,0.260,0.702,0.758,1.625,3.537,3.000,4.400,1.475,3.500 > ,2.100,2.467/) C C--- Scaling factors(Ai) for the EUV flux ! DATA AFAC/1.0017E-02,7.1250E-03,1.3375E-02,1.9450E-02,2.7750E-03 ! > ,1.3768E-01,2.6467E-02,2.5000E-02,3.3333E-03,2.2450E-02 ! > ,6.5917E-03,3.6542E-02,7.4083E-03,7.4917E-03,2.0225E-02 ! > ,8.7583E-03,3.2667E-03,5.1583E-03,3.6583E-03,1.6175E-02 ! > ,3.3250E-03,1.1800E-02,4.2667E-03,3.0417E-03,4.7500E-03 ! > ,3.8500E-03,1.2808E-02,3.2750E-03,4.7667E-03,4.8167E-03 ! > ,5.6750E-03,4.9833E-03,3.9417E-03,4.4167E-03,5.1833E-03 ! > ,5.2833E-03,4.3750E-03/ ! AFAC = >(/1.0017E-02,7.1250E-03,1.3375E-02,1.9450E-02,2.7750E-03 > ,1.3768E-01,2.6467E-02,2.5000E-02,3.3333E-03,2.2450E-02 > ,6.5917E-03,3.6542E-02,7.4083E-03,7.4917E-03,2.0225E-02 > ,8.7583E-03,3.2667E-03,5.1583E-03,3.6583E-03,1.6175E-02 > ,3.3250E-03,1.1800E-02,4.2667E-03,3.0417E-03,4.7500E-03 > ,3.8500E-03,1.2808E-02,3.2750E-03,4.7667E-03,4.8167E-03 > ,5.6750E-03,4.9833E-03,3.9417E-03,4.4167E-03,5.1833E-03 > ,5.2833E-03,4.3750E-03/) C C----- loop through the wavelengths calculating the scaling factors and C----- the resulting solar flux. C----- The scaling factors are restricted to be greater than 0.8 DO 50 I=1,37 FLXFAC=(1.0 + AFAC(I) * (0.5*(F107+F107A) - 80.0)) IF(FLXFAC.LT.0.8) FLXFAC=0.8 EUVFLX(I)=F74113(I) * FLXFAC * 1.0E9 50 CONTINUE C DO 51 I=1,37 BROP2P(I) = 0. IF(I.GT.14) BROP2P(I) = 1.-BROP2D(I)-BROP4S(I) SIGOP2P(I)=SIGIO(I)*BROP2P(I) SIGOP2D(I)=SIGIO(I)*BROP2D(I) SIGOP4S(I)=SIGIO(I)*BROP4S(I) 51 CONTINUE RETURN END C