code 34322; procedure DECSOLBND(A, N, LW, RW, AUX, B); value N, LW, RW; integer N, LW, RW; array A, B, AUX; begin integer I, J, K, KK, KK1, PK, IK, LW1, F, Q, W, W1, W2,IW, NRW, SHIFT, SDET; real R, S, EPS, MIN; array M[0:LW], V[1:N]; F:= LW; SDET:= 1; W1:= LW + RW; W:= W1 + 1; W2:= W - 2; IW:= 0; 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; 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; 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[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; if PK ^= K then begin V[PK]:= V[K]; PK:= PK - K; ICHVEC(KK1, KK1 + W2, PK * W1, A); SDET:= - SDET; R:= B[K]; B[K]:= B[PK + K]; B[PK + K]:= R; R:= M[PK]; M[PK]:= A[KK]; A[KK]:= R end else R:= A[KK]; IW:= KK1; LW1:= F - K; if R < 0 then SDET:= - SDET; for I:= 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); B[K + I]:= B[K + I] - B[K] * S end end; AUX[3]:= N; AUX[5]:= MIN; KK:= (N + 1) * W - W1; W2:= - 1; SHIFT:= N * W1; for K:= N step - 1 until 1 do begin KK:= KK - W; SHIFT:= SHIFT - W1; if W2 < W1 then W2:= W2 + 1; B[K]:= (B[K] - VECVEC(K + 1, K + W2, SHIFT, B, A)) / A[KK] end; END: AUX[1]:= SDET end DECSOLBND; eop