
      SUBROUTINE xsgaul(ear, ne, param, ifl, photar, photer)

      INTEGER ne, ifl
      REAL ear(0:ne), param(2), photar(ne), photer(ne)

C---
C XSPEC model subroutine
C Simple gaussian line profile
C---
C see ADDMOD for parameter descriptions
C number of model parameters:2
C       1       EL      line energy (in energy units, e.g. keV)
C       2       W	line width (sigma) (in energy units)
C intrinsic energy range: none
C       N.B. the line may have significant flux at unphysical (i.e. negative)
C            energies when EL<~W.
C algorithm:
C       n(E) = (1./(sqrt(2pi*W*W)) * exp(-0.5*((E-EL)/W)**2)) dE
C       N.B. the norm is equal to the total integrated number of counts in
C            the line.
C       If W is less than or equal to zero, the line is treated as a delta
C            function.
C       N.B. when the energy spacing is much greater than W and the stepsize
C            for EL then the partial derivative determinations can lead
C            to fit error conditions.  The solution is to increase the
C            stepsize for EL
C---
C 17 Dec 1983 - rashafer
C 1.1: An attempt to use simple linear interpolation for the
C      response to better handle very narrow lines.  This
C      is not strictly correct, and effectively the lines will have
C      widths of order of the ear spacing at that point.
C 4/19/98  kaa  Reverted to putting whole line in a single bin if the
C               width is small. This means for lines with width < ear
C               spacing the energy can only be determined to the ear
C               spacing. This change is necessary to determine line widths
C               correctly using high resolution spectroscopy.
C---

      REAL crtsig
      PARAMETER (crtsig=6.0)
      REAL el, w, emin, emax, winv, alow, erf, ahi
      REAL emidie, emidje, delta
      INTEGER ie, ielow, je

c Initialize the model array

      DO ie = 1, ne
         photar(ie) = 0.
      ENDDO

c Calculate the line

      CALL gaussline(ear, ne, param(1), param(2), 1.0, crtsig, 
     &               .FALSE., photar)

      RETURN
      END

c **************************************************************************

      SUBROUTINE gaussline(ear, ne, ecenter, width, norm, crtsig, 
     &                     qspeedy, photar)

      IMPLICIT NONE

      INTEGER ne

      REAL ear(0:ne), photar(ne)
      REAL ecenter, width, norm, crtsig

      LOGICAL qspeedy

c Add the input gaussian line to the photar array. This is broken out from
c the xsgaul function to make it available to other models which may need
c to calculate gaussian line shapes. If qspeedy is true then uses a tabulation
c otherwise does a proper calculation of the erf function.

      REAL emin, emax, winv, alow, ahi
      REAL emidie, emidje, delta
      INTEGER ie, ielow, je, ien

      DOUBLE PRECISION energyfrac
      REAL erf
      INTEGER bisearch
      EXTERNAL erf, bisearch

c first trap case of zero width line

      IF ( width .LE. 0. ) THEN
         ie = bisearch(ne, ear, ecenter)
         IF ( ie .GT. 0 ) photar(ie) = photar(ie) + norm
         RETURN
      ENDIF

c Set the line energy, width and the energy range over which the
c line will be calculated (essentially +/- crtsig sigma)

      width = max(0., width)
      emin = ecenter - crtsig*width
      emax = ecenter + crtsig*width

c If the line calculation energies lie outside the response energy range
c then give up

      IF ( (emax.LT.ear(0)) .OR. (emin.GE.ear(ne)) ) RETURN


c This is the speedy method using tabulated gaussian data

      IF ( qspeedy ) THEN

c Find the bin with the line center. If line center is below first bin then
c don't calculate lower part of the line. If line center is above first bin
c then just calculate part of line within energy range.

         IF ( ecenter .LT. ear(0) ) THEN
            ien = 0
         ELSEIF ( ecenter .GT. ear(ne) ) THEN
            ien = ne
         ELSE
            ien = bisearch(ne, ear, ecenter)
         ENDIF

c Do the low energy part of the line

         ielow = ien
         alow = 0
         DO WHILE ( ielow .GE. 1 )
            ahi = energyfrac(ecenter, width, ear(ielow-1))
            IF ( ahi .GE. 0. ) THEN
                photar(ielow) = photar(ielow) +
     &                   (ahi-alow)*0.5*norm
            ELSE

c Too many sigma away so stop now and add the rest of the Gaussian into this
c bin. Not strictly correct but shouldn't matter and ensures that the total
c flux is preserved.

               photar(ielow) = photar(ielow) +
     &                      (1.-alow)*0.5*norm
               ielow = 1
            ENDIF
            alow = ahi
            ielow = ielow - 1
         ENDDO

c Find the bin with the line center. If line center is above the last bin then
c don't calculate upper part of the line. If line center is below first bin
c then just calculate part of line within energy range.

         IF ( ecenter .LT. ear(0) ) THEN
            ien = 1
         ELSEIF ( ecenter .GT. ear(ne) ) THEN
            ien = ne + 1
         ELSE
            ien = bisearch(ne, ear, ecenter)
         ENDIF

