196 lines
6.0 KiB
Fortran
196 lines
6.0 KiB
Fortran
FUNCTION SIGK(FR,ITR,MODE)
|
|
C ==========================
|
|
C
|
|
C 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 >0 - cross-section non-zero (extrapolated) longward
|
|
C of edge
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
PARAMETER (SIH0=2.815D29, E10=2.3025851)
|
|
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.D-18
|
|
HENRY(X,S,A,B,C)=A*X**S*(C+X*(B-2.*C+X*(1.+C-B)))*1.D-18
|
|
C
|
|
SIGK=0.
|
|
IF(INDEXP(ITR).EQ.0) RETURN
|
|
IF(MODE.EQ.0.AND.FR.LT.FR0(ITR)) RETURN
|
|
C
|
|
C IC is the index of the given transition in the special numbering
|
|
C of continua (given by ITRCON(ITR)
|
|
C IBF(IC) 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 fit formula (polynomial fits to the OP results);
|
|
C = 5 Verner fit formula (OP results & HDS calculations at high
|
|
C energies); ONLY for GROUND states;
|
|
C = 6 DETAIL's fit formula from Klaus Werner
|
|
C (similar to Butler's fit but up to 5th order)
|
|
C = 7 hydrogenic cross-section with Gaunt factor after 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
|
|
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 (see explanation in SBFHE1)
|
|
C
|
|
C for IBF = 21 or 23 Koester's fit (A&A 149, 423)
|
|
C
|
|
C IBF = 21 means that the multiplicity S=1 (singlet)
|
|
C IBF = 23 means that the multiplicity S=3 (triplet)
|
|
C
|
|
IC=ITRCON(ITR)
|
|
IB=IBF(IC)
|
|
II=ILOW(ITR)
|
|
IQ=NQUANT(II)
|
|
IE=IEL(ILOW(ITR))
|
|
IF(IB.LT.0) GO TO 60
|
|
IF(IE.EQ.IELHM) GO TO 40
|
|
IF(IE.EQ.IELHE1.AND.IB.GE.10.AND.IB.LE.23) GO TO 50
|
|
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
|
|
frd=fr0(itr)
|
|
fr0l=0.95*frd
|
|
if(fr.ge.frd) then
|
|
gau0=gaunt(iq,fr/ch)
|
|
sigk=sigk*gaunt(iq,fr/ch)
|
|
else if(fr.ge.fr0l) then
|
|
gau0=gaunt(iq,frd/ch)
|
|
corg=(fr-fr0l)/(frd-fr0l)*(gau0-1.)+1.
|
|
sigk=sigk*corg
|
|
end if
|
|
ELSE IF(IB.EQ.2) THEN
|
|
C
|
|
C Peach-type formula (for IBF=2)
|
|
C
|
|
FREL=FR0(ITR)/FR
|
|
IF(GAMCS(IC).GT.0) THEN
|
|
IF(GAMCS(IC).LT.1.E6) THEN
|
|
FR00=2.997925E18/GAMCS(IC)
|
|
ELSE
|
|
FR00=GAMCS(IC)
|
|
END IF
|
|
IF(FR.LT.FR00) RETURN
|
|
FREL=FR00/FR
|
|
END IF
|
|
if(frel.gt.0.)
|
|
* SIGK=PEACH (FREL,S0CS(IC),ALFCS(IC),BETCS(IC))
|
|
ELSE IF(IB.EQ.3) THEN
|
|
C
|
|
C Henry-type formula (for IBF=3)
|
|
C
|
|
FREL=FR0(ITR)/FR
|
|
if(frel.gt.0.)
|
|
* SIGK=HENRY(FREL,S0CS(IC),ALFCS(IC),BETCS(IC),GAMCS(IC))
|
|
C
|
|
C Butler expression
|
|
C
|
|
ELSE IF(IB.EQ.4) THEN
|
|
FREL=FR0(ITR)/FR
|
|
XL=LOG(FREL)
|
|
SL=S0CS(IC)+XL*(ALFCS(IC)+XL*BETCS(IC))
|
|
SIGK=EXP(SL)
|
|
C
|
|
C Verner expression
|
|
C
|
|
ELSE IF(IB.EQ.5) THEN
|
|
SIGK=VERNER(FR,ITR)
|
|
C
|
|
C DETAIL expression
|
|
C
|
|
ELSE IF(IB.EQ.6) THEN
|
|
FREL=FR0(ITR)/FR
|
|
XL=LOG(FREL)
|
|
XL2=XL*XL
|
|
XL3=XL2*XL
|
|
SL=CTOP(1,IC)+XL*CTOP(2,IC)+XL2*CTOP(3,IC)+XL3*CTOP(4,IC)
|
|
SL=SL+XL2*XL2*CTOP(5,IC)+XL3*XL2*CTOP(6,IC)
|
|
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(ITR),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(ITR))
|
|
SIGM=0.
|
|
IF(X.GE.XTOP(1,IC)) THEN
|
|
DO IFIT = 1,NFIT
|
|
XFIT(IFIT) = XTOP(IFIT,IC)
|
|
SFIT(IFIT) = CTOP(IFIT,IC)
|
|
END DO
|
|
SIGM = YLINTP (X,XFIT,SFIT,NFIT,MFIT)
|
|
SIGM = 1.D-18*EXP(E10*SIGM)
|
|
ENDIF
|
|
SIGK=SIGM
|
|
END IF
|
|
if(iatm(ii).eq.iath.and.ii.gt.n0hn+2.
|
|
* and.ib.le.1.and.fr.lt.fr0(itr)) then
|
|
fr1=fr0pc(ii)
|
|
frdec=min(fr1*1.25,fr0(itr))
|
|
if(fr.gt.fr1.and.fr.lt.frdec)
|
|
* sigk=sigk*(fr-fr1)/(frdec-fr1)
|
|
end if
|
|
c
|
|
RETURN
|
|
C
|
|
C special expression for H-
|
|
C
|
|
40 SIGK=SBFHMI(FR)
|
|
RETURN
|
|
C
|
|
C He I cross-sections
|
|
C
|
|
50 SIGK=SBFHE1(II,IB,FR,G(II))
|
|
RETURN
|
|
C
|
|
C non-standard, user supplied form of cross-section (for IBF < 0)
|
|
C
|
|
60 CALL SPSIGK(IB,FR,SIGSP)
|
|
SIGK=SIGSP
|
|
RETURN
|
|
END
|