1 files changed, 103 insertions, 0 deletions
diff --git a/pkg/images/imgeom/src/blkrp.gx b/pkg/images/imgeom/src/blkrp.gx
new file mode 100644
index 00000000..fb297633
--- /dev/null
+++ b/pkg/images/imgeom/src/blkrp.gx
@@ -0,0 +1,103 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <imhdr.h>
+
+$for (dlrs)
+
+# BLKRP -- Block replicate an image.
+
+procedure blkrp$t (in, out, blkfac)
+
+pointer	in			# Input IMIO pointer
+pointer	out			# Output IMIO pointer
+int	blkfac[ARB]		# Block replication factors
+
+int	i, j, ndim, nin, nout
+pointer	sp, buf, buf1, buf2, buf3, v1, v2, v3, ptrin, ptrout
+pointer	imgl1$t(), impl1$t(), imgnl$t(), impnl$t()
+
+begin
+	call smark (sp)
+
+	ndim = IM_NDIM(in)
+	nin = IM_LEN(in, 1)
+	nout = nin * blkfac[1]
+	IM_LEN(out,1) = nout
+
+	if (ndim == 1) {
+	    # For one dimensional images do the replication directly.
+
+	    buf1 = imgl1$t (in)
+	    buf2 = impl1$t (out)
+	    ptrin = buf1
+	    ptrout = buf2
+	    do i = 1, nin {
+		do j = 1, blkfac[1] {
+		    Mem$t[ptrout] = Mem$t[ptrin]
+		    ptrout = ptrout + 1
+		}
+		ptrin = ptrin + 1
+	    }
+
+	} else {
+	    # For higher dimensional images use line access routines.
+
+	    do i = 2, ndim
+	        IM_LEN(out,i) = IM_LEN(in,i) * blkfac[i]
+
+	    # Allocate memory.
+	    call salloc (buf, nout, TY_PIXEL)
+	    call salloc (v1, IM_MAXDIM, TY_LONG)
+	    call salloc (v2, IM_MAXDIM, TY_LONG)
+	    call salloc (v3, IM_MAXDIM, TY_LONG)
+
+	    # Initialize the input line vector and the output section vectors.
+	    call amovkl (long(1), Meml[v1], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v2], IM_MAXDIM)
+	    call amovkl (long(1), Meml[v3], IM_MAXDIM)
+
+	    # For each output line compute a block replicated line from the
+	    # input image.  If the line replication factor is greater than
+	    # 1 then simply repeat the input line.  This algorithm is
+	    # sequential in both the input and output image though the
+	    # input image will be recycled for each repetition of higher
+	    # dimensions.
+
+	    while (impnl$t (out, buf2, Meml[v2]) != EOF) {
+		# Get the input vector corresponding to the output line.
+		do i = 2, ndim
+		    Meml[v1+i-1] = (Meml[v3+i-1] - 1) / blkfac[i] + 1
+		i = imgnl$t (in, buf1, Meml[v1])
+
+		# Block replicate the columns.
+		if (blkfac[1] == 1)
+		    buf3 = buf1
+		else {
+	            ptrin = buf1
+	            ptrout = buf
+	            do i = 1, nin {
+		        do j = 1, blkfac[1] {
+		            Mem$t[ptrout] = Mem$t[ptrin]
+		            ptrout = ptrout + 1
+		        }
+		        ptrin = ptrin + 1
+	            }
+		    buf3 = buf
+		}
+
+		# Copy the input line to the output line.
+		call amov$t (Mem$t[buf3], Mem$t[buf2], nout)
+
+		# Repeat for each repetition of the input line.
+		for (i=2;  i <= blkfac[2];  i=i+1) {
+	            j = impnl$t (out, buf2, Meml[v2])
+		    call amov$t (Mem$t[buf3], Mem$t[buf2], nout)
+		}
+
+		call amovl (Meml[v2], Meml[v3], IM_MAXDIM)
+	    }
+	}
+
+	call sfree (sp)
+end
+$endfor