code 34364;
    procedure HSHHRMTRIVAL(A, N, D, BB, EM); value N; integer N;
     array A, D, BB, EM;
    begin integer I, J, J1, JM1, R, RM1;
        real NRM, W, TOL2, X, AR, AI, H, T, Q, AJR, ARJ, DJ,
        BBJ, MOD2;
        NRM:= 0;
        for I:= 1 step 1 until N do 
        begin W:= ABS(A[I,I]);
            for J:= I - 1 step - 1 until 1, I + 1 step 1
            until N do W:= W + ABS(A[I,J]) + ABS(A[J,I]);
            if W > NRM then NRM:= W
        end I;
        TOL2:= (EM[0] * NRM) ** 2; EM[1]:= NRM; R:= N;
        for RM1:= N - 1 step - 1 until 1 do 
        begin X:= TAMMAT(1, R - 2, R, R, A, A) + MATTAM(1, R -
            2, R, R, A, A); AR:= A[RM1,R]; AI:= - A[R,RM1];
            D[R]:= A[R,R];
            if X < TOL2 then BB[RM1]:= AR * AR + AI * AI else 
            begin MOD2:= AR * AR + AI * AI; if MOD2 = 0 then 
                begin A[RM1,R]:= SQRT(X); T:= X end 
                else 
                begin X:= X + MOD2; H:= SQRT(MOD2 * X);
                    T:= X + H; H:= 1 + X / H;
                    A[R,RM1]:= - AI * H; A[RM1,R]:= AR * H;
                end;
                J:= 1; JM1:= 0;
                for J1:= 2 step 1 until R do 
                begin D[J]:= (TAMMAT(1, J, J, R, A, A) +
                    MATMAT(J1, RM1, J, R, A, A) + MATTAM(1,
                    JM1, J, R, A, A) - MATMAT(J1, RM1, R, J,
                    A, A)) / T;
                    BB[J]:= (MATMAT(1, JM1, J, R, A, A) -
                    TAMMAT(J1, RM1, J, R, A, A) - MATMAT(1, J,
                    R, J, A, A) - MATTAM(J1, RM1, J, R, A, A))
                    / T; JM1:= J; J:= J1
                end J1;
                Q:= (TAMVEC(1, RM1, R, A, D) - MATVEC(1, RM1,
                R, A, BB)) / T / 2;
                ELMVECCOL(1, RM1, R, D, A, - Q);
                ELMVECROW(1, RM1, R, BB, A, Q); J:= 1;
                for J1:= 2 step 1 until R do 

                begin AJR:= A[J,R]; ARJ:= A[R,J]; DJ:= D[J];
                    BBJ:= BB[J];
                    ELMROWVEC(J, RM1, J, A, D, - AJR);
                    ELMROWVEC(J, RM1, J, A, BB, ARJ);
                    ELMROWCOL(J, RM1, J, R, A, A, - DJ);
                    ELMROW(J, RM1, J, R, A, A, BBJ);
                    ELMCOLVEC(J1, RM1, J, A, D, - ARJ);
                    ELMCOLVEC(J1, RM1, J, A, BB, - AJR);
                    ELMCOL(J1, RM1, J, R, A, A, BBJ);
                    ELMCOLROW(J1, RM1, J, R, A, A, DJ); J:= J1;
                end J1;
                BB[RM1]:= X;
            end;
            R:= RM1;
        end RM1;
        D[1]:= A[1,1];
    end HSHHRMTRIVAL;
        eop