perm filename SORTRA.SIM[SIM,SYS] blob sn#460280 filedate 1979-07-20 generic text, type T, neo UTF8
OPTIONS(/E/C/-A/-Q/-I/-D);
COMMENT Procedure SORTRA will sort the contents
of the REAL array in ACSENDING 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 sortRA (arr,n);
REAL ARRAY arr;   INTEGER n;
BEGIN   INTEGER i,k,q,m,p;   REAL t,x;
    INTEGER ARRAY ut,lz [1:Ln(Abs(n)+2)/0.69314718];

    OPTIONS(/A);
    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
		BEGIN
		    WHILE q >= k DO
		    BEGIN
			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
	    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 SORTREAL IN ACSENDING ORDER;