From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001
From: Joe Hunkeler <jhunkeler@gmail.com>
Date: Tue, 11 Aug 2015 16:51:37 -0400
Subject: Repatch (from linux) of OSX IRAF

---
 sys/vops/asrt.gx | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 sys/vops/asrt.gx

(limited to 'sys/vops/asrt.gx')

diff --git a/sys/vops/asrt.gx b/sys/vops/asrt.gx
new file mode 100644
index 00000000..ff639b2a
--- /dev/null
+++ b/sys/vops/asrt.gx
@@ -0,0 +1,77 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	LOGPTR	32			# log2(maxpts) (4e9)
+
+# ASRT -- Vector Quicksort.  The output vector may be the same as the
+# input vector.
+
+procedure asrt$t (a, b, npix)
+
+PIXEL	a[ARB], b[ARB]		# input, output arrays
+int	npix			# number of pixels
+
+PIXEL	pivot, temp
+int	i, j, k, p, lv[LOGPTR], uv[LOGPTR]
+define	swap {temp=$1;$1=$2;$2=temp}
+
+begin
+	call amov$t (a, b, npix)		# in place sort
+
+	lv[1] = 1
+	uv[1] = npix
+	p = 1
+
+	while (p > 0) {
+	    if (lv[p] >= uv[p])			# only one elem in this subset
+		p = p - 1			# pop stack
+	    else {
+		# Dummy do loop to trigger the Fortran optimizer.
+		do p = p, ARB {
+		    i = lv[p] - 1
+		    j = uv[p]
+
+		    # Select as the pivot the element at the center of the
+		    # array, to avoid quadratic behavior on an already sorted
+		    # array.
+
+		    k = (lv[p] + uv[p]) / 2
+		    swap (b[j], b[k])
+		    pivot = b[j]			# pivot line
+
+		    while (i < j) {
+		    $if (datatype == x)
+			for (i=i+1;  abs(b[i]) < abs(pivot);  i=i+1)
+		    $else
+			for (i=i+1;  b[i] < pivot;  i=i+1)
+		    $endif
+			    ;
+			for (j=j-1;  j > i;  j=j-1)
+		    $if (datatype == x)
+			    if (abs(b[j]) <= abs(pivot))
+		    $else
+			    if (b[j] <= pivot)
+		    $endif
+				break
+			if (i < j)		# out of order pair
+			    swap (b[i], b[j])	# interchange elements
+		    }
+
+		    j = uv[p]			# move pivot to position i
+		    swap (b[i], b[j])		# interchange elements
+
+		    if (i-lv[p] < uv[p] - i) {	# stack so shorter done first
+			lv[p+1] = lv[p]
+			uv[p+1] = i - 1
+			lv[p] = i + 1
+		    } else {
+			lv[p+1] = i + 1
+			uv[p+1] = uv[p]
+			uv[p] = i - 1
+		    }
+
+		    break
+		}
+		p = p + 1			# push onto stack
+	    }
+	}
+end
-- 
cgit