200 lines
5.6 KiB
Fortran
200 lines
5.6 KiB
Fortran
SUBROUTINE OPACW(ID,CROSS,ABSO,EMIS,
|
|
* ABSOC,EMISC,SCATC,MODC)
|
|
C ========================================
|
|
C
|
|
C Absorption, emission, and scattering coefficients
|
|
C at depth ID and for several frequencies (some or all)
|
|
C
|
|
C Input: ID - depth index
|
|
C CROSS - two dimensional array of photoionization
|
|
C cross-sections
|
|
C Output: ABSO - array of absorption coefficient
|
|
C EMIS - array of emission coefficient
|
|
C SCAT - array of scattering coefficient (all scattering
|
|
C mechanisms except electron scattering)
|
|
C
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'WINCOM.FOR'
|
|
DIMENSION CROSS(MCROSS,MFRQ)
|
|
DIMENSION ABSO(MFREQ),EMIS(MFREQ),SCAT(MFREQ),
|
|
* ABSOC(MFREQC),EMISC(MFREQC),SCATC(MFREQC),
|
|
* ABLIN(MFREQ),EMLIN(MFREQ),
|
|
* ABL1(MFREQC),EML1(MFREQC),SCL1(MFREQC)
|
|
COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
|
|
common/dissol/fropc(mlevel),indexp(mlevel)
|
|
common/lasers/lasdel
|
|
PARAMETER (UN=1.,TEN15=1.E-15,CSB=2.0706E-16,CFF=3.694E8)
|
|
C
|
|
IF(IMODE.EQ.-1.AND.ID.NE.IDSTD) RETURN
|
|
T=TEMP(ID)
|
|
ANE=ELEC(ID)
|
|
T1=UN/T
|
|
HKT=HK*T1
|
|
TK=HKT/H
|
|
SRT=UN/SQRT(T)
|
|
SGFF=CFF*SRT
|
|
CON=CSB*T1*SRT
|
|
conts=1.e-36/con
|
|
ABLY=0.
|
|
EMLY=0.
|
|
SCLY=0.
|
|
IJ0=2
|
|
IF(NFREQ.EQ.1) IJ0=1
|
|
IF(IMODE.EQ.2) IJ0=NFREQ
|
|
M=3
|
|
C
|
|
C Opacity and emissivity in continuum
|
|
C **** calculated only for the continuum frequencies *****
|
|
C
|
|
DO 200 IJ=1,NFREQC
|
|
FR=FREQC(IJ)
|
|
FR15=FR*TEN15
|
|
BNU=BN*FR15*FR15*FR15
|
|
HKF=HKT*FR
|
|
ABF=0.
|
|
EBF=0.
|
|
AFF=0.
|
|
DO 100 IL=1,NION
|
|
N0I=NFIRST(IL)
|
|
N1I=NLAST(IL)
|
|
NKE=NNEXT(IL)
|
|
XN=POPUL(NKE,ID)
|
|
C
|
|
C Bound-free contribution + possibly
|
|
c pseudo-continuum (accounting for dissolved fraction)
|
|
C
|
|
DO 10 II=N0I,N1I
|
|
SG=0.
|
|
IF(IFWOP(II).LT.0) THEN
|
|
SG=SGMERG(II,ID,FR)
|
|
ELSE
|
|
SG=CROSS(II,IJ)
|
|
IF(INDEXP(II).EQ.5) THEN
|
|
IZZ=IZ(IEL(II))
|
|
FR0=ENION(II)/6.6256E-27
|
|
CALL DWNFR1(FR,FR0,ID,IZZ,DW1)
|
|
SG=SG*DW1
|
|
END IF
|
|
END IF
|
|
ABF=ABF+SG*POPUL(II,ID)
|
|
XX=SG*XN*EXP(ENION(II)*TK)*WOP(II,ID)
|
|
IF(XX.lt.conts) go to 10
|
|
EBF=EBF+XX*CON*G(II)/G(NKE)
|
|
10 CONTINUE
|
|
IT=IFREE(IL)
|
|
IF(IT.EQ.0) GO TO 100
|
|
C
|
|
C Free-free contribution
|
|
C
|
|
IE=IL
|
|
IF(IE.EQ.IELHM) GO TO 65
|
|
CH=IZ(IL)*IZ(IL)
|
|
SF1=CH*XN*SGFF/(FR*FR*FR)
|
|
C
|
|
C The following expression is the so-called modified free-free
|
|
C opacity, ie. allowing for the photoionization from higher,
|
|
C non-explicit, LTE energy levels of the ion IL
|
|
C
|
|
HKFM=HKT*MIN(FF(IL),FR)
|
|
SF2=EXP(HKFM)
|
|
IF(IT.NE.2) GO TO 50
|
|
SG=GFREE(T,FR/CH)
|
|
SF2=SF2+SG-UN
|
|
50 SFF=SF1*SF2
|
|
GO TO 70
|
|
65 SFF=SFFHMI(XN,FR,T)
|
|
70 AFF=AFF+SFF
|
|
100 CONTINUE
|
|
C
|
|
C Additional opacities
|
|
C
|
|
CALL OPADD(0,ID,FR,ABAD,EMAD,SCAD)
|
|
IF(IOPHLI.NE.0) CALL LYMLIN(ID,FR,ABLY,EMLY,SCLY)
|
|
C
|
|
C Total opacity and emissivity
|
|
C
|
|
X=EXP(-HKF)
|
|
X1=UN-X
|
|
BNE=BNU*X*ANE
|
|
ABSOC(IJ)=ABF+ANE*(X1*AFF-X*EBF)+ANE*SIGE+ABAD+ABLY
|
|
EMISC(IJ)=BNE*(AFF+EBF)+EMAD+EMLY
|
|
SCATC(IJ)=SCAD+SCLY
|
|
ABL1(IJ)=ABLY
|
|
EML1(IJ)=EMLY
|
|
SCL1(IJ)=SCLY
|
|
200 CONTINUE
|
|
c
|
|
if(modc.eq.0) return
|
|
c
|
|
IF(NFREQ.LE.2.OR.IMODE.EQ.-1) RETURN
|
|
C
|
|
C interpolated continuum and hydrogen line opacity and emissivity
|
|
C for all frequencies
|
|
C
|
|
DO IJ=1,NFREQ
|
|
IJC=IJCINT(IJ)
|
|
ABSO(IJ)=FRX1(IJ)*ABSOC(IJC)+(1.-FRX1(IJ))*ABSOC(IJC+1)
|
|
EMIS(IJ)=FRX1(IJ)*EMISC(IJC)+(1.-FRX1(IJ))*EMISC(IJC+1)
|
|
SCAT(IJ)=FRX1(IJ)*SCATC(IJC)+(1.-FRX1(IJ))*SCATC(IJC+1)
|
|
END DO
|
|
IF(IMODE.EQ.2) GO TO 225
|
|
C
|
|
C **** Opacity and emissivity in lines ****
|
|
C
|
|
CALL LINOPW(ID,ABLIN,EMLIN)
|
|
DO IJ=1,NFREQ
|
|
ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
|
|
EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
|
|
END DO
|
|
C
|
|
C **** Opacity and emissivity in molecular lines ****
|
|
C
|
|
if(ifmol.gt.0) then
|
|
do ilist=1,nmlist
|
|
CALL MOLOP(ID,ABLIN,EMLIN,AVAB,ILIST)
|
|
DO IJ=1,NFREQ
|
|
ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
|
|
EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
|
|
END DO
|
|
end do
|
|
end if
|
|
225 CONTINUE
|
|
C
|
|
C **** Detailed opacity and emissivity in hydrogen lines ****
|
|
C
|
|
CALL HYDLIW(ID,ABLIN,EMLIN)
|
|
DO IJ=1,NFREQ
|
|
ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
|
|
EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
|
|
END DO
|
|
C
|
|
C **** Detailed opacity and emissivity in HE II lines ****
|
|
C (for IHE2L=1)
|
|
C
|
|
CALL HE2LIW(ID,ABLIN,EMLIN)
|
|
DO IJ=1,NFREQ
|
|
ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
|
|
EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
|
|
END DO
|
|
C
|
|
C opacity due to detailed photoinization cross-section
|
|
C (from tables; including resonance features)
|
|
C The two routines may be called and correspond to different formats
|
|
C as well as difference in INPUT!
|
|
C
|
|
CALL PHTION(ID,ABSO,EMIS,FREQ,NFREQ)
|
|
CALL PHTX(ID,ABSO,EMIS,FREQ,0)
|
|
C
|
|
IF(ICONTL.EQ.1) RETURN
|
|
DO IJ=1,NFREQC
|
|
ABSOC(IJ)=ABSOC(IJ)-ABL1(IJ)
|
|
EMISC(IJ)=EMISC(IJ)-EML1(IJ)
|
|
SCATC(IJ)=SCATC(IJ)-SCL1(IJ)
|
|
END DO
|
|
RETURN
|
|
END
|