code 34320;
procedure DECBND(A, N, LW, RW, AUX, M, P); value N, LW, RW;
integer N, LW, RW; integer array P; array A, M, AUX;
begin integer I, J, K, KK, KK1, PK, MK, IK, LW1, F, Q, W, W1,
W2, NRW, IW, SDET;
real R, S, EPS, MIN;
array V[1:N];
F:= LW; W1:= LW + RW; W:= W1 + 1; W2:= W - 2; IW:= 0; SDET:= 1;
NRW:= N - RW; LW1:= LW + 1; Q:= LW - 1;
for I:= 2 step 1 until LW do
begin Q:= Q - 1; IW:= IW + W1;
for J:= IW - Q step 1 until IW do A[J]:= 0
end;
IW:= - W2; Q:= - LW;
for I:= 1 step 1 until N do
begin IW:= IW + W; if I <= LW1 then IW:= IW - 1;
Q:= Q + W; if I > NRW then Q:= Q - 1;
V[I]:= SQRT(VECVEC(IW, Q, 0, A, A))
end;
EPS:= AUX[2]; MIN:= 1; KK:= - W1; MK:= - LW;
if F > NRW then W2:= W2 + NRW - F;
for K:= 1 step 1 until N do
begin if F < N then F:= F + 1; IK:= KK:= KK + W;
MK:= MK + LW; S:= ABS(A[KK]) / V[K]; PK:= K; KK1:= KK + 1;
for I:= K + 1 step 1 until F do
begin IK:= IK + W1; M[MK + I - K]:= R:= A[IK]; A[IK]:= 0;
R:= ABS(R) / V[I]; if R > S then
begin S:= R; PK:= I end
end;
if S < MIN then MIN:= S; if S < EPS then
begin AUX[3]:= K - 1; AUX[5]:= S; "GO TO" END end;
if K + W2 >= N then W2:= W2 - 1;
P[K]:= PK; if PK ^= K then
begin V[PK]:= V[K];
PK:= PK - K; ICHVEC(KK1, KK1 + W2, PK * W1, A);
SDET:= - SDET; R:= M[MK + PK]; M[MK + PK]:= A[KK];
A[KK]:= R
end else R:= A[KK]; if R < 0 then SDET:= - SDET;
IW:= KK1; LW1:= F - K + MK;
for I:= MK + 1 step 1 until LW1 do
begin M[I]:= S:= M[I] / R; IW:= IW + W1;
ELMVEC(IW, IW + W2, KK1 - IW, A, A, - S)
end
end;
AUX[3]:= N; AUX[5]:= MIN;
END: AUX[1]:= SDET
end DECBND;
eop