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

92 lines
2.7 KiB
Fortran

SUBROUTINE HE2INI
C =================
C
C Initializes necessary arrays for evaluating the He II line
C absorption profiles using data calculated by Schoening and
C Butler
C
C This procedure is quite analogous to HYDINI for hydrogen lines
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
COMMON/HE2PRF/PRFHE2(19,MDEPTH,36),WLHE2(19,36),NWLHE2(19),
* ILHE2(19),IUHE2(19)
COMMON/HE2DAT/WL2(36,19),XT2(6),XNE2(11,19),PRF2(36,6,11),
* NWL2,NT2,NE2
DATA NLINE1 /19/
C
IH=67
OPEN(UNIT=IH,FILE='./data/he2prf.dat',STATUS='OLD')
C
DO ILINE=1,NLINE1
C
C read the Schoening and Butler tables, which have to be stored
C in file he23prf.dat
C
READ(IH,501) ILHE2(ILINE),IUHE2(ILINE)
IF(ILHE2(ILINE).LE.2) THEN
WL00=227.838
ELSE
WL00=227.7776
END IF
WL0=WL00/(1./ILHE2(ILINE)**2-1./IUHE2(ILINE)**2)
READ(IH,*) NWL2,(WL2(I,ILINE),I=1,NWL2)
READ(IH,503) NT2,(XT2(I),I=1,NT2)
READ(IH,504) NE2,(XNE2(I,ILINE),I=1,NE2)
READ(IH,500)
NWLHE2(ILINE)=NWL2
C
DO I=1,NWL2
IF(WL2(I,ILINE).LT.1.E-4) WL2(I,ILINE)=1.E-4
WLHE2(ILINE,I)=LOG10(WL2(I,ILINE))
END DO
C
DO IE=1,NE2
DO IT=1,NT2
READ(IH,500)
READ(IH,505) (PRF2(IWL,IT,IE),IWL=1,NWL2)
END DO
END DO
C
C coefficient for the asymptotic profile is determined from
C the input data
C
XCLOG=PRF2(NWL2,1,1)+2.5*LOG10(WL2(NWL2,ILINE))+31.831-
* XNE2(1,ILINE)-2.*LOG10(WL0)
XKLOG=0.6666667*(XCLOG-0.176)
XK=EXP(XKLOG*2.3025851)
DO ID=1,ND
T=TEMP(ID)+2.42E-8*VTURB(ID)
ANE=ELEC(ID)
TL=LOG10(T)
ANEL=LOG10(ANE)
F00=1.25E-9*ANE**0.666666667
FXK=F00*XK
DOP=1.E8/WL0*SQRT(4.12E7*T)
DBETA=WL0*WL0/2.997925E18/FXK
BETAD=DBETA*DOP
C
C interpolation to the actual values of temperature and electron
C density. The result is stored at array PRFHE2, which has indices
C ILINE - index of line
C ID - depth index
C IWL - wavelength index (notice that the wavelength grid may
C generally be different for different lines
C
DO IWL=1,NWL2
CALL INTHE2(PROF,TL,ANEL,IWL,ILINE)
PRFHE2(ILINE,ID,IWL)=PROF
END DO
END DO
END DO
CLOSE(IH)
C
500 FORMAT(1X)
501 FORMAT(//14X,I2,9X,I2/)
c 502 FORMAT(2X,I4,1P6E10.3,4(/5X,0P6F10.4)/5X,5F10.4)
503 FORMAT(2X,I4,F10.3,5F12.3)
504 FORMAT(2X,I4,F10.2,5F12.2/4X,5F12.2)
505 FORMAT(10F8.3)
RETURN
END