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

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

      INCLUDE 'xspec.inc'

c Subroutine to smooth the model spectrum by relativistic effects from a
c disk - xsdili. 
c ACF and RMJ May/June 1998
c
cc Updated by LB, Feb. 2006

c Arguments :
c    ear      r        i: Energy ranges
c    ne       i        i: Number of elements in photar array
c    param    r        i: Model parameters

c  parameters :
c       1        power law index for emissivity (10 for disk)
c       2        inner radius (GM/c**2)
c       3        outer radius (GM/c**2)
c       4        inclination  (degrees)

c    ifl      i        i: Data set
c    photar   r      i/r: Model flux


      INTEGER itmp, MAXB, HALFMAXB
      PARAMETER (MAXB=3000,HALFMAXB=MAXB/2)

      REAL energy, fact, sigma, sum,earb(0:MAXB)
      REAL paramb(9),photarb(MAXB),photerb(MAXB),energyb,delen
      REAL sum1, r1, r2

      INTEGER ie, je, ierr, oldne,ifrac,i,ifrac1,ifrac2
      INTEGER if, if1, if2

      CHARACTER contxt*80

      LOGICAL first

      SAVE itmp, oldne, ierr
      DATA itmp, oldne/2*-1/
      save first,earb
      DATA first/.true./
      if (first) then
         do i=0,MAXB
           earb(i)=20.0*float(i)/float(MAXB)
         end do
         first=.false.
      end if
      paramb(1)=10.0
      paramb(2)=param(1)
      paramb(3)=param(2)
      paramb(4)=param(3)
      paramb(5)=param(4)
      paramb(6)=param(5)
      paramb(7)=param(6)
      paramb(8)=param(7)
      paramb(9)=0.0
      call spin(earb,MAXB,paramb,ifl,photarb,photerb)

      IF ( itmp .EQ. -1 .OR. Ne. NE. oldne ) THEN
         CALL udmget(Ne, 6, itmp, ierr)
         contxt = 'Failed to get memory for tmp'
         IF ( ierr .NE. 0 ) GOTO 999
         oldne = Ne
       ENDIF

       do ie=0,ne-1
         MEMR(itmp+ie)=0.0
       enddo

c Loop over energy ranges for the current dataset
      
	sum=0.
	do i=1,maxb
	  sum=sum+photarb(i)
	enddo
	do i=1,maxb
	  photarb(i)=photarb(i)/sum
	enddo

	do ie=1,ne
	  energy=0.5*(ear(ie-1)+ear(ie))
	  do je=1,ne
   	     f1=ear(je-1)/energy*float(halfmaxb)
     &	     	*(1.+1./float(halfmaxb))	
     	     f2=ear(je)/energy*float(halfmaxb)
     &	     	*(1.+1./float(halfmaxb))    
	     if1=f1
	     r1=f1-if1
	     if2=f2
	     r2=f2-if2
	     sum=0.0

             do if=if1+1,if2-1
                if(if.ge.1.and.if.le.maxb)then
	           sum=sum+photarb(if)
	        endif
             end do
             
             if(if1.ge.1.and.if1.le.maxb)then
               sum=sum+(1.0-r1)*photarb(if1)
             end if
             
             if(if2.ge.1.and.if2.le.maxb)then
                sum=sum+(r2)*photarb(if2)
             end if
             
             if (if1 .eq. if2) then
               if(if1.ge.1.and.if1.le.maxb)then
                 sum=sum-photarb(if1)
               end if
             end if
             
	     memr(itmp+je-1)=memr(itmp+je-1)+photar(ie)*sum
	  enddo
	enddo


      open(7,file='kerrconv.dat',status='unknown')

      DO ie = 1, ne
         photar(ie) = MEMR(itmp+ie-1)
         write(7,*) ie,photar(ie)
      ENDDO

      close(7)

 999  CONTINUE
      IF ( ierr .NE. 0 ) THEN
         CALL xwrite(contxt, 10)
      ENDIF

      RETURN
      END

