58 lines
1.6 KiB
Fortran
58 lines
1.6 KiB
Fortran
subroutine quasim(ij)
|
|
c =====================
|
|
c
|
|
c quasi-molecular opacity for Lyman alpha, beta, gamma
|
|
c
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
common/quasun/tqmprf,iquasi,nunalp,nunbet,nungam,nunbal
|
|
dimension sgd(mdepth)
|
|
c
|
|
if(iquasi.le.0) return
|
|
fr=freq(ij)
|
|
wlam=2.997925e18/fr
|
|
if(wlam.lt.911..or.wlam.gt.1727.) return
|
|
ii=nfirst(ielh)
|
|
c
|
|
do jup=2,iquasi+1
|
|
jj=ii+1
|
|
itr=itra(ii,jj)
|
|
do id=1,nd
|
|
anp=popul(nnext(ielh),id)
|
|
t=temp(id)
|
|
if(tqmprf.gt.0.) t=tqmprf
|
|
call allard(wlam,t,popul(ii,id),anp,sg,1,jup)
|
|
sgd(id)=sg
|
|
end do
|
|
if(ijlin(ij).ne.itr) then
|
|
sg0=0.
|
|
do ilint=1,nlines(ij)
|
|
itt=itrlin(ilint,ij)
|
|
if(itt.eq.itr) then
|
|
IJ0=IFR0(ITR)
|
|
DO IJT=IJ0,IFR1(ITR)
|
|
IF(FREQ(IJT).LE.FR) THEN
|
|
IJ0=IJT
|
|
GO TO 20
|
|
END IF
|
|
END DO
|
|
20 IJ1=IJ0-1
|
|
A1=(FR-FREQ(IJ0))/(FREQ(IJ1)-FREQ(IJ0))
|
|
A2=UN-A1
|
|
do id=1,nd
|
|
SG0=A1*PRFLIN(ID,IJ1)+A2*PRFLIN(ID,IJ0)
|
|
end do
|
|
end if
|
|
end do
|
|
end if
|
|
do id=1,nd
|
|
abso1(id)=abso1(id)+sgd(id)*abtra(itr,id)
|
|
emis1(id)=emis1(id)+sgd(id)*emtra(itr,id)
|
|
end do
|
|
end do
|
|
c
|
|
return
|
|
end
|