Repatch (from linux) of OSX IRAF

1 files changed, 180 insertions, 0 deletions

diff --git a/pkg/obsolete/imcombine/icmedian.gx b/pkg/obsolete/imcombine/icmedian.gx
new file mode 100644
index 00000000..b70f4302
--- /dev/null
+++ b/pkg/obsolete/imcombine/icmedian.gx
@@ -0,0 +1,180 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	"../icombine.h"
+
+$for (sird)
+# IC_MEDIAN -- Median of lines
+
+procedure ic_median$t (d, n, npts, doblank, median)
+
+pointer	d[ARB]			# Input data line pointers
+int	n[npts]			# Number of good pixels
+int	npts			# Number of output points per line
+int	doblank			# Set blank values?
+$if (datatype == sil)
+real	median[npts]		# Median
+$else
+PIXEL	median[npts]		# Median
+$endif
+
+int	i, j1, j2, j3, k, n1
+bool	even
+$if (datatype == silx)
+real	val1, val2, val3
+$else
+PIXEL	val1, val2, val3
+$endif
+
+include	"../icombine.com"
+
+begin
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# Check for previous sorting
+	if (mclip) {
+	    if (dflag == D_ALL) {
+		n1 = n[1]
+		even = (mod (n1, 2) == 0)
+		j1 = n1 / 2 + 1
+		j2 = n1 / 2
+		do i = 1, npts {
+		    k = i - 1
+		    if (even) {
+			val1 = Mem$t[d[j1]+k]
+			val2 = Mem$t[d[j2]+k]
+			median[i] = (val1 + val2) / 2.
+		    } else
+			median[i] = Mem$t[d[j1]+k]
+		}
+	    } else {
+		do i = 1, npts {
+		    k = i - 1
+		    n1 = n[i]
+		    if (n1 > 0) {
+			j1 = n1 / 2 + 1
+			if (mod (n1, 2) == 0) {
+			    j2 = n1 / 2
+			    val1 = Mem$t[d[j1]+k]
+			    val2 = Mem$t[d[j2]+k]
+			    median[i] = (val1 + val2) / 2.
+			} else
+			    median[i] = Mem$t[d[j1]+k]
+		    } else if (doblank == YES)
+			median[i] = blank
+		}
+	    }
+	    return
+	}
+
+	# Repeatedly exchange the extreme values until there are three
+	# or fewer pixels.
+
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+	    while (n1 > 3) {
+		j1 = 1
+		j2 = 1
+		$if (datatype == x)
+	        val1 = abs (Mem$t[d[j1]+k])
+		$else
+	        val1 = Mem$t[d[j1]+k]
+		$endif
+	        val2 = val1
+	        do j3 = 2, n1 {
+		    $if (datatype == x)
+	            val3 = abs (Mem$t[d[j3]+k])
+		    $else
+		    val3 = Mem$t[d[j3]+k]
+		    $endif
+	            if (val3 > val1) {
+		        j1 = j3
+		        val1 = val3
+		    } else if (val3 < val2) {
+		        j2 = j3
+		        val2 = val3
+		    }
+	        }
+		j3 = n1 - 1
+		if (j1 < j3 && j2 < j3) {
+		    Mem$t[d[j1]+k] = val3
+		    Mem$t[d[j2]+k] = Mem$t[d[j3]+k]
+		    Mem$t[d[j3]+k] = val1
+		    Mem$t[d[n1]+k] = val2
+		} else if (j1 < j3) {
+		    if (j2 == j3) {
+			Mem$t[d[j1]+k] = val3
+			Mem$t[d[n1]+k] = val1
+		    } else {
+			Mem$t[d[j1]+k] = Mem$t[d[j3]+k]
+			Mem$t[d[j3]+k] = val1
+		    }
+		} else if (j2 < j3) {
+		    if (j1 == j3) {
+			Mem$t[d[j2]+k] = val3
+			Mem$t[d[n1]+k] = val2
+		    } else {
+			Mem$t[d[j2]+k] = Mem$t[d[j3]+k]
+			Mem$t[d[j3]+k] = val2
+		    }
+		}
+		n1 = n1 - 2
+	    }
+
+	    if (n1 == 3) {
+		$if (datatype == x)
+	        val1 = abs (Mem$t[d[1]+k])
+	        val2 = abs (Mem$t[d[2]+k])
+	        val3 = abs (Mem$t[d[3]+k])
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = Mem$t[d[2]+k]
+		    else if (val1 < val3)	# acb
+		        median[i] = Mem$t[d[3]+k]
+		    else			# cab
+		        median[i] = Mem$t[d[1]+k]
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = Mem$t[d[2]+k]
+		    else if (val1 > val3)	# bca
+		        median[i] = Mem$t[d[3]+k]
+		    else			# bac
+		        median[i] = Mem$t[d[1]+k]
+	        }
+		$else
+	        val1 = Mem$t[d[1]+k]
+	        val2 = Mem$t[d[2]+k]
+	        val3 = Mem$t[d[3]+k]
+	        if (val1 < val2) {
+		    if (val2 < val3)		# abc
+		        median[i] = val2
+		    else if (val1 < val3)	# acb
+		        median[i] = val3
+		    else			# cab
+		        median[i] = val1
+	        } else {
+		    if (val2 > val3)		# cba
+		        median[i] = val2
+		    else if (val1 > val3)	# bca
+		        median[i] = val3
+		    else			# bac
+		        median[i] = val1
+	        }
+		$endif
+	    } else if (n1 == 2) {
+		val1 = Mem$t[d[1]+k]
+		val2 = Mem$t[d[2]+k]
+		median[i] = (val1 + val2) / 2
+	    } else if (n1 == 1)
+		median[i] = Mem$t[d[1]+k]
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
+$endfor