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

50 lines
2.0 KiB
Fortran

FUNCTION TOPBAS(FREQ,FREQ0,TYPLV)
C ==================================
C
C Procedure calculates the photo-ionisation cross section SIGMA in
C [cm^2] at frequency FREQ. FREQ0 is the threshold frequency from
C level I of ion KI. Threshold cross-sections will be of the order
C of the numerical value of 10^-18.
C Opacity-Project (OP) interpolation fit formula
C
INCLUDE 'PARAMS.FOR'
PARAMETER (E10=2.3025851)
PARAMETER (MMAXOP = 200,! maximum number of levels in OP data
+ MOP = 15 )! maximum number of fit points per level
CHARACTER*10 IDLVOP(MMAXOP) ! level identifyer Opacity-Project data
CHARACTER*10 TYPLV
COMMON /TOPB/ SOP(MOP,MMAXOP) ,! sigma = alog10(sigma/10^-18) of fit point
+ XOP(MOP,MMAXOP) ,! x = alog10(nu/nu0) of fit point
+ NOP(MMAXOP) ,! number of fit points for current level
+ NTOTOP ,! total number of levels in OP data
+ IDLVOP ,! level identifyer Opacity-Project data
+ LOPREA ! .T. OP data read in; .F. OP data not yer read in
DIMENSION XFIT(MOP) ,! local array containing x for OP data
+ SFIT(MOP) ! local array containing sigma for OP data
C
C Read OP data if not yet done
C
TOPBAS=0.
IF (.NOT.LOPREA) CALL OPDATA
X = LOG10(FREQ/FREQ0)
DO IOP = 1,NTOTOP
IF (IDLVOP(IOP).EQ.TYPLV) THEN
C level has been detected in OP-data file
IF (NOP(IOP).LE.0) GO TO 20
DO IFIT = 1,NOP(IOP)
XFIT(IFIT) = XOP(IFIT,IOP)
SFIT(IFIT) = SOP(IFIT,IOP)
END DO
SIGM = YLINTP (X,XFIT,SFIT,NOP(IOP),MOP)
SIGM = 1.D-18*EXP(E10*SIGM)
TOPBAS=SIGM
GO TO 10
END IF
END DO
10 RETURN
C Level is not found ,or no data for this level, in RBF.DAT
20 WRITE (61,100) TYPLV
100 FORMAT ('SIGMA.......: OP DATA NOT AVAILABLE FOR LEVEL ',A10)
RETURN
END