git push -u origin main
This commit is contained in:
@@ -0,0 +1,199 @@
|
||||
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
|
||||
Reference in New Issue
Block a user