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

87 lines
2.8 KiB
Fortran

SUBROUTINE HE2SEW(IJ)
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
IHE2LW(IJ)=-1
IF(IFHE2.LE.0) RETURN
FR=FREQ(IJ)
AL0=2.997925E17/FR
AL1=2.997925E17/FR
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
IHE2LW(IJ)=1
MHE10W(IJ)=60
MHE20W(IJ)=60
IF(AL1.LT.91.) THEN
ILWHEW(IJ)=1
ELSE IF(AL0.LT.204.) THEN
ILWHEW(IJ)=2
ELSE IF(AL0.LT.364.) THEN
ILWHEW(IJ)=3
ELSE IF(AL0.LT.569.) THEN
ILWHEW(IJ)=4
ELSE IF(AL0.LT.819.) THEN
ILWHEW(IJ)=5
ELSE IF(AL0.LT.1116.) THEN
ILWHEW(IJ)=6
ELSE IF(AL0.LT.1457.) THEN
ILWHEW(IJ)=7
ELSE IF(AL0.LT.1844.) THEN
ILWHEW(IJ)=8
ELSE IF(AL0.LT.2277.) THEN
ILWHEW(IJ)=9
ELSE IF(AL0.LT.2756.) THEN
ILWHEW(IJ)=10
ELSE IF(AL0.LT.3279.) THEN
ILWHEW(IJ)=11
ELSE
ILWHEW(IJ)=12
END IF
FRION=FRHE(ILWHEW(IJ))
FR1=FRION*ILWHEW(IJ)*ILWHEW(IJ)
IF(FRION.GT.FR) MHE10W(IJ)=int(SQRT(FR1/(FRION-FR)))
RETURN
END