perm filename SORTTA.SIM[SIM,SYS] blob sn#460282 filedate 1979-07-20 generic text, type T, neo UTF8
OPTIONS(/E/C/-A/-Q/-I/-D);
COMMENT Procedure SORTTA will sort the contents
of the TEXT array in ASCENDING 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 sortTA (arr,n);
TEXT ARRAY arr;   INTEGER n;
BEGIN   INTEGER i,k,q,m,p;   TEXT 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 SORTTEXT IN ASCENDING ORDER;