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

      implicit none

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

      CHARACTER*255 filenm

      integer MAXAR
      parameter (MAXAR = 1000)

      real eparam(9)
      real ephotar(MAXAR),p(MAXAR),ephoter(MAXAR),e(0:MAXAR),pcon(MAXAR)
      real emin, emax, elo, ehi, z, de
      real e1, e2
      logical firstcall,ccheck
      INTEGER i, nex, ix, jx
      
      save firstcall
      data firstcall/.true./


c This model convolves the input spectrum with
c the line profile from a Keplerian Accretion disk around
c both Schwarzschild & Kerr (arbitrary spin) black holes.
c
c It requires the use of an extensive set of transfer functions, which must be
c downloaded from the XSPEC website. These transfer functions should be placed
c in $LHEASOFT/../spectral/xspec/manager/XSKDLINE/
c
c It is not called directly from XSPEC, rather, it is called by the files
c xskdcN. Here, N is either 0 or 1 and denotes different modes of operation for
c the model. The convolution is performed by performing multiple calls to
c xskdline.f, which generates the convolution kernel, which is then used to
c determine the blurring of each energy bin. For further information how each 
c of the modes works, consult xskdcN.f, xskdline.f as appropriate.
c
c Finally, the user should note that chatter>=12 will case the model to dump
c the current line parameters to the screen

c=============

      if (firstcall) then
         write(*,*) 'this is a convolution model by Chris Done'
         write(*,*) 'USE THE EXTEND COMMAND'
         firstcall=.false.
      end if

c Extend energy array
      nex=MAXAR
      emin = log10(0.5 * ear(1))
      emax = log10(2.0 * ear(ne))
      de = (emax - emin) / real(nex)
      do ix = 0, nex
         e(ix) = 10.0**(emin + ix * de)
      end do
      
c     rebin old spectrum on new energy array
      i = 1
      do ix = 1, nex
         p(ix) = 0.0
         pcon(ix)=0.0
         emin = e(ix - 1)
         emax = e(ix)

c        only do if overlap on grid - otherwise keep p(ix)=0
         if (emin.gt.ear(0).and.emin.lt.ear(ne-1)) then
            do while(ear(i) < emin)
               i = i + 1
            end do

            do while(ear(i - 1) < emax)
               e1 = max(ear(i - 1), emin)
               e2 = min(ear(i), emax)
               p(ix) = p(ix) + photar(i) * (e2 - e1)/(ear(i)-ear(i-1))
               i = i + 1
            end do
            i = i - 1
         end if
      end do


c     set line parameters
      eparam(2)=param(1)
      eparam(3)=param(2)
      eparam(4)=param(3)
      eparam(5)=param(4)
      eparam(6)=param(5)
      eparam(7)=param(6)
      eparam(8)=param(7)
      eparam(9)=param(8)

c  convolution with kdline
      do ix=1,nex,1
         ccheck=.FALSE.
         If (ix.EQ.1) ccheck=.TRUE.
         eparam(1)=0.5*(e(ix)+e(ix-1))
         call xskdline (ccheck, e, nex, eparam, ifl,ephotar,ephoter)
         do jx=1,nex,1
            pcon(jx)=pcon(jx)+p(ix)*ephotar(jx)
         end do
         param(1)=eparam(2)
         param(2)=eparam(3)
         param(3)=eparam(4)
         param(4)=eparam(5)
         param(5)=eparam(6)
         param(6)=eparam(7)
         param(7)=eparam(8)
      end do

c rebinning
      ix = 1
      do i = 1, ne
         photar(i) = 0.0
         emin = ear(i - 1)
         emax = ear(i)
         do while(e(ix) < emin)
           ix = ix + 1
         end do

         do while(e(ix - 1) < emax)
           e1 = max(e(ix - 1), emin)
           e2 = min(e(ix), emax)
           photar(i) = photar(i) + pcon(ix) * (e2 - e1)/(e(ix)-e(ix-1))
           ix = ix + 1
         end do
         ix = ix - 1

      end do

      RETURN
      END
