111 lines
2.9 KiB
Fortran
111 lines
2.9 KiB
Fortran
SUBROUTINE OPADD0(IJ)
|
|
C ======================
|
|
C
|
|
C setting cross secxtion for ondividual addiaopnal opacity sources
|
|
c
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
C
|
|
PARAMETER (FRRAY = 2.463D15,
|
|
* FRAYHe= 5.150E15,
|
|
* FRAYH2= 2.922E15,
|
|
* CLS = 2.997925e18,
|
|
* CR0 = 5.799D-13,
|
|
* CR1 = 1.422D-6,
|
|
* CR2 = 2.784D0)
|
|
C
|
|
FR=FREQ(IJ)
|
|
IF(ISPODF.GE.1) FR=FREQ(IFREQB(IJ))
|
|
c
|
|
IT=NCON
|
|
C
|
|
C -----------------------
|
|
C HI Rayleigh scattering
|
|
C -----------------------
|
|
C
|
|
IF(IRSCT.NE.0) THEN
|
|
IT=IT+1
|
|
if(it.gt.mcross)
|
|
* CALL QUIT('it.gt.mcross in opadd',it,mcross)
|
|
FRM=MIN(FR,FRRAY)
|
|
X=(CLS/FRM)**2
|
|
BFCS(IT,IJ)=real((CR0+(CR1+CR2/X)/X)/X/X)
|
|
END IF
|
|
C
|
|
C -----------------------
|
|
C He I Rayleigh scattering
|
|
C -----------------------
|
|
C
|
|
IF(IRSCHE.NE.0) THEN
|
|
IT=IT+1
|
|
if(it.gt.mcross)
|
|
* CALL QUIT('it.gt.mcross in opadd',it,mcross)
|
|
X=(CLS/MIN(FR,FRAYHe))**2
|
|
CS=5.484E-14/X/X*(1.+(2.44E5+5.94E10/(X-2.90E5))/X)**2
|
|
BFCS(IT,IJ)=real(CS)
|
|
END IF
|
|
C
|
|
C -----------------------
|
|
C H2 Rayleigh scattering
|
|
C -----------------------
|
|
C
|
|
IF(IRSCH2.NE.0.AND.IFMOL.GT.0) THEN
|
|
IT=IT+1
|
|
if(it.gt.mcross)
|
|
* CALL QUIT('it.gt.mcross in opadd',it,mcross)
|
|
X=(CLS/MIN(FR,FRAYH2))**2
|
|
X2=1./X/X
|
|
CS=(8.14E-13+1.28E-6/X+1.61*X2)*X2
|
|
BFCS(IT,IJ)=real(CS)
|
|
END IF
|
|
C
|
|
C ----------------------------
|
|
C H- bound-free and free-free
|
|
C ----------------------------
|
|
C
|
|
IF(IOPHMI.GT.0) THEN
|
|
IT=IT+1
|
|
if(it.gt.mcross)
|
|
* CALL QUIT('it.gt.mcross in opadd',it,mcross)
|
|
BFCS(IT,IJ)=real(SBFHMI(FR))
|
|
END IF
|
|
C
|
|
C -----------------------------
|
|
C H2+ bound-free and free-free
|
|
C -----------------------------
|
|
C
|
|
IF(IOPH2P.GT.0) THEN
|
|
IT=IT+1
|
|
if(it+1.gt.mcross)
|
|
* CALL QUIT('it.gt.mcross in opadd',it,mcross)
|
|
X=FR*1.D-15
|
|
BFCS(IT,IJ)=real((-7.342D-3+(-2.409+(1.028+(-4.23D-1+
|
|
* (1.224D-1-1.351D-2*X)*X)*X)*X)*X)*1.602D-12/BOLK)
|
|
IT=IT+1
|
|
X=LOG(FR)
|
|
CS0=-3.0233D3+(3.7797D2+(-1.82496D1+(3.9207D-1-
|
|
* 3.1672D-3*X)*X)*X)*X
|
|
BFCS(IT,IJ)=real(cs0)
|
|
END IF
|
|
C
|
|
C -----------------------------
|
|
C He- free-free
|
|
C -----------------------------
|
|
C
|
|
IF(IOPHEM.GT.0) THEN
|
|
IT=IT+1
|
|
if(it+2.gt.mcross)
|
|
* CALL QUIT('it.gt.mcross in opadd',it,mcross)
|
|
A=3.397D-46+(-5.216D-31+7.039D-15/FR)/FR
|
|
B=-4.116D-42+(1.067D-26+8.135D-11/FR)/FR
|
|
C=5.081D-37+(-8.724D-23-5.659D-8/FR)/FR
|
|
BFCS(IT,IJ)=real(A)
|
|
BFCS(IT+1,IJ)=real(B)
|
|
BFCS(IT+2,IJ)=real(C)
|
|
END IF
|
|
C
|
|
RETURN
|
|
END
|