code 34366;
    procedure HSHCOMHES(AR, AI, N, EM, B, TR, TI, DEL); value N;
    integer N; array AR, AI, EM, B, TR, TI, DEL;
    begin integer R, RM1, I, J, NM1;
        real TOL, T, XR, XI;
        NM1:= N - 1; TOL:= (EM[0] * EM[1]) ** 2; RM1:= 1;
        for R:= 2 step 1 until NM1 do 
        begin if HSHCOMCOL(R, N, RM1, AR, AI, TOL, B[RM1],
            TR[R], TI[R], T) then 
            begin for I:= 1 step 1 until N do 
                begin XR:= (MATMAT(R, N, I, RM1, AI, AI) -
                    MATMAT(R, N, I, RM1, AR, AR)) / T;
                    XI:= ( - MATMAT(R, N, I, RM1, AR, AI) -
                    MATMAT(R, N, I, RM1, AI, AR)) / T;
                    ELMROWCOL(R, N, I, RM1, AR, AR, XR);
                    ELMROWCOL(R, N, I, RM1, AR, AI, XI);
                    ELMROWCOL(R, N, I, RM1, AI, AR, XI);
                    ELMROWCOL(R, N, I, RM1, AI, AI, - XR)
                end;
                HSHCOMPRD(R, N, R, N, RM1, AR, AI, AR, AI, T);
            end;
            DEL[RM1]:= T; RM1:= R
        end FORR;
        if N > 1 then CARPOL(AR[N,NM1], AI[N,NM1], B[NM1],
        TR[N], TI[N]); RM1:= 1; TR[1]:= 1; TI[1]:= 0;
        for R:= 2 step 1 until N do 
        begin COMMUL(TR[RM1], TI[RM1], TR[R], TI[R], TR[R],
            TI[R]); COMCOLCST(1, RM1, R, AR, AI, TR[R], TI[R]);
            COMROWCST(R + 1, N, R, AR, AI, TR[R], - TI[R]);
            RM1:= R
        end;
    end HSHCOMHES

        eop