code 34193; comment MCA 2423; procedure COMSCL(A, N, N1, N2, IM); value N, N1, N2; integer N, N1, N2; array A, IM; begin integer I, J, K; real S, U, V, W; for J:= N1 step 1 until N2 do begin S:= 0; if IM[J] ^= 0 then begin for I:= 1 step 1 until N do begin U:= A[I,J] ** 2 + A[I,J + 1] ** 2; if U > S then begin S:= U; K:= I end end; if S ^= 0 then begin V:= A[K,J] / S; W:= - A[K,J + 1] / S; for I:= 1 step 1 until N do begin U:= A[I,J]; S:= A[I,J + 1]; A[I,J]:= U * V - S * W; A[I,J + 1]:= U * W + S * V end end; J:= J + 1 end else begin for I:= 1 step 1 until N do if ABS(A[I,J]) > ABS(S) then S:= A[I,J]; if S ^= 0 then for I:= 1 step 1 until N do A[I,J]:= A[I,J] / S end end end COMSCL; eop