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/lz/amedl.x | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 sys/vops/lz/amedl.x

(limited to 'sys/vops/lz/amedl.x')

diff --git a/sys/vops/lz/amedl.x b/sys/vops/lz/amedl.x
new file mode 100644
index 00000000..8a993fd2
--- /dev/null
+++ b/sys/vops/lz/amedl.x
@@ -0,0 +1,48 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# AMED -- Vector median selection.  The selection is carried out in a temporary
+# array, leaving the input vector unmodified.  Especially demanding applications
+# may wish to call the asok routine directory to avoid the call to the memory
+# allocator.
+
+long procedure amedl (a, npix)
+
+long	a[ARB]
+int	npix
+
+pointer	sp, aa
+long	median
+long	asokl()		# select the Kth smallest element from A
+
+begin
+	switch (npix) {
+	case 1, 2:
+	    return (a[1])
+
+	case 3:
+		if (a[1] < a[2]) {
+		    if (a[2] < a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[3])
+		    else
+			return (a[1])
+		} else {
+		    if (a[2] > a[3])
+			return (a[2])
+		    else if (a[1] < a[3])
+			return (a[1])
+		    else
+			return (a[3])
+		}
+
+	default:
+	    call smark (sp)
+	    call salloc (aa, npix, TY_LONG)
+	    call amovl (a, Meml[aa], npix)
+	    median = asokl (Meml[aa], npix, (npix + 1) / 2)
+	    call sfree (sp)
+
+	    return (median)
+	}
+end
-- 
cgit