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

94 lines
2.6 KiB
Fortran

subroutine getlal
c =================
c
c getlal reads in the profile functions for Lyman alpha, beta, gamma,
c and Balmer alpha, including the quasi-molecular satellites;
c valid for first and second order in neutral and ionized H density
c modified routine provided originally by D. Koester
c
c
INCLUDE 'PARAMS.FOR'
parameter (NXMAX=1400,NNMAX=5)
common/quasun/nunalp,nunbet,nungam,nunbal
common /callarda/xlalp(NXMAX),plalp(NXMAX,NNMAX),stnnea,stncha,
* vneua,vchaa,nxalp,iwarna
common /callardb/xlbet(NXMAX),plbet(NXMAX,NNMAX),stnneb,stnchb,
* vneub,vchab,nxbet,iwarnb
common /callardg/xlgam(NXMAX),plgam(NXMAX,NNMAX),stnneg,stnchg,
* vneug,vchag,nxgam,iwarng
common /callardc/xlbal(NXMAX),plbal(NXMAX,NNMAX),stnnec,stnchc,
* vneuc,vchac,nxbal,iwarnc
c
c Lyman alpha
c
nxalp=0
if(nunalp.gt.0) then
nunalp=67
open(unit=nunalp,file='./data/laquasi.dat',status='old')
read(nunalp,*) nxalp,stnnea,stncha,vneua,vchaa
do i=1,nxalp
read(nunalp,*) xlalp(i),(plalp(i,j),j=1,NNMAX)
end do
close(nunalp)
stnnea=10.0**stnnea
stncha=10.0**stncha
iwarna=0
close(nunalp)
write(*,*)
write(*,*) ' read quasi-molecular data for L alpha'
end if
c
c Lyman beta
c
nxbet=0
if(nunbet.gt.0) then
nunbet=67
open(unit=nunbet,file='./data/lbquasi.dat',status='old')
read(nunbet,*) nxbet,stnneb,stnchb,vneub,vchab
do i=1,nxbet
read(nunbet,*) xlbet(i),(plbet(i,j),j=1,NNMAX)
end do
close(nunbet)
stnneb=10.0**stnneb
stnchb=10.0**stnchb
iwarnb=0
write(*,*) ' read quasi-molecular data for L beta'
end if
c
c Lyman gamma
c
nxgam=0
if(nungam.gt.0) then
nungam=67
open(unit=nunalp,file='./data/lgquasi.dat',status='old')
read(nungam,*) nxgam,stnneg,stnchg,vneug,vchag
do i=1,nxgam
read(nungam,*) xlgam(i),(plgam(i,j),j=1,NNMAX)
end do
close(nungam)
stnneg=10.0**stnneg
stnchg=10.0**stnchg
iwarng=0
write(*,*) ' read quasi-molecular data for L gamma'
end if
c
c Balmer alpha
c
nxbal=0
if(nunbal.gt.0) then
nunbal=67
open(unit=nunalp,file='./data/lhquasi.dat',status='old')
read(nunbal,*) nxbal,stnnec,stnchc,vneuc,vchac
do i=1,nxbal
read(nunbal,*) xlbal(i),(plbal(i,j),j=1,NNMAX)
end do
close(nunbal)
stnnec=10.0**stnnec
stnchc=10.0**stnchc
iwarnc=0
write(*,*) ' read quasi-molecular data for H alpha'
end if
write(*,*)
return
end