      subroutine lsdtqli(d,e,n,np,z)

C*******************************************************
C
C This is a double-precision version of the Numerical Recipies
C eigenvalue and eigenvector routine. This can be found on page
C 473 of the Second Edition. This version has the eigenvector
C matrix z passed with anything in it - this matrix does not
C have to contain the unit matrix.
C
C Updated:27/3/95 
C 
C (c) Numerical Recipies
C
C********************************************************
  
      implicit none
      integer n,np
      double precision d(np),e(np),z(np,np)
      integer i,iter,k,l,m
      double precision b,c,dd,f,g,p,r,s,lsdpythag

C This bit I have added to set up a unit matrix...

      do l=1,np
        do k=1,np
          if(k.eq.l) then
            z(k,l)=1.
          else
            z(k,l)=0.
          endif
        enddo
      enddo

      do i=2,n
        e(i-1)=e(i)
      enddo
      e(n)=0.D0
      do l=1,n
        iter=0
 1      do m=l,n-1
          dd=abs(d(m))+abs(d(m+1))
          if (abs(e(m))+dd.eq.dd) goto 2
        enddo
        m=n
 2      if(m.ne.l) then
          if(iter.eq.30)pause 'too many iterations in dctqli'
          iter=iter+1
          g=(d(l+1)-d(l))/(2.D0*e(l))
          r=lsdpythag(g,1.D0)
          g=d(m)-d(l)+e(l)/(g+dsign(r,g))
          s=1.D0
          c=1.D0
          p=0.D0
          do i=m-1,l,-1
            f=s*e(i)
            b=c*e(i)
            r=lsdpythag(f,g)
            e(i+1)=r
            if(r.eq.0.D0) then
              d(i+1)=d(i+1)-p
              e(m)=0.D0
              goto 1
            endif
            s=f/r
            c=g/r
            g=d(i+1)-p
            r=(d(i)-g)*s+2.D0*c*b
            p=s*r
            d(i+1)=g+p
            g=c*r-b
            do k=1,n
              f=z(k,i+1)
              z(k,i+1)=s*z(k,i)+c*f
              z(k,i)=c*z(k,i)-s*f
            enddo
          enddo
          d(l)=d(l)-p
          e(l)=g
          e(m)=0.D0
          goto 1
        endif
      enddo
      return
      end
      



