code 34260;
procedure HSHREABID(A, M, N, D, B, EM);
value M, N; integer M, N; array A, D, B, EM;
begin integer I, J, I1;
    real NORM, MACHTOL, W, S, F, G, H;

    NORM:= 0;
    for I:= 1 step 1 until M do 
    begin W:= 0;
        for J:= 1 step 1 until N do W:= ABS(A[I,J]) + W;
        if W > NORM then NORM:= W
    end;
    MACHTOL:= EM[0] * NORM; EM[1]:= NORM;
    for I:= 1 step 1 until N do 
    begin I1:= I + 1; S:= TAMMAT(I1, M, I, I, A, A);
        if S < MACHTOL then D[I]:= A[I,I] else 
        begin F:= A[I,I]; S:= F * F + S;
            D[I]:= G:= if F < 0 then SQRT(S) else - SQRT(S);
            H:= F * G - S; A[I,I]:= F - G;
            for J:= I1 step 1 until N do 
            ELMCOL(I, M, J, I, A, A, TAMMAT(I, M, I, J, A, A) / H)
        end;
        if I < N then 
        begin S:= MATTAM(I1 + 1, N, I, I, A, A);
            if S < MACHTOL then B[I]:= A[I,I1] else 
            begin F:= A[I,I1]; S:= F * F + S;
                B[I]:= G:= if F < 0 then SQRT(S) else - SQRT(S);
                H:= F * G - S; A[I,I1]:= F - G;
                for J:= I1 step 1 until M do 
                ELMROW(I1, N, J, I, A, A, MATTAM(I1, N, I, J, A, A) /
                H)
            end 
        end 
    end 
end HSHREABID

        eop