Initial commit

1 files changed, 231 insertions, 0 deletions

diff --git a/noao/onedspec/odcombine/srcwt/icmedian.gx b/noao/onedspec/odcombine/srcwt/icmedian.gx
new file mode 100644
index 00000000..4ac51ae6
--- /dev/null
+++ b/noao/onedspec/odcombine/srcwt/icmedian.gx
@@ -0,0 +1,231 @@
+# 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, j, k, j1, j2, n1, lo, up, lo1, up1
+bool	even
+$if (datatype == silx)
+real	val1, val2, val3
+$else
+PIXEL	val1, val2, val3
+$endif
+PIXEL	temp, wtemp
+$if (datatype == x)
+real	abs_temp
+$endif
+
+include	"../icombine.com"
+
+begin
+	# If no data return after possibly setting blank values.
+	if (dflag == D_NONE) {
+	    if (doblank == YES) {
+		do i = 1, npts
+		    median[i]= blank
+	    }
+	    return
+	}
+
+	# If the data were previously sorted then directly compute the median.
+	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
+	}
+
+	# Compute the median.
+	do i = 1, npts {
+	    k = i - 1
+	    n1 = n[i]
+
+	    # If there are more than 3 points use Wirth algorithm.  This
+	    # is the same as vops$amed.gx except for an even number of
+	    # points it selects the middle two and averages.
+	    if (n1 > 3) {
+		lo = 1
+		up = n1
+		j  = max (lo, min (up, (up+1)/2))
+
+		while (lo < up) {
+		    if (! (lo < up))
+			break
+
+		    temp = Mem$t[d[j]+k];  lo1 = lo;  up1 = up
+		    $if (datatype == x)
+		    abs_temp = abs (temp)
+		    $endif
+
+		    repeat {
+			$if (datatype == x)
+			while (abs (Mem$t[d[lo1]+k]) < abs_temp)
+			$else
+			while (Mem$t[d[lo1]+k] < temp)
+			$endif
+			    lo1 = lo1 + 1
+			$if (datatype == x)
+			while (abs_temp < abs (Mem$t[d[up1]+k]))
+			$else
+			while (temp < Mem$t[d[up1]+k])
+			$endif
+			    up1 = up1 - 1
+			if (lo1 <= up1) {
+			    wtemp = Mem$t[d[lo1]+k]
+			    Mem$t[d[lo1]+k] = Mem$t[d[up1]+k]
+			    Mem$t[d[up1]+k] = wtemp
+			    lo1 = lo1 + 1;  up1 = up1 - 1
+			}
+		    } until (lo1 > up1)
+
+		    if (up1 < j)
+			lo = lo1
+		    if (j < lo1)
+			up = up1
+		}
+
+		median[i] = Mem$t[d[j]+k]
+
+		if (mod (n1,2) == 0) {
+		    lo = 1
+		    up = n1
+		    j  = max (lo, min (up, (up+1)/2)+1)
+
+		    while (lo < up) {
+			if (! (lo < up))
+			    break
+
+			temp = Mem$t[d[j]+k];  lo1 = lo;  up1 = up
+			$if (datatype == x)
+			abs_temp = abs (temp)
+			$endif
+
+			repeat {
+			    $if (datatype == x)
+			    while (abs (Mem$t[d[lo1]+k]) < abs_temp)
+			    $else
+			    while (Mem$t[d[lo1]+k] < temp)
+			    $endif
+				lo1 = lo1 + 1
+			    $if (datatype == x)
+			    while (abs_temp < abs (Mem$t[d[up1]+k]))
+			    $else
+			    while (temp < Mem$t[d[up1]+k])
+			    $endif
+				up1 = up1 - 1
+			    if (lo1 <= up1) {
+				wtemp = Mem$t[d[lo1]+k]
+				Mem$t[d[lo1]+k] = Mem$t[d[up1]+k]
+				Mem$t[d[up1]+k] = wtemp
+				lo1 = lo1 + 1;  up1 = up1 - 1
+			    }
+			} until (lo1 > up1)
+
+			if (up1 < j)
+			    lo = lo1
+			if (j < lo1)
+			    up = up1
+		    }
+		    median[i] = (median[i] + Mem$t[d[j]+k]) / 2
+		}
+
+	    # If 3 points find the median directly.
+	    } else 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
+
+	    # If 2 points average.
+	    } else if (n1 == 2) {
+		val1 = Mem$t[d[1]+k]
+		val2 = Mem$t[d[2]+k]
+		median[i] = (val1 + val2) / 2
+
+	    # If 1 point return the value.
+	    } else if (n1 == 1)
+		median[i] = Mem$t[d[1]+k]
+
+	    # If no points return with a possibly blank value.
+	    else if (doblank == YES)
+		median[i] = blank
+	}
+end
+$endfor