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

57 lines
1.5 KiB
Fortran

SUBROUTINE GHYDOP(IJ)
C =====================
c
c hydrogen opacity -lines + pseudocontinuum from Gomez tables
c
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
INCLUDE 'ATOMIC.FOR'
common/intcfg/yint(mfreq),jgint(mfreq)
c
if(ihgom.eq.0.or.jgint(ij).eq.0) return
jf=ij
do 10 id=1,nd
if(elec(id).lt.HGLIM) go to 10
rl=log(elec(id))
tl=log(temp(id))
c
DELTAR=(RL-EGTAB1)/(EGTAB2-EGTAB1)*FLOAT(nugele-1)
JR = 1 + IDINT(DELTAR)
IF(JR.LT.1) JR = 1
IF(JR.GT.(nugele-1)) JR = nugele-1
r1i=elevec(jr)
r2i=elevec(jr+1)
dri=(RL-R1i)/(R2i-R1i)
if(JR .eq. 1) dri = 0.d0
C
DELTAT=(TL-TGTAB1)/(TGTAB2-TGTAB1)*FLOAT(nugtemp-1)
JT = 1 + IDINT(DELTAT)
IF(JT.LT.1) JT = 1
IF(JT.GT.nugtemp-1) JT = nugtemp-1
t1i=temvec(jt)
t2i=temvec(jt+1)
dti=(TL-T1i)/(T2i-T1i)
if(JT .eq. 1) dti = 0.d0
C
opr1=hydcrs(jt,jr,jf)+dti*
* (hydcrs(jt+1,jr,jf)-hydcrs(jt,jr,jf))
opr2=hydcrs(jt,jr+1,jf)+dti*
* (hydcrs(jt+1,jr+1,jf)-hydcrs(jt,jr+1,jf))
opac=opr1+dri*(opr2-opr1)
ab = exp(opac)*0.0265*4.1347e-15
c
if(freq(ij).gt.8.22013e14) then
ii=nfirst(ielh)
else
ii=nfirst(ielh)+1
end if
c
oph=ab*popul(ii,id)*g(ii)
abso1(id)=abso1(id)+oph
emis1(id)=emis1(id)+oph*xkfb(id)/xkf1(id)
10 continue
c
return
end