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

62 lines
1.5 KiB
Fortran

subroutine lyahhe(xl,ahe,prof)
c ==============================
c
c Lyman alpha broadening by helium - after N. Allard
c
INCLUDE 'PARAMS.FOR'
parameter (nxmax=1000)
c parameter (sthe=1.e21)
common/hhebrd/sthe,nunhhe
common/calhhe/xlhhe(nxmax),sighhe(nxmax),nxhhe
dimension xlhh0(nxmax),sighh0(nxmax)
data iread/0/
c
if(iread.eq.0) then
c nxhhe=679
c open(unit=67,
c * file='siglyhhe_21_T14500.lam',
c * status='old')
it=0
do i=1,nxmax
read(67,*,err=5,end=5) xl,sig
it=it+1
if(nunhhe.eq.1) xl=1./(1.e-8*xl+1./1215.67)
xlhh0(it)=xl
sighh0(it)=sig
end do
5 nxhhe=it
do i=1,nxhhe
xlhhe(i)=xlhh0(nxhhe-i+1)
sighhe(i)=sighh0(nxhhe-i+1)
end do
c do i=1,nxhhe
c j=nxhhe-i+1
c read(67,*) xlhhe(j),sighhe(j)
c end do
close(67)
iread=1
end if
c
prof=0.
if(xl.gt.xlhhe(nxhhe)) return
jl=0
ju=nxhhe+1
10 if(ju-jl.gt.1) then
jm=(ju+jl)/2
if((xlhhe(nxhhe).gt.xlhhe(1)).eqv.(xl.gt.xlhhe(jm))) then
jl=jm
else
ju=jm
endif
go to 10
endif
j=jl
c
if(j.eq.0) j=1
if(j.eq.nxhhe) j=j-1
a1=(xl-xlhhe(j))/(xlhhe(j+1)-xlhhe(j))
s1=(1.0-a1)*sighhe(j)+a1*sighhe(j+1)
prof=s1*ahe/sthe*6.2831855
return
end