code 34170;
    comment MCA 2400;
    procedure TFMREAHES(A, N, EM, INT); value N; integer N;
     array A, EM; integer array INT;
    begin integer I, J, J1, K, L;
        real S, T, MACHTOL, MACHEPS, NORM;
         array B[0:N - 1];

        MACHEPS:= EM[0]; NORM:= 0;
        for I:= 1 step 1 until N do 
        begin S:= 0;
            for J:= 1 step 1 until N do S:= S + ABS(A[I,J]);
            if S > NORM then NORM:= S
        end;
        EM[1]:= NORM; MACHTOL:= NORM * MACHEPS; INT[1]:= 0;
        for J:= 2 step 1 until N do 
        begin J1:= J - 1; L:= 0; S:= MACHTOL;
            for K:= J + 1 step 1 until N do 
            begin T:= ABS(A[K,J1]); if T > S then 
                begin L:= K; S:= T end 
            end;
            if L ^= 0 then 
            begin if ABS(A[J,J1]) < S then 
                begin ICHROW(1, N, J, L, A);
                    ICHCOL(1, N, J, L, A)
                end 
                else L:= J; T:= A[J,J1];
                for K:= J + 1 step 1 until N do 
                A[K,J1]:= A[K,J1] / T
            end 
            else 
            for K:= J + 1 step 1 until N do A[K,J1]:= 0;
            for I:= 1 step 1 until N do 
            B[I - 1]:= A[I,J]:= A[I,J] +
            (if L = 0 then 0 else MATMAT(J + 1, N, I, J1, A, A))-
            MATVEC(1, if J1 < I - 2 then J1 else I - 2, I, A, B);
            INT[J]:= L
        end 
    end TFMREAHES

        eop