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

56 lines
1.6 KiB
Fortran

SUBROUTINE HE1INI
C =================
C
C Initializes necessary arrays for evaluating the He I line
C absorption profiles using data calculated by Barnard, Cooper
C and Smith JQSRT 14, 1025, 1974 (for 4471)
C or Shamey, unpublished PhD thesis, 1969 (for other lines)
C
C This procedure is quite analogous to HYDINI for hydrogen lines
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
COMMON/PROHE1/PRFHE1(50,4,8,3),DLMHE1(50,8,3),XNEHE1(8),
* NWLAM(8,4)
COMMON/PRO447/PRF447(80,4,7),DLM447(80,7),XNE447(7)
DATA NT /4/
C
IH=67
OPEN(UNIT=IH,FILE='./data/he1prf.dat',STATUS='OLD')
C
C read the Barnard, Cooper, Smith tables for He I 4471 line,
C which have to be stored in file unit IH
C
NE=7
DO IE=1,NE
READ(IH,501) IL,WL0,IE1,XXNE,NWL
NWLAM(IE,1)=NWL
XNE447(IE)=LOG10(XXNE)
DO I=1,NWL
READ(IH,502) DLM447(I,IE),
* (PRF447(I,IT,IE),IT=1,NT)
END DO
END DO
C
C read Shamey's tables for He I 4387, 4026, and 4922 lines
C which have to be stored in file unit IH
C
NE=8
DO ILN=1,3
DO IE=1,NE
READ(IH,501) IL,WL0,IE1,XXNE,NWL
NWLAM(IE,ILN+1)=NWL
XNEHE1(IE)=LOG10(XXNE)
DO I=1,NWL
READ(IH,*) DLMHE1(I,IE,ILN),
* (PRFHE1(I,IT,IE,ILN),IT=1,NT)
END DO
END DO
END DO
CLOSE(IH)
C
501 FORMAT(/9X,I2,7X,F10.3,13X,I2,6X,E8.1,7X,I3/)
502 FORMAT(5E10.2)
RETURN
END