172 lines
5.4 KiB
Fortran
172 lines
5.4 KiB
Fortran
FUNCTION SIGK(FR,ITR,MODE)
|
|
C ==========================
|
|
C
|
|
C driver for evaluating the photoionization cross-sections
|
|
C
|
|
C Input: FR - frequency
|
|
C ITR - index of the transition
|
|
c mode - =0 cross-section equal to zero longward of edge
|
|
c mode - >0 cross-section non-zero (extrapolated) longward of edge
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
PARAMETER (SIH0=2.815D29, E10=2.3025851)
|
|
parameter (wi1=911.753878, wi2=227.837832, un=1.e0)
|
|
CHARACTER*10 TYPLEV(MLEVEL)
|
|
COMMON/PRINTP/TYPLEV
|
|
COMMON/TOPCS/CTOP(MFIT,MCROSS), ! sigma = alog10(sigma/10^-18) of fit point
|
|
+ XTOP(MFIT,MCROSS) ! x = alog10(nu/nu0) of fit point
|
|
common/dissol/fropc(mlevel),indexp(mlevel)
|
|
DIMENSION XFIT(MFIT) , ! local array containing x for OP data
|
|
+ SFIT(MFIT) ! local array containing sigma for OP data
|
|
C
|
|
PEACH(X,S,A,B) =A*X**S*(B+X*(1.-B))*1.E-18
|
|
HENRY(X,S,A,B,C)=A*X**S*(C+X*(B-2.*C+X*(1.+C-B)))*1.E-18
|
|
C
|
|
SIGK=0.
|
|
II=ITR
|
|
FR0=ENION(II)/6.6256E-27
|
|
IF(FR0.LE.0.) RETURN
|
|
wl0=2.997925e18/fr0
|
|
C
|
|
C wavelength with an explicit correction to the air wavalength
|
|
C
|
|
IF(WL0.GT.vaclim) THEN
|
|
ALM=1.E8/(WL0*WL0)
|
|
XN1=64.328+29498.1/(146.-ALM)+255.4/(41.-ALM)
|
|
WL0=WL0/(XN1*1.D-6+UN)
|
|
fr0=2.997925e18/wl0
|
|
END IF
|
|
c
|
|
IF(mode.eq.0 .and. FR.LT.FR0) RETURN
|
|
C
|
|
C IBF(ITR) is the switch controlling the mode of evaluation of the
|
|
C cross-section:
|
|
C = 0 hydrogenic cross-section, with Gaunt factor set to 1
|
|
C = 1 hydrogenic cross-section with exact Gaunt factor
|
|
C = 2 Peach-type expression (see function PEACH)
|
|
C = 3 Henry-type expression (see function HENRY)
|
|
C = 4 Butler new calculations
|
|
C = 7 hydrogenic cross-section with Gaunt factor from K. Werner
|
|
C = 9 Opacity project fits (routine TOPBAS - interpolations)
|
|
C > 100 - cross-sections extracted form TOPBASE, for several points
|
|
C In this case, IBF-100 is the number of points
|
|
C < 0 non-standard, user supplied expression (user should update
|
|
C subroutine SPSIGK)
|
|
C
|
|
C for H- : for any IBF > 0 - standard expression
|
|
C for He I:
|
|
C for IBF = 11 or = 13 - Opacity Project cross section
|
|
C Seaton-Ferney's cubic fits, Hummer's procedure (HEPHOT)
|
|
C IBF = 11 means that the multiplicity S=1 (singlet)
|
|
C IBF = 13 means that the multiplicity S=3 (triplet)
|
|
C for IBF = 10 - cross section, based on Opacity Project, but
|
|
C appropriately averaged for an averaged level
|
|
C
|
|
C
|
|
IB=IBF(ITR)
|
|
IQ=NQUANT(II)
|
|
IE=IEL(II)
|
|
IF(IE.EQ.IELHM) THEN
|
|
SIGK=SBFHMI(FR)
|
|
RETURN
|
|
END IF
|
|
IF(IE.EQ.IELHE1.AND.IB.GE.10.AND.IB.LE.13) THEN
|
|
SIGK=SBFHE1(II,IB,FR)
|
|
RETURN
|
|
END IF
|
|
c
|
|
CH=IZ(IE)*IZ(IE)
|
|
IQ5=IQ*IQ*IQ*IQ*IQ
|
|
C
|
|
IF(IB.EQ.0) THEN
|
|
C
|
|
C hydrogenic expression (for IBF = 0)
|
|
C
|
|
SIGK=SIH0/FR/FR/FR*CH*CH/IQ5
|
|
C
|
|
C exact hydrogenic - with Gaunt factor (for IBF=1)
|
|
C
|
|
ELSE IF(IB.EQ.1) THEN
|
|
SIGK=SIH0/FR/FR/FR*CH*CH/IQ5
|
|
c IF(FR.GE.FR0.OR.(IE.EQ.IELH.AND.IQ.LE.3))
|
|
c * SIGK=SIGK*GAUNT(IQ,FR/CH)
|
|
fr0l=0.95*fr0
|
|
if(fr.ge.fr0) then
|
|
sigk=sigk*gaunt(iq,fr/ch)
|
|
else if(fr.ge.fr0l) then
|
|
gau0=gaunt(iq,fr0/ch)
|
|
corg=(fr-fr0l)/(fr0-fr0l)*(gau0-1.)+1.
|
|
sigk=sigk*corg
|
|
end if
|
|
ELSE IF(IB.EQ.2) THEN
|
|
C
|
|
C Peach-type formula (for IBF=2)
|
|
C
|
|
IF(GAMBF(II).GT.0) THEN
|
|
IF(GAMBF(II).LT.1.E6) THEN
|
|
FR0=2.997925E18/GAMBF(II)
|
|
ELSE
|
|
FR0=GAMBF(II)
|
|
END IF
|
|
IF(FR.LT.FR0) RETURN
|
|
END IF
|
|
FREL=FR0/FR
|
|
SIGK=PEACH(FREL,S0BF(II),ALFBF(II),BETBF(II))
|
|
ELSE IF(IB.EQ.3) THEN
|
|
C
|
|
C Henry-type formula (for IBF=3)
|
|
C
|
|
FREL=FR0/FR
|
|
SIGK=HENRY(FREL,S0BF(II),ALFBF(II),BETBF(II),GAMBF(II))
|
|
C
|
|
C Butler expression
|
|
C
|
|
ELSE IF(IB.EQ.4) THEN
|
|
FREL=FR0/FR
|
|
XL=LOG(FREL)
|
|
SL=S0BF(II)+XL*(ALFBF(II)+XL*BETBF(II))
|
|
SIGK=EXP(SL)
|
|
C
|
|
C exact hydrogenic - with Gaunt factor from K Werner (for IBF=7)
|
|
C
|
|
ELSE IF(IB.EQ.7) THEN
|
|
IQ5=IQ*IQ*IQ*IQ*IQ
|
|
SIGK=SIH0/(FR*FR*FR)*CH*CH/IQ5*GNTK(IQ,FR/CH)
|
|
C
|
|
C selected Opacity Project data (for IBF=9)
|
|
C (c.-s. evaluated by routine TOPBAS which needs an input file RBF.DAT)
|
|
C
|
|
ELSE IF(IB.EQ.9) THEN
|
|
SIGK=TOPBAS(FR,FR0,TYPLEV(II))
|
|
C
|
|
C other Opacity Project data (for IBF>100)
|
|
C (c.-s. evaluated by interpolating from direct input data)
|
|
C
|
|
ELSE IF(IB.GT.100) THEN
|
|
NFIT=IB-100
|
|
X = LOG10(FR/FR0)
|
|
IF(X.LT.XTOP(1,II)) THEN
|
|
SIGM=0.
|
|
ELSE
|
|
DO IFIT = 1,NFIT
|
|
XFIT(IFIT) = XTOP(IFIT,II)
|
|
SFIT(IFIT) = CTOP(IFIT,II)
|
|
END DO
|
|
SIGM = YLINTP (X,XFIT,SFIT,NFIT,MFIT)
|
|
SIGM = 1.D-18*EXP(E10*SIGM)
|
|
END IF
|
|
SIGK=SIGM
|
|
ELSE IF(IB.LT.0) THEN
|
|
CALL SPSIGK(ITR,IB,FR,SIGSP)
|
|
SIGK=SIGSP
|
|
END IF
|
|
if(iatm(ii).eq.iath.and.ii.gt.n0hn+2.
|
|
* and.ib.le.1.and.fr.lt.fr0) then
|
|
fr1=fropc(ii)
|
|
frdec=min(fr1*1.25,fr0)
|
|
if(fr.gt.fr1.and.fr.lt.frdec)
|
|
* sigk=sigk*(fr-fr1)/(frdec-fr1)
|
|
end if
|
|
RETURN
|
|
END
|