aboutsummaryrefslogtreecommitdiff
path: root/sys/vops/amed.gx
diff options
context:
space:
mode:
Diffstat (limited to 'sys/vops/amed.gx')
-rw-r--r--sys/vops/amed.gx72
1 files changed, 72 insertions, 0 deletions
diff --git a/sys/vops/amed.gx b/sys/vops/amed.gx
new file mode 100644
index 00000000..21a31724
--- /dev/null
+++ b/sys/vops/amed.gx
@@ -0,0 +1,72 @@
+# 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.
+
+PIXEL procedure amed$t (a, npix)
+
+PIXEL a[ARB]
+int npix
+
+pointer sp, aa
+PIXEL median
+PIXEL asok$t() # select the Kth smallest element from A
+$if (datatype == x)
+real a1, a2, a3
+$endif
+
+begin
+ switch (npix) {
+ case 1, 2:
+ return (a[1])
+
+ case 3:
+ $if (datatype == x)
+ a1 = abs (a[1])
+ a2 = abs (a[2])
+ a3 = abs (a[3])
+ if (a1 < a2) {
+ if (a2 < a3)
+ return (a[2])
+ else if (a1 < a3)
+ return (a[3])
+ else
+ return (a[1])
+ } else {
+ if (a2 > a3)
+ return (a[2])
+ else if (a1 < a3)
+ return (a[1])
+ else
+ return (a[3])
+ }
+ $else
+ 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])
+ }
+ $endif
+
+ default:
+ call smark (sp)
+ call salloc (aa, npix, TY_PIXEL)
+ call amov$t (a, Mem$t[aa], npix)
+ median = asok$t (Mem$t[aa], npix, (npix + 1) / 2)
+ call sfree (sp)
+
+ return (median)
+ }
+end