code 34361;
    procedure EQILBRCOM(A1, A2, N, EM, D, INT); value N;
    integer N; array A1, A2, EM, D; integer array INT;
    begin integer I, P, Q, J, T, COUNT, EXPONENT, NI, IM, I1;
        real C, R, EPS;
        procedure MOVE(K); value K; integer K;
        begin real DI;
            NI:= Q - P; T:= T + 1; if K ^= I then 
            begin ICHCOL(1, N, K, I, A1); ICHROW(1, N, K, I, A1);
                ICHCOL(1, N, K, I, A2); ICHROW(1, N, K, I, A2);
                DI:= D[I]; D[I]:= D[K]; D[K]:= DI
            end 
        end MOVE;
        EPS:= EM[0] ** 4; T:= P:= 1; Q:= NI:= I:= N;
        COUNT:= EM[6];
        for J:= 1 step 1 until N do 
        begin D[J]:= 1; INT[J]:= 0 end;
        for I:= if I < Q then I + 1 else P while COUNT > 0
        and NI > 0 do 
        begin COUNT:= COUNT - 1; IM:= I - 1; I1:= I + 1;
            C:= TAMMAT(P, IM, I, I, A1, A1) + TAMMAT(I1, Q, I,
            I, A1, A1) + TAMMAT(P, IM, I, I, A2, A2) +
            TAMMAT(I1, Q, I, I, A2, A2);
            R:= MATTAM(P, IM, I, I, A1, A1) + MATTAM(I1, Q, I,
            I, A1, A1) + MATTAM(P, IM, I, I, A2, A2) +
            MATTAM(I1, Q, I, I, A2, A2); if C / EPS <= R then 
            begin INT[T]:= I; MOVE(P); P:= P + 1 end 
            else if R / EPS <= C then 
            begin INT[T]:= - I; MOVE(Q); Q:= Q - 1 end 
            else 
            begin EXPONENT:= LN(R / C) * 0.36067;
                if ABS(EXPONENT) > 1 then 
                begin NI:= Q - P; C:= 2 ** EXPONENT;
                    D[I]:= D[I] * C;
                    for J:= 1 step 1 until IM, I1 step 1
                    until N do 
                    begin A1[J,I]:= A1[J,I] * C;
                        A1[I,J]:= A1[I,J] / C;
                        A2[J,I]:= A2[J,I] * C;
                        A2[I,J]:= A2[I,J] / C
                    end 
                end 
                else NI:= NI - 1
            end 
        end;
        EM[7]:= EM[6] - COUNT
    end EQILBRCOM;
        eop