c Do the high energy part of the line

         ielow = ien
         alow = 0
         DO WHILE ( ielow .LE. ne )
            ahi = energyfrac(ecenter, width, ear(ielow))
            IF ( ahi .GE. 0. ) THEN
               photar(ielow) = photar(ielow) +
     &                 (ahi-alow)*0.5*norm
            ELSE

c Too many sigma away so stop now and add the rest of the Gaussian into this
c bin. Not strictly correct but shouldn't matter and ensures that the total
c flux is preserved.

               photar(ielow) = photar(ielow) +
     &                  (1.-alow)*0.5*norm
               ielow = ne
            ENDIF
            alow = ahi
            ielow = ielow + 1
         ENDDO

c and this is the slower method using erf calculation.

      ELSE

         winv = 1./width/sqrt(2.)

c If there is part of the gaussian below the response energy range then
c store that in alow.

         ielow = 0
         IF (emin.LE.ear(0)) THEN
            alow = 0.5*erf(winv*(ear(0)-ecenter))
            ielow = -1
            ie = 1
         ELSE
            alow = -0.5
         ENDIF

c find the start of the line

         IF (ielow.EQ.0) ielow = bisearch(ne, ear, emin)
         IF (ielow .NE. -1) ie = ielow

c integrate the gaussian for the energy ranges covering the line

         DO WHILE (ear(ie).LT.emax)
            ahi = 0.5*erf(winv*(ear(ie)-ecenter))
            photar(ie) = photar(ie) + norm*(ahi - alow)
            alow = ahi
            ie = ie + 1
            IF (ie.GT.ne) RETURN
         ENDDO

c if all of the model was in a single bin

         IF (ie.EQ.ielow) THEN
            photar(ie) = photar(ie) + norm
         ELSE
            photar(ie) = photar(ie) + norm*(0.5 - alow)
         ENDIF

      ENDIF

      RETURN
      END

c ****************************************************************
      FUNCTION energyfrac(linecentre, linewidth, energy)

      IMPLICIT NONE

      DOUBLE PRECISION energyfrac
      REAL linecentre, linewidth, energy

c Function to return amount of energy emitted between line centre and energy

      DOUBLE PRECISION sigma
      INTEGER minindex
      DOUBLE PRECISION remainder

      INTEGER GAUSSMAXSTEP
      DOUBLE PRECISION GAUSSMAX, GAUSSSTEP
      PARAMETER (GAUSSMAXSTEP=30)
      PARAMETER (GAUSSMAX=3)
      PARAMETER (GAUSSSTEP=GAUSSMAX*1.0/GAUSSMAXSTEP)

      DOUBLE PRECISION intGaus(0:GAUSSMAXSTEP)

c Integrated Gaussian probability distribution (x=0->3 in steps of 0.1)

      DATA intGaus /0, 0.07965567455405775, 0.1585194188782062,
     & 0.23582284437790513, 0.3108434832206486, 0.38292492254802624, 
     & 0.4514937644998527, 0.5160726955538542, 0.5762892028332065,
     & 0.6318797493064812, 0.6826894921370861, 0.7286678781072344,
     & 0.7698606595565836, 0.8063990308287794, 0.8384866815324581,
     & 0.8663855974622838, 0.8904014166008838, 0.910869074482914,
     & 0.9281393617741482, 0.9425668803679965, 0.9544997361036416,
     & 0.9642711588743671, 0.9721931049730028, 0.9785517799566483,
     & 0.9836049281508079, 0.9875806693484477, 0.9906776239525625,
     & 0.9930660523939188, 0.9948897393391443, 0.9962683733992319,
     & 0.9973002039367398/

c Compute how many sigmas away we are
      sigma = abs( (energy-linecentre)/linewidth )

c Now interpolate from the table
      minindex = INT(sigma/GAUSSSTEP)

c If we're past the edge of the tabulated data return -1.
      IF ( minindex .GE. GAUSSMAXSTEP ) THEN
         energyfrac = -1
         RETURN
      ENDIF

      remainder = (sigma - DBLE(minindex)*GAUSSSTEP) * (1./GAUSSSTEP)

c Do the interpolation
      energyfrac = (1.-remainder)*intGaus(minindex) +
     &             remainder*intGaus(minindex+1)

      RETURN
      END

c ******************************************************************

      FUNCTION bisearch(ne, ear, energy)

      INTEGER bisearch, ne
      REAL ear(0:ne), energy

c Function to do a bisection search for which element of the energy array
c the input energy lies in.

      INTEGER low, high


      IF ( energy .LT. ear(0) .OR. energy .GT. ear(ne) ) THEN
         bisearch = -1
         RETURN
      ENDIF

      low = 0
      high = ne

      DO WHILE ( (high-low) .GT. 1 )

         bisearch = (low + high) / 2
         IF ( energy .GT. ear(bisearch-1) ) THEN
            low = bisearch
         ELSE
            high = bisearch
         ENDIF

      ENDDO

      bisearch = low

      RETURN
      END


