Google
 

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;