SUBROUTINE tred2(a,n,np,d,e) INTEGER n,np REAL a(np,np),d(np),e(np) INTEGER i,j,k,l REAL f,g,h,hh,scale do 18 i=n,2,-1 l=i-1 h=0. scale=0. if(l.gt.1)then do 11 k=1,l scale=scale+abs(a(i,k)) 11 continue if(scale.eq.0.)then e(i)=a(i,l) else do 12 k=1,l a(i,k)=a(i,k)/scale h=h+a(i,k)**2 12 continue f=a(i,l) g=-sign(sqrt(h),f) e(i)=scale*g h=h-f*g a(i,l)=f-g f=0. do 15 j=1,l C Omit following line if finding only eigenvalues a(j,i)=a(i,j)/h g=0. do 13 k=1,j g=g+a(j,k)*a(i,k) 13 continue do 14 k=j+1,l g=g+a(k,j)*a(i,k) 14 continue e(j)=g/h f=f+e(j)*a(i,j) 15 continue hh=f/(h+h) do 17 j=1,l f=a(i,j) g=e(j)-hh*f e(j)=g do 16 k=1,j a(j,k)=a(j,k)-f*e(k)-g*a(i,k) 16 continue 17 continue endif else e(i)=a(i,l) endif d(i)=h 18 continue C Omit following line if finding only eigenvalues. d(1)=0. e(1)=0. do 24 i=1,n C Delete lines from here ... l=i-1 if(d(i).ne.0.)then do 22 j=1,l g=0. do 19 k=1,l g=g+a(i,k)*a(k,j) 19 continue do 21 k=1,l a(k,j)=a(k,j)-g*a(k,i) 21 continue 22 continue endif C ... to here when finding only eigenvalues. d(i)=a(i,i) C Also delete lines from here ... a(i,i)=1. do 23 j=1,l a(i,j)=0. a(j,i)=0. 23 continue C ... to here when finding only eigenvalues. 24 continue return END C (C) Copr. 1986-92 Numerical Recipes Software .