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