begin comment eigenvalues of a real symmetric matrix by the QR method. Algorithm 253, P.A. Businger, CACM 8 (1965) 217; integer n; n ≔ read; begin integer i,j; real array a[1:n,1:n]; procedure symmetric QR1(n,g); value n; integer n; array g; comment uses Housholders.s method and the QR algorithm to find all n eigenvalues of the real symmetric matrix whose lower triangular part is given in the array g[1:n,1:n]. The computed eigenvalues are stored as the diagonal elements g[i,i]. The original contents of the lower triangular part of g are lost during the computation whereas the strictly upper triagular part of g is left untouched; begin real procedure sum(i,m,n,a); value m,n; integer i,m,n; real a; begin real s; s ≔ 0; for i ≔ m step 1 until n do s ≔ s + a; sum ≔ s end sum; real procedure max (a,b); value a,b; real a,b; max ≔ if a > b then a else b; procedure Housholder tridiagonalization 1(n,g,a,bq,norm); value n; integer n; array g,a,bq; real norm; comment nonlocal real procedure sum, max; comment reduces the given real symmetric n by n matrix g to tridiagonal form using n - 2 elementary orthogonal trans- formations (I-2ww.) = (I-gamma uu.). Only the lower tri angular part of g need be given. The diagonal elements and the squares of the subdiagonal elements of the reduced matrix are stored in a[1:n] and bq[1:n-1] respectively. norm is set equal to the infinity norm of the reduced matrix. The columns of the strictly lower triagular part of g are replaced by the nonzero portions of the vectors u; begin integer i,j,k; real t,absb,alpha,beta,gamma,sigma; array p[2:n]; norm ≔ absb ≔ 0; for k ≔ 1 step 1 until n - 2 do begin a[k] ≔ g[k,k]; sigma ≔ bq[k] ≔ sum(i,k+1,n,g[i,k]⭡2); t ≔ absb + abs(a[k]); absb ≔ sqrt(sigma); norm ≔ max(norm,t+absb); if sigma ≠ 0 then begin alpha ≔ g[k+1,k]; beta ≔ if alpha < 0 then absb else - absb; gamma ≔ 1 / (sigma-alpha×beta); g[k+1,k] ≔ alpha - beta; for i ≔ k + 1 step 1 until n do p[i] ≔ gamma × (sum(j,k+1,i,g[i,j]×g[j,k]) + sum(j,i+1,n,g[j,i]×g[j,k])); t ≔ 0·5 × gamma × sum(i,k+1,n,g[i,k]×p[i]); for i ≔ k + 1 step 1 until n do p[i] ≔ p[i] - t×g[i,k]; for i ≔ k + 1 step 1 until n do for j ≔ k + 1 step 1 until i do g[i,j] ≔ g[i,j] - g[i,k]×p[j] - p[i]×g[j,k] end end k; a[n-1] ≔ g[n-1,n-1]; bq[n-1] ≔ g[n,n-1]⭡2; a[n] ≔ g[n,n]; t ≔ abs(g[n,n-1]); norm ≔ max(norm,absb+abs(a[n-1])+t); norm ≔ max(norm,t+abs(a[n])) end Housholder tridiagonalization 1; integer i,k,m,m1; real norm,epsq,lambda,mu,sq1,sq2,u,pq,gamma,t; array a[1:n],bq[0:n-1]; Housholder tridiagonalization 1(n,g,a,bq,norm); epsq ≔ 2·25÷-22×norm⭡2; comment The tollerance used in the QR iteration depends on the square of the relative machine precision. Here 2.25%-22 is used which is appropriate for a machine with a 36-bit mantissa; mu ≔ 0; m ≔ n; inspect: if m = 0 then goto return else i ≔ k ≔ m1 ≔ m - 1; bq[0] ≔ 0; if bq[k] < epsq then begin g[m,m] ≔ a[m]; mu ≔ 0; m ≔ k; goto inspect end; for i ≔ i - 1 while bq[i] > epsq do k ≔ i; if k = m1 then begin comment treat 2 * 2 block separately; mu ≔ a[m1]×a[m] - bq[m1]; sq1 ≔ a[m1] + a[m]; sq2 ≔ sqrt((a[m1]-a[m])⭡2+4×bq[m1]); lambda ≔ 0·5×(if sq1>0 then sq1+sq2 else sq1-sq2); g[m1,m1] ≔ lambda; g[m,m] ≔ mu / lambda; mu ≔ 0; m ≔ m - 2; goto inspect end; lambda ≔ if abs(a[m]-mu) < 0·5×abs(a[m]) then a[m] + 0·5×sqrt(bq[m1]) else 0·0; mu ≔ a[m]; sq1 ≔ sq2 ≔ u ≔ 0; for i ≔ k step 1 until m1 do begin comment shortcut single QR iteration; gamma ≔ a[i] - lambda - u; pq ≔ if sq1 ≠ 1 then gamma⭡2/(1-sq1) else (1-sq2)×bq[i-1]; t ≔ pq + bq[i]; bq[i-1] ≔ sq1 × t; sq2 ≔ sq1; sq1 ≔ bq[i] / t; u ≔ sq1 × (gamma+a[i+1]-lambda); a[i] ≔ gamma + u + lambda end i; gamma ≔ a[m] - lambda - u; bq[m1] ≔ sq1 × (if sq1≠1 then gamma⭡2/(1-sq1) else (1-sq2)×bq[m1]); a[m] ≔ gamma + lambda; goto inspect; return: end symmetric QR 1; for i ≔ 1 step 1 until n do for j ≔ 1 step 1 until i do a[i,j] ≔ read; symmetric QR 1(n,a); for i ≔ 1 step 1 until n do begin NLCR; ABSFIXT(2,0,i); PRINT(a[i,i]) end end end