code 34271;
integer procedure QRISNGVALDECBID(D, B, M, N, U, V, EM);
value M, N; integer M, N; array D, B, U, V, EM;
begin integer N0, N1, K, K1, I, I1, COUNT, MAX, RNK;
real TOL, BMAX, Z, X, Y, G, H, F, C, S, MIN;
TOL:= EM[2] * EM[1]; COUNT:= 0; BMAX:= 0; MAX:= EM[4]; MIN:= EM[6];
RNK:= N0:= N;
IN: K:= N; N1:= N - 1;
NEXT: K:= K - 1; if K > 0 then
begin if ABS(B[K]) >= TOL then
begin if ABS(D[K]) >= TOL then goto NEXT;
C:= 0; S:= 1;
for I:= K step 1 until N1 do
begin F:= S * B[I]; B[I]:= C * B[I]; I1:= I + 1;
if ABS(F) < TOL then goto NEGLECT;
G:= D[I1]; D[I1]:= H:= SQRT(F * F + G * G);
C:= G / H; S:= - F / H;
ROTCOL(1, M, K, I1, U, C, S)
end;
NEGLECT:
end
else if ABS(B[K]) > BMAX then BMAX:= ABS(B[K])
end;
if K = N1 then
begin if D[N] < 0 then
begin D[N]:= - D[N];
for I:= 1 step 1 until N0 do V[I,N]:= - V[I,N]
end;
if D[N] <= MIN then RNK:= RNK - 1; N:= N1
end
else
begin COUNT:= COUNT + 1; if COUNT > MAX then goto END;
K1:= K + 1; Z:= D[N]; X:= D[K1]; Y:= D[N1];
G:= if N1 = 1 then 0 else B[N1 - 1]; H:= B[N1];
F:= ((Y - Z) * (Y + Z) + (G - H) * (G + H)) / (2 * H * Y);
G:= SQRT(F * F + 1);
F:= ((X - Z) * (X + Z) + H * (Y / (if F < 0 then F - G
else F + G) - H)) / X; C:= S:= 1;
for I:= K1 + 1 step 1 until N do
begin I1:= I - 1; G:= B[I1]; Y:= D[I]; H:= S * G; G:= C * G;
Z:= SQRT(F * F + H * H); C:= F / Z; S:= H / Z;
if I1 ^= K1 then B[I1 - 1]:= Z; F:= X * C + G * S;
G:= G * C - X * S; H:= Y * S; Y:= Y * C;
ROTCOL(1, N0, I1, I, V, C, S);
D[I1]:= Z:= SQRT(F * F + H * H); C:= F / Z; S:= H / Z;
F:= C * G + S * Y; X:= C * Y - S * G;
ROTCOL(1, M, I1, I, U, C, S)
end;
B[N1]:= F; D[N]:= X
end;
if N > 0 then goto IN;
END: EM[3]:= BMAX; EM[5]:= COUNT; EM[7]:= RNK; QRISNGVALDECBID:= N
end QRISNGVALDECBID;
eop