SpectraRust/tlusty/extracted/reiman.f
2026-03-19 14:05:33 +08:00

69 lines
2.0 KiB
Fortran

FUNCTION REIMAN(IB,FR)
C ======================
C
C Read table of photon energies and photo-ionization cross-sections
C from Reilman & Manson (1979, Ap. J. Suppl., 40, 815) for the species
C indicated by IB
C
C Compute linearly interpolated value of the cross-section
C at the frequency FR.
C
C (At the moment, only a few transitions are considered)
C
INCLUDE 'IMPLIC.FOR'
DIMENSION HEV(30),F0(30),SIG0(30,2),SIGS(30)
C
DATA HEV /
* 130.,160.,190.,210.,240.,270.,300.,330.,360.,390.,
* 420.,450.,480.,510.,540.,570.,600.,630.,660.,690.,
* 720.,750.,780.,810.,840.,870.,900.,930.,960.,990./
DATA SIG0 /
* 3*0., 4.422D-1, 3.478D-1,
* 2.794D-1, 2.286D-1, 1.899D-1, 1.598D-1, 1.360D-1,
* 1.169D-1, 1.013D-1, 8.845D-2, 7.776D-2, 6.877D-2,
* 6.114D-2, 5.463D-2, 4.904D-2, 4.419D-2, 3.998D-2,
* 3.629D-2, 3.305D-2, 3.019D-2, 2.766D-2, 2.540D-2,
* 2.339D-2, 2.158D-2, 1.996D-2, 1.850D-2, 1.718D-2,
* 4*0., 1.981D-1, 1.584D-1,
* 1.290D-1, 1.066D-1, 8.932D-2, 7.567D-2, 6.475D-2,
* 5.589D-2, 4.862D-2, 4.259D-2, 3.754D-2, 3.329D-2,
* 2.966D-2, 2.656D-2, 2.388D-2, 2.157D-2, 1.954D-2,
* 1.777D-2, 1.621D-2, 1.484D-2, 1.362D-2, 1.253D-2,
* 1.155D-2, 1.067D-2, 9.888D-3, 9.179D-3/
SAVE HEV,SIG0
C
INDEX=-IB-300
NUM=30
DO I=1,NUM
F0(I)=HEV(I)*2.418573D14
SIGS(I)=SIG0(I,INDEX)
END DO
C
IL=1
IR=NUM
DO I=1,NUM-1
IF(FR.GE.F0(I).AND.FR.LE.F0(I+1)) THEN
IL=I
IR=I+1
GO TO 60
END IF
END DO
C
C LINEAR INTERPOLATION:
C
60 SIGM=(SIGS(IR)-SIGS(IL))*(FR-F0(IL))/(F0(IR)-F0(IL))
* + SIGS(IL)
C
C IF OUTSIDE WAVELENGTH RANGE SET TO FIRST(LAST) VALUE:
C
IF(FR.LE.F0(1)) SIGM=SIGS(1)
IF(FR.GE.F0(NUM)) SIGM=SIGS(NUM)
C
C IF LAST NON-ZERO SIG VALUES, NO INTERPOLATION:
C
c IF(SIGS(IR).EQ.0.) SIGM=SIGS(IL)
C
REIMAN=SIGM*1.D-18
RETURN
END