git push -u origin main
This commit is contained in:
@@ -0,0 +1,171 @@
|
||||
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
|
||||
Reference in New Issue
Block a user