Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/sortld.sim
There is 1 other file named sortld.sim in the archive. Click here to see a list.
OPTIONS(/E/C/-A/-Q/-I/-D);
COMMENT Procedure SORTLD will sort the contents
of the LONG REAL array in DESCENDING order.
Author: Algorithm 271 CACM 11-65, 5-66.
Modified by: Mats Ohlin, FOA 1, S-104 50 STOCKHOM 80, SWEDEN.
Date: 75-09-19
;
PROCEDURE sortLD (arr,n);
LONG REAL ARRAY arr; INTEGER n;
BEGIN INTEGER i,k,q,m,p; LONG REAL t,x;
INTEGER ARRAY ut,lz [1:Ln(Abs(n)+2)/0.69314718];
OPTIONS(/A);
IF arr[1] < arr[n] THEN
BEGIN
t:= arr[1];
OPTIONS(/-A); arr[1]:= arr[n]; arr[n]:= t
END test and swap;
i:= m := 1;
WHILE m > 0 DO
BEGIN
IF n-i > 1 THEN
BEGIN
p:= (n+i)//2; t:= arr[p];
arr[p]:= arr[i]; q:= n; k:= i;
FOR k:= k+1 WHILE k <= q DO
BEGIN
IF arr[k] < t THEN
BEGIN
WHILE q >= k DO
BEGIN
IF arr[q] > t THEN
BEGIN
x:= arr[k]; arr[k]:= arr[q];
arr[q]:= x; q:= q-1;
GO TO l;
END;
q:= q-1;
END Q;
END;
l:
END K;
arr[i]:= arr[q];
arr[q]:= t;
IF 2*q>i+n THEN
BEGIN
lz[m]:= i; ut[m]:= q-1; i:= q+1;
END
ELSE
BEGIN
lz[m]:= q+1; ut[m]:= n; n:= q-1;
END;
m:= m+1;
END
ELSE
BEGIN
IF (IF i < n THEN arr[i] < arr[n] ELSE FALSE) THEN
BEGIN
x:= arr[i]; arr[i]:= arr[n]; arr[n]:= x
END;
m:= m-1;
IF m > 0 THEN
BEGIN i:= lz[m]; n:= ut[m] END;
END
END m > 0 loop;
END SORTLONG REAL IN DESCENDING ORDER;