SpectraRust/synspec/extracted/he2set.f
2026-03-19 14:05:33 +08:00

93 lines
3.0 KiB
Fortran

SUBROUTINE HE2SET
C =================
C
C Initialization procedure for treating the He II line opacity
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'SYNTHP.FOR'
dimension frhe(12)
DATA FRHE /1.3158153D+16, 3.2895381D+15, 1.4624854D+15,
* 8.2261878D+14, 5.2647201D+14, 3.6560459D+14,
* 2.6860713D+14, 2.0565220D+14, 1.6249055D+14,
* 1.3161730D+14, 1.0877460D+14, 9.1400851D+13/
C
C IHE2L=-1 - He II lines are excluded a priori
C
IHE2L=-1
IF(IFHE2.LE.0) RETURN
IF(FREQ(2).GE.1.315812E16) RETURN
AL0=2.997925E17/FREQ(1)
AL1=2.997925E17/FREQ(2)
c IF(AL0.GT.390.) RETURN
if(grav.lt.6.) then
IF(AL0.GT.31..AND.AL1.LT.91.1) RETURN
IF(AL0.GT.26.1.AND.AL1.LT.29.8) RETURN
IF(AL0.GT.24.8.AND.AL1.LT.25.1) RETURN
IF(AL0.GT.122.1.AND.AL1.LT.162.9) RETURN
IF(AL0.GT.165.1.AND.AL1.LT.204.9) RETURN
IF(AL0.GT.109..AND.AL1.LT.120.9) RETURN
IF(AL0.GT.103..AND.AL1.LT.107.9) RETURN
IF(AL0.GT.99.7.AND.AL1.LT.102.) RETURN
IF(AL0.GT.320.8.AND.AL1.LT.364.4) RETURN
IF(AL0.GT.273.8.AND.AL1.LT.319.8) RETURN
IF(AL0.GT.251.6.AND.AL1.LT.272.8) RETURN
IF(AL0.GT.239.0.AND.AL1.LT.250.6) RETURN
IF(AL0.GT.231.1.AND.AL1.LT.238.0) RETURN
IF(AL0.GT.225.8.AND.AL1.LT.230.1) RETURN
else if(grav.lt.7.) then
IF(AL0.GT.33..AND.AL1.LT.91.1) RETURN
IF(AL0.GT.124.1.AND.AL1.LT.160.9) RETURN
IF(AL0.GT.167.1.AND.AL1.LT.202.9) RETURN
IF(AL0.GT.111..AND.AL1.LT.118.9) RETURN
IF(AL0.GT.322.8.AND.AL1.LT.364.4) RETURN
IF(AL0.GT.275.8.AND.AL1.LT.317.8) RETURN
IF(AL0.GT.253.6.AND.AL1.LT.270.8) RETURN
IF(AL0.GT.241.0.AND.AL1.LT.248.6) RETURN
IF(AL0.GT.233.1.AND.AL1.LT.236.0) RETURN
else
IF(AL0.GT.39..AND.AL1.LT.91.1) RETURN
IF(AL0.GT.134.1.AND.AL1.LT.150.9) RETURN
IF(AL0.GT.177.1.AND.AL1.LT.202.9) RETURN
end if
C
C otherwise, He II lines are included
C
IHE2L=1
MHE10=60
MHE20=60
IF(AL1.LT.91.) THEN
ILWHE2=1
ELSE IF(AL0.LT.204.) THEN
ILWHE2=2
ELSE IF(AL0.LT.364.) THEN
ILWHE2=3
ELSE IF(AL0.LT.569.) THEN
ILWHE2=4
ELSE IF(AL0.LT.819.) THEN
ILWHE2=5
ELSE IF(AL0.LT.1116.) THEN
ILWHE2=6
ELSE IF(AL0.LT.1457.) THEN
ILWHE2=7
ELSE IF(AL0.LT.1844.) THEN
ILWHE2=8
ELSE IF(AL0.LT.2277.) THEN
ILWHE2=9
ELSE IF(AL0.LT.2756.) THEN
ILWHE2=10
ELSE IF(AL0.LT.3279.) THEN
ILWHE2=11
ELSE
ILWHE2=12
END IF
FRION=FRHE(ILWHE2)
FR1=FRION*ILWHE2*ILWHE2
IF(FRION.GT.FREQ(2)) MHE10=int(SQRT(FR1/(FRION-FREQ(2))))
IF(FRION.GT.FREQ(1)) MHE20=int(SQRT(FR1/(FRION-FREQ(1))) )
WRITE(6,601) ILWHE2,MHE20+1
601 FORMAT(1H0/ ' *** HE II LINES CONTRIBUTE'/
* ' THE NEAREST LINE ON THE SHORT-WAVELENGTH SIDE IS',
* I3,' TO ',I3/)
RETURN
END