102 lines
2.7 KiB
Fortran
102 lines
2.7 KiB
Fortran
SUBROUTINE PHTX(ID,ABSO,EMIS,fre,icon)
|
|
C ======================================
|
|
C
|
|
C Opacity due to detailed photoionization (read from tables by
|
|
C routine SIGAVS)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
DIMENSION ABSO(MFREQ),EMIS(MFREQ),PLANF(MFREQ),STIMU(MFREQ)
|
|
dimension fre(mfreq)
|
|
DIMENSION PHOTI(MCROSS,MFREQ)
|
|
DIMENSION IJP(MLEVEL),IJQ(MPHOT)
|
|
PARAMETER (C3=1.4387886)
|
|
SAVE PHOTI,IJP,IJQ
|
|
C
|
|
IF(IASV.EQ.0 .AND. NQHT.EQ.0) RETURN
|
|
T=TEMP(ID)
|
|
nfre=nfreq
|
|
ij0=3
|
|
if(icon.eq.1) then
|
|
ij0=1
|
|
nfre=nfreqc
|
|
end if
|
|
c
|
|
DO 10 IJ=1,NFRE
|
|
XX=FRE(IJ)
|
|
X15=XX*1.E-15
|
|
BNU=BN*X15*X15*X15
|
|
HKF=HK*XX
|
|
EXH=EXP(HKF/T)
|
|
PLANF(IJ)=BNU/(EXH-1.)
|
|
STIMU(IJ)=1.-1./EXH
|
|
10 CONTINUE
|
|
C
|
|
IF(IASV.EQ.0) GOTO 100
|
|
IF(ID.EQ.1) THEN
|
|
DO 40 I=1,NLEVEL
|
|
IF(CRMX(I).EQ.0.) GOTO 40
|
|
IK1=MAX0(2,IJP(I))
|
|
DO 42 IJ=3,NFRE
|
|
DO 45 IK=IK1,NFCR(I)
|
|
IF(FRECR(I,IK).LT.FRE(IJ)) THEN
|
|
IK2=IK
|
|
GOTO 46
|
|
ENDIF
|
|
45 CONTINUE
|
|
46 IK1=IK2
|
|
IF(IJ.EQ.3) IJP(I)=IK1
|
|
DFR=(FRE(IJ)-FRECR(I,IK1))/(FRECR(I,IK1-1)-FRECR(I,IK1))
|
|
PHOTI(I,IJ)=CROSR(I,IK1)+DFR*(CROSR(I,IK1-1)-CROSR(I,IK1))
|
|
42 CONTINUE
|
|
PHOTI(I,1)=PHOTI(I,3)
|
|
PHOTI(I,2)=PHOTI(I,NFREQ)
|
|
40 CONTINUE
|
|
ENDIF
|
|
DO 30 I=1,NLEVEL
|
|
IF(CRMX(I).EQ.0.) GOTO 30
|
|
POP=POPUL(I,ID)
|
|
DO 20 IJ=1,NFRE
|
|
AB=PHOTI(I,IJ)*POP*STIMU(IJ)
|
|
ABSO(IJ)=ABSO(IJ)+AB
|
|
EMIS(IJ)=EMIS(IJ)+AB*PLANF(IJ)
|
|
20 CONTINUE
|
|
30 CONTINUE
|
|
C
|
|
100 IF(NQHT.EQ.0) RETURN
|
|
IF(ID.EQ.1) THEN
|
|
DO 110 I=1,NQHT
|
|
IF(CRMY(I).EQ.0.) GOTO 110
|
|
IK1=MAX0(2,IJQ(I))
|
|
DO 120 IJ=3,NFRE
|
|
DO 125 IK=IK1,NFQHT(I)
|
|
IF(FRECQ(I,IK).LT.FRE(IJ)) THEN
|
|
IK2=IK
|
|
GOTO 126
|
|
ENDIF
|
|
125 CONTINUE
|
|
126 IK1=IK2
|
|
IF(IJ.EQ.3) IJQ(I)=IK1
|
|
DFR=(FRE(IJ)-FRECQ(I,IK1))/(FRECQ(I,IK1-1)-FRECQ(I,IK1))
|
|
PHOTI(I,IJ)=QHOT(I,IK1)+DFR*(QHOT(I,IK1-1)-QHOT(I,IK1))
|
|
120 CONTINUE
|
|
110 CONTINUE
|
|
ENDIF
|
|
DO 210 I=1,NQHT
|
|
IF(CRMY(I).EQ.0.) GOTO 210
|
|
IAT=int(AQHT(I))
|
|
X=(AQHT(I)-FLOAT(IAT)+1.E-4)*100.
|
|
ION=INT(X)+1
|
|
POP=RRR(ID,ION,IAT)*GQHT(I)*EXP(-EQHT(I)*C3/T)
|
|
DO 220 IJ=3,NFRE
|
|
AB=PHOTI(I,IJ)*POP*STIMU(IJ)
|
|
ABSO(IJ)=ABSO(IJ)+AB
|
|
EMIS(IJ)=EMIS(IJ)+AB*PLANF(IJ)
|
|
220 CONTINUE
|
|
210 CONTINUE
|
|
C
|
|
RETURN
|
|
END
|