code 34184; comment MCA 2414; integer procedure REAEIG1(A, N, EM, VAL, VEC); value N; integer N; array A, EM, VAL, VEC; begin integer I, K, MAX, J, L; real RESIDU, R, MACHTOL; array D, V[1:N], B[1:N,1:N]; integer array INT, INT0[1:N]; RESIDU:= 0; MAX:= 0; EQILBR(A, N, EM, D, INT0); TFMREAHES(A, N, EM, INT); for I:= 1 step 1 until N do for J:= (if I = 1 then 1 else I - 1) step 1 until N do B[I,J]:= A[I,J]; K:= REAEIG1:= REAVALQRI(B, N, EM, VAL); for I:= K + 1 step 1 until N do for J:= I + 1 step 1 until N do begin if VAL[J] > VAL[I] then begin R:= VAL[I]; VAL[I]:= VAL[J]; VAL[J]:= R end end; MACHTOL:= EM[0] * EM[1]; for L:= K + 1 step 1 until N do begin if L > 1 then begin if VAL[L - 1] - VAL[L] < MACHTOL then VAL[L]:= VAL[L - 1] - MACHTOL end; for I:= 1 step 1 until N do for J:= (if I = 1 then 1 else I - 1) step 1 until N do B[I,J]:= A[I,J]; REAVECHES(B, N, VAL[L], EM, V); if EM[7] > RESIDU then RESIDU:= EM[7]; if EM[9] > MAX then MAX:= EM[9]; for J:= 1 step 1 until N do VEC[J,L]:= V[J] end; EM[7]:= RESIDU; EM[9]:= MAX; BAKREAHES2(A, N, K + 1, N, INT, VEC); BAKLBR(N, K + 1, N, D, INT0, VEC); REASCL(VEC, N, K + 1, N) end REAEIG1 eop