47 lines
1.3 KiB
Fortran
47 lines
1.3 KiB
Fortran
SUBROUTINE PHTION(ID,ABSO,EMIS,FRE,NFRE)
|
|
C ========================================
|
|
C
|
|
C Opacity due to detailed photoionization (read from tables by
|
|
C routine READPH)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
COMMON/PHOTCS/PHOT(MFRQ,MPHOT),WPHT0,WPHT1,APHT(MPHOT),
|
|
* EPHT(MPHOT),GPHT(MPHOT),JPHT(MPHOT),
|
|
* NPHT
|
|
DIMENSION ABSO(MFRQ),EMIS(MFRQ),PLANF(MFRQ),STIMU(MFRQ)
|
|
DIMENSION FRE(MFRQ)
|
|
PARAMETER (C3=1.4387886)
|
|
C
|
|
IF(NPHT.LE.0) RETURN
|
|
T=TEMP(ID)
|
|
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
|
|
DO 30 I=1,NPHT
|
|
IF(JPHT(I).LE.0) THEN
|
|
IAT=int(APHT(I))
|
|
X=(APHT(I)-FLOAT(IAT)+1.E-4)*1.E2
|
|
ION=INT(X)+1
|
|
POP=RRR(ID,ION,IAT)*GPHT(I)*EXP(-EPHT(I)*C3/T)
|
|
ELSE
|
|
JJ=JPHT(I)
|
|
POP=POPUL(JJ,ID)
|
|
END IF
|
|
DO 20 IJ=1,NFRE
|
|
AB=PHOT(IJ,I)*POP*STIMU(IJ)
|
|
ABSO(IJ)=ABSO(IJ)+AB
|
|
EMIS(IJ)=EMIS(IJ)+AB*PLANF(IJ)
|
|
20 CONTINUE
|
|
30 CONTINUE
|
|
RETURN
|
|
END
|