code 34426;
procedure DECTRIPIV(SUB, DIAG, SUPER, N, AID, AUX, PIV);
value N; integer N; array SUB, DIAG, SUPER, AID, AUX;
boolean array PIV;
begin integer I, I1, N1, N2;
real D, R, S, U, T, Q, V, W, NORM, NORM1, NORM2, TOL;
TOL:= AUX[2]; D:= DIAG[1]; R:= SUPER[1];
NORM:= NORM2:= ABS(D) + ABS(R); N2:= N - 2;
for I:= 1 step 1 until N2 do
begin I1:= I + 1; S:= SUB[I]; T:= DIAG[I1]; Q:= SUPER[I1];
NORM1:= NORM2; NORM2:= ABS(S) + ABS(T) + ABS(Q);
if NORM2 > NORM then NORM:= NORM2;
if ABS(D) * NORM2 < ABS(S) * NORM1 then
begin if ABS(S) <= TOL * NORM2 then
begin AUX[3]:= I - 1; AUX[5]:= S; goto EXIT end;
DIAG[I]:= S; U:= SUPER[I]:= T / S;
V:= AID[I]:= Q / S; SUB[I]:= D;
W:= SUPER[I1]:= -V * D; D:= DIAG[I1]:= R - U * D;
R:= W; NORM2:= NORM1; PIV[I]:= true
end else
begin if ABS(D) <= TOL * NORM1 then
begin AUX[3]:= I - 1; AUX[5]:= D; goto EXIT end;
U:= SUPER[I]:= R / D; D:= DIAG[I1]:= T - U * S;
AID[I]:= 0; PIV[I]:= false; R:= Q
end
end;
N1:= N - 1; S:= SUB[N1]; T:= DIAG[N]; NORM1:= NORM2;
NORM2:= ABS(S) + ABS(T); if NORM2 > NORM then NORM:= NORM2;
if ABS(D) * NORM2 < ABS(S) * NORM1 then
begin if ABS(S) <= TOL * NORM2 then
begin AUX[3]:= N2; AUX[5]:= S; goto EXIT end;
DIAG[N1]:= S; U:= SUPER[N1]:= T / S; SUB[N1]:= D;
D:= DIAG[N]:= R - U * D; NORM2:= NORM1; PIV[N1]:= true
end else
begin if ABS(D) <= TOL * NORM1 then
begin AUX[3]:= N2; AUX[5]:= D; goto EXIT end;
U:= SUPER[N1]:= R / D; D:= DIAG[N]:= T - U * S;
PIV[N1]:= false
end;
if ABS(D) <= TOL * NORM2 then
begin AUX[3]:= N1; AUX[5]:= D; goto EXIT end;
AUX[3]:= N; AUX[5]:= NORM;
EXIT:
end DECTRIPIV;
eop