SUBROUTINE tqli(d,e,n,np,z) 1,7
USE RAD_BIAS
IMPLICIT NONE
INTEGER, INTENT(IN) :: n,np
! REAL(KIND=LONG), INTENT(OUT) :: d(np),e(np),z(np,np)
REAL(KIND=LONG) :: d(np),e(np),z(np,np)
! USES pythag
INTEGER i,iter,k,l,m
REAL(KIND=LONG) :: b,c,dd,f,g,p,r,s,pythag
do i=2,n
e(i-1)=e(i)
end do
e(n)=0.
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
end do
m=n
2 if(m.ne.l)then
if(iter.eq.30)pause 'too many iterations in tqli'
iter=iter+1
g=(d(l+1)-d(l))/(2.*e(l))
r=pythag
(g,1.)
g=d
(m)-d(l)+e(l)/(g+sign(r,g))
s=1.
c=1.
p=0.
do i=m-1,l,-1
f=s*e(i)
b=c*e(i)
r=pythag
(f,g)
e(i+1)=r
if(r.eq.0.)then
d(i+1)=d
(i+1)-p
e(m)=0.
goto 1
endif
s=f/r
c=g/r
g=d
(i+1)-p
r=(d(i)-g)*s+2.*c*b
p=s*r
d(i+1)=g+p
g=c*r-b
! Omit lines from here ...
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
end do
! ... to here when finding only eigenvalues.
end do
d(l)=d
(l)-p
e(l)=g
e(m)=0.
goto 1
endif
end do
return
END SUBROUTINE tqli