90 lines
2.2 KiB
Fortran
90 lines
2.2 KiB
Fortran
SUBROUTINE TABINT
|
|
C =================
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
common/intcff/yint(mfreq),jint(mfreq)
|
|
dimension absort(mfrtab)
|
|
C
|
|
IF(IOPTAB.LT.0.AND.IFRSET.EQ.0) THEN
|
|
c
|
|
C if frequencies are exactly tabular
|
|
c
|
|
nfreq=numfreq
|
|
nfreqc=numfreq
|
|
do ij=1,nfreq
|
|
freq(ij)=frtab(ij)
|
|
ijfr(ij)=ij
|
|
jik(ij)=ij
|
|
ijali(ij)=1
|
|
end do
|
|
w(1)=0.5*(frtab(1)-frtab(2))
|
|
w(nfreq)=0.5*(frtab(nfreq-1)-frtab(nfreq))
|
|
do ij=2,nfreq-1
|
|
w(ij)=0.5*(frtab(ij-1)-frtab(ij+1))
|
|
end do
|
|
C
|
|
ELSE
|
|
C
|
|
C if frequencies are already set
|
|
c
|
|
c set up interpolation coefficients for frequency interpolation
|
|
c by bisection
|
|
c
|
|
fr1=frtab(1)
|
|
fr2=frtab(numfreq)
|
|
do ij=1,nfreq
|
|
xint=freq(ij)
|
|
jl=0
|
|
ju=numfreq+1
|
|
10 continue
|
|
if(ju-jl.gt.1) then
|
|
jm=(ju+jl)/2
|
|
if((fr2.gt.fr1).eqv.(xint.gt.frtab(jm))) then
|
|
jl=jm
|
|
else
|
|
ju=jm
|
|
end if
|
|
go to 10
|
|
end if
|
|
j=jl
|
|
if(j.eq.numfreq) j=j-1
|
|
if(j.eq.0) j=j+1
|
|
jint(ij)=j
|
|
yint(ij)=un/log10(frtab(j+1)/frtab(j))
|
|
end do
|
|
c
|
|
do it=1,numtemp
|
|
numrho=numrh(it)
|
|
do ir=1,numrho
|
|
do k=1,numfreq
|
|
absort(k)=absopac(it,ir,k)
|
|
end do
|
|
do ij=1,nfreq
|
|
j=jint(ij)
|
|
rc=(absort(j+1)-absort(j))*yint(ij)
|
|
opac=rc*log10(freq(ij)/frtab(j))+absort(j)
|
|
absopac(it,ir,ij)=opac
|
|
end do
|
|
end do
|
|
end do
|
|
c
|
|
c reset tabular opacities to zero out of range of FREQ
|
|
c
|
|
do ij=1,nfreq
|
|
if(freq(ij).lt.fr2*0.99.or.freq(ij).gt.fr1*1.01) then
|
|
do it=1,numtemp
|
|
numrho=numrh(it)
|
|
do ir=1,numrho
|
|
absopac(it,ir,ij)=0.
|
|
end do
|
|
end do
|
|
end if
|
|
end do
|
|
END IF
|
|
C
|
|
RETURN
|
|
END
|