code 34194;
    comment MCA 2424;
    integer procedure COMEIG1(A, N, EM, RE, IM, VEC);
    value N; integer N;
    array A, EM, RE, IM, VEC;
    begin integer I, J, K, PJ, ITT;
        real X, Y, MAX, NEPS;
        array AB[1:N,1:N], D, U, V[1:N];
        integer array INT, INT0[1:N];

        procedure TRANSFER;
        begin integer I, J;
            for I:= 1 step 1 until N do 
            for J:= (if I = 1 then 1 else I - 1) step 1
            until N do AB[I,J]:= A[I,J]
        end TRANSFER;

        EQILBR(A, N, EM, D, INT0); TFMREAHES(A, N, EM, INT); TRANSFER;
        K:= COMEIG1:= COMVALQRI(AB, N, EM, RE, IM);
        NEPS:= EM[0] * EM[1]; MAX:= 0; ITT:= 0;
        for I:= K + 1 step 1 until N do 
        begin X:= RE[I]; Y:= IM[I]; PJ:= 0;
         AGAIN: for J:= K + 1 step 1 until I - 1 do 
            begin if ((X - RE[J]) ** 2 +
                (Y - IM[J]) ** 2 <= NEPS ** 2) then 
                begin if PJ = J then NEPS:= EM[2] * EM[1]
                    else PJ:= J; X:= X + 2 * NEPS; goto AGAIN
                end 
            end;
            RE[I]:= X; TRANSFER; if Y ^= 0 then 
            begin COMVECHES(AB, N, RE[I], IM[I], EM, U, V);
                for J:= 1 step 1 until N do VEC[J,I]:= U[J];
                I:= I + 1; RE[I]:= X
            end 
            else REAVECHES(AB, N, X, EM, V);
            for J:= 1 step 1 until N do VEC[J,I]:= V[J];
            if EM[7] > MAX then MAX:= EM[7];
            ITT:= if ITT > EM[9] then ITT else EM[9]
        end;
        EM[7]:= MAX; EM[9]:= ITT; BAKREAHES2(A, N, K + 1, N, INT, VEC);
        BAKLBR(N, K + 1, N, D, INT0, VEC); COMSCL(VEC, N, K + 1, N, IM)
    end COMEIG1;
        eop