Initial commit

10 files changed, 1313 insertions, 0 deletions

diff --git a/noao/mtlocal/cyber/rrcopy/README b/noao/mtlocal/cyber/rrcopy/README
new file mode 100644
index 00000000..ec7e7c70
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/README
@@ -0,0 +1,2 @@
+This directory contains source code for rrcopy, the Cyber RCOPY tape
+reader.  
diff --git a/noao/mtlocal/cyber/rrcopy/Revisions b/noao/mtlocal/cyber/rrcopy/Revisions
new file mode 100644
index 00000000..09bf9e12
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/Revisions
@@ -0,0 +1,15 @@
+.help revisions Jun88 noao.mtlocal.cyber.rrcopy
+.nf
+noao$mtlocal/cyber/rrcopy/t_rrcopy.x, rcrheader.x
+	Fixed two places in t_rrcopy where the procedure was returning 
+	without closing the mt file.  Procedure rc_read_header was
+	not returning the value (OK) when NOT at EOF.  These two errors,
+	while present all along, had not been seen until rrcopy was modified
+	to read tapes with more then one datafile; see below.  (4-AUG-88 ShJ)
+
+noao$mtlocal/cyber/rrcopy/t_rrcopy.x
+	Added a hidden parameter "datafile" to the rrcopy task.  This 
+	allows more than one file of rcopy format data per tape.  With
+	this "extension" to the rcopy format, many rcopy files can be
+	archived on a single tape.  (26-JULY-88 ShJ)
+.endhelp
diff --git a/noao/mtlocal/cyber/rrcopy/mkpkg b/noao/mtlocal/cyber/rrcopy/mkpkg
new file mode 100644
index 00000000..6d2d99d3
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/mkpkg
@@ -0,0 +1,15 @@
+# The Cyber rcopy format reader RRCOPY makes the following contributions
+# to the dataio package library:
+
+$checkout libpkg.a ../../
+$update   libpkg.a
+$checkin  libpkg.a ../../
+$exit
+
+libpkg.a:
+	rcrbits.x	../pow.inc <error.h> <imhdr.h> <mach.h> rrcopy.h
+	rcrheader.x	<error.h> <imhdr.h> <mach.h> rrcopy.h
+	rcrimage.x	rrcopy.h <error.h> <imhdr.h> <mach.h>
+	rrcopy.x	<mach.h> rrcopy.h
+	t_rrcopy.x	rrcopy.h <error.h> <imhdr.h> <mach.h>
+	;
diff --git a/noao/mtlocal/cyber/rrcopy/rcrbits.x b/noao/mtlocal/cyber/rrcopy/rcrbits.x
new file mode 100644
index 00000000..c6525787
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/rcrbits.x
@@ -0,0 +1,279 @@
+include	<mach.h>
+include	<imhdr.h>
+include	<error.h>
+include "rrcopy.h"
+
+# RC_UP_12 -- Unpack 12-bit unsigned integers from a stream of bits.  
+# Each output integer word contains successive 12-bit increments 
+# of the input bit stream in the least significant bit positions.
+# It is assummed that the initial_bit_offset is the first bit of a 
+# Cyber 60-bit word containing 5 packed 12-bit pixels, the first pixel
+# in the highest 12 bits.
+
+procedure rc_up_12 (input, initial_bit_offset, output, npix_unpk)
+
+char	input[ARB]
+int	output[npix_unpk], npix_unpk
+int	initial_bit_offset, nbits, n, nn, bit_offset
+int	npix_word, ncyb_words, index
+int	bitupk()
+
+begin
+	nbits = 12
+	npix_word = 5
+	if (mod (npix_unpk, npix_word) == 0)
+	    ncyb_words = (npix_unpk) / npix_word
+	else
+	    call error (0, "Incorrect number of pixels to be unpacked")
+	index = 1
+
+	do n = 1, ncyb_words {
+	    bit_offset = initial_bit_offset + (n * 60)
+	    do nn = 1, npix_word {
+	        bit_offset = bit_offset - nbits
+	        output[index] = bitupk (input, bit_offset, nbits)
+	        if (output[index] == 7777B)
+		    output[index] = BLANK
+		index = index + 1
+	    }
+	}
+end
+
+
+# RC_UP_20 -- Unpack 20-bit signed integers from a stream of bits.
+# Each output integer word contains sucessive 20-bit increments of the input.
+# Conversion from one's complement to two's complement is performed.
+# It is assummed that initial_bit_offset is the first bit of a Cyber 
+# 60-bit word containing 3 packed 20-bit pixels, the first pixel in the
+# highest 20 bits.
+
+procedure rc_up_20 (input, initial_bit_offset, output, npix_unpk)
+
+char	input[ARB]
+int	output[npix_unpk], npix_unpk
+int	nbits, n, index, bit_offset, initial_bit_offset
+int	npix_word, ncyb_words, nn, pix_val
+int	bitupk()
+
+begin
+	nbits = 20
+	npix_word = 3
+	if (mod (npix_unpk, npix_word) == 0)
+	    ncyb_words = npix_unpk / npix_word
+	else
+	    call error (0, "Incorrect number of pixels to be unpacked")
+	index = 1
+
+	do n = 1, ncyb_words {
+	    bit_offset = initial_bit_offset + (n * 60)
+	    do nn = 1, npix_word {
+	        bit_offset = bit_offset - nbits
+	        pix_val = bitupk (input, bit_offset, nbits)
+	        if (pix_val == 3777777B)
+	   	    pix_val = BLANK
+	        else if (and (pix_val, 2000000B) != 0) 
+		    # negative pixel
+		    pix_val = -and (3777777B, not(pix_val))
+		output[index] = pix_val
+		index = index + 1
+	    }
+	}
+end
+
+
+# RC_UP_30 -- unpack Cyber 30-bit floating point numbers from a stream of
+# bits.  The input bit stream is unpacked in 30-bit increments into
+# an integer array.  Procedure REPACK_FP is called to reconstruct the
+# floating point numbers from this array.  It is assumed initial_bit_offset
+# is the first bit of a Cyber 60-bit word containing 2 30-bit pixels, the
+# first pixel in the higher 30 bits.
+
+procedure rc_up_30 (input, initial_bit_offset, fp_value, npix)
+
+char	input[ARB]
+real	fp_value[npix]
+pointer	int_buf, sp
+int	initial_bit_offset, npix, bit_offset
+int	nbits, n
+int	bitupk()
+
+begin
+	# Allocate buffer space, allowing for maximum of 1 extraneous pixel
+	call smark (sp)
+	call salloc (int_buf, npix + 1, TY_INT) 
+
+	nbits = 30
+	bit_offset = initial_bit_offset - 60
+
+	do n = 1, npix, 2 {
+	    bit_offset = bit_offset + 90
+	    Memi[int_buf + n - 1] = bitupk (input, bit_offset, 30)
+	    bit_offset = bit_offset - nbits
+	    Memi[int_buf + n] = bitupk (input, bit_offset, 30)
+	}
+
+	call rc_repack_fp (Memi[int_buf], fp_value, npix)
+	call sfree (sp)
+end
+
+
+# RC_UP_60R -- Unpack Cyber 60-bit floating point numbers from a stream 
+# of bits.  The 30 most significant bits from each 60-bit word are
+# unpacked into an integer array.  Procedure REPACK_FP is called to
+# reconstruct the floating point numbers from this array.
+# An 18-bit mantissa, 11-bit exponent and a sign bit are unpacked into
+# the lower 30 bits of each output word.
+
+procedure rc_up_60r (input, initial_bit_offset, fp_value, nwords)
+
+char	input[ARB]
+real	fp_value[nwords]
+int	initial_bit_offset, nwords, bit_offset
+pointer	int_buf, sp
+int	n, nbits_unpk, nbits
+int	bitupk()
+
+begin
+	# Allocate space on stack
+	call smark (sp)
+	call salloc (int_buf, nwords, TY_INT)
+
+	nbits = 60
+	nbits_unpk = 30
+	bit_offset = initial_bit_offset + 30
+   
+	do n = 1, nwords {
+	    Memi[int_buf + n - 1] = bitupk (input, bit_offset, nbits_unpk)
+	    bit_offset = bit_offset + 60
+	}
+
+	call rc_repack_fp (Memi[int_buf], fp_value, nwords)
+	call sfree (sp)
+end
+
+
+# RC_UP_60I -- Unpack 60-bit integers from a stream of bits.  Each element
+# of output contains only the lower 32 bits of each input word, as this
+# procedure is called only for getting NROWS, NCOLS and a few other small
+# positive integer values.  (A 60-bit intger is not a valid IPPS pixel type.)
+
+procedure rc_up_60i (input, initial_bit_offset, output, nwords)
+
+char	input[ARB]
+int	output[nwords]
+int	initial_bit_offset, nwords, bit_offset
+int	n, nbits_unpk, nbits
+int	bitupk()
+
+begin
+	nbits_unpk = NBITS_INT 
+	nbits = 60
+	bit_offset = initial_bit_offset
+
+	do n = 1, nwords {
+	    output[n] = bitupk (input, bit_offset, nbits_unpk)
+	    bit_offset = bit_offset + 60
+	}
+end
+
+
+# RC_UP_ID -- Unpacks ID string from input bit stream.  The IPPS ID string is 
+# written in 7-bit ASCII, with eight characters per Cyber word.  The lowest 
+# 4 bits of each 60-bit word is unused.  The highest 7 bits of the first Cyber 
+# word in the bit stream contains the character count.
+
+procedure rc_up_id (input, output)
+
+char	input[SZ_HEADER]
+char	output[SZ_HEADER]
+int	nbits, nchar_offset, id_offset, nchars, n
+int	nchars_word, ncyb_words, nn, index
+int	bitupk()
+
+begin
+	nbits = 7
+	nchar_offset = NBITS_CYBER_WORD - 6
+	nchars = bitupk (input, nchar_offset, nbits)
+	ncyb_words = (nchars + 7) / 8
+	index = 1
+
+	do n = 1, ncyb_words {
+	    if (n == 1) {
+		nchars_word = 7
+		id_offset = nchar_offset - 7
+	    } else {
+		nchars_word = 8
+		id_offset = (n * NBITS_CYBER_WORD) - 6
+	    }
+	    do nn = 1, nchars_word {
+	        output[index] = bitupk (input, id_offset, nbits)
+		index = index + 1
+	        id_offset = id_offset - 7
+	    }
+	}
+	output[nchars+1] = EOS
+end
+
+
+# RC_REPACK_FP -- returns a floating point number as the function value.
+# The input to REPACK_FP is an integer containing a 30-bit Cyber floating
+# point number in the least significant bits.  The exponent, mantissa
+# and two bits indicating the sign are extracted and used to reassemble
+# the floating point value.  Cyber blanks and overflows are returned as BLANK.
+
+procedure rc_repack_fp (int_value, float_value, nvalues)
+
+int	int_value[ARB], nvalues
+real	float_value[nvalues]
+
+int	i, pixel
+int	exp, mantissa
+real	tbl[255]
+int	bitupk(), and(), not()
+include	"../pow.inc"
+
+begin
+	do i=1, nvalues {	
+	    pixel = int_value[i]
+	    # Check for blanks
+	    if (pixel == 1777000000B) {
+		float_value[i] = BLANK
+		next
+	    }
+
+	    # Check "bit59" and complement all bits if it is set
+	    if (and (pixel, 4000000000B) != 0)  {
+		pixel = not (pixel)
+		mantissa = -and (pixel, 777777B)
+	    } else
+		mantissa = and (pixel, 777777B)
+	    
+	    # Extract and interpret exponent: remove Cyber bias of 2000B
+	    # and convert to two's complement if negative number
+	    exp = bitupk (pixel, 19, 11)
+	    if (exp > 1777B) 
+		# "bit58" is set, positive exponent
+		exp = exp - 2000B
+	    else
+		# negative exponent
+		exp = exp - 1777B
+
+	    # Reconstruct the floating point value:  30 is added to the
+	    # exponent because only the top 18 bits of the 48-bit mantissa
+	    # were extracted;  the 129 is to register the data array index.
+	    #     float_value[i] = real(mantissa) * 2 ** (exp + 30) 
+	    #      (tbl[1] = 2 ** -128) ==> (2 ** n = tbl[n + 129]).
+
+	    exp = exp + 30 + 129
+	    if (exp <= 0) {
+		#call eprintf (
+		   #"RRCOPY_RPACK_FP: Exponent underflow in following record\n")
+		float_value[i] = 0.0
+	    } else if (exp > 255) {
+		#call eprintf (
+		   #"RRCOPY_REPACK_FP: Exponent overflow in following record\n")
+		float_value[i] = MAX_REAL
+	    } else if (exp > 0 && exp <= 255)
+	        float_value[i] = double (mantissa) * tbl[exp]
+	}
+end
diff --git a/noao/mtlocal/cyber/rrcopy/rcrheader.x b/noao/mtlocal/cyber/rrcopy/rcrheader.x
new file mode 100644
index 00000000..2187c6a1
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/rcrheader.x
@@ -0,0 +1,119 @@
+include	<mach.h>
+include	<imhdr.h>
+include	<error.h>
+include "rrcopy.h"
+
+# RC_READ_HEADER -- reads the IPPS header (64 60-bit words) as
+# a bit stream into consecutive elements of char array header. 
+# Any extraneous information between the header and data is skipped;
+# the tape is left positioned at the first data record.
+
+int procedure rc_header_read (rd, rp)
+
+int	rd
+pointer	rp
+char  	raw_header[SZ_HEADER], header[SZ_HEADER]
+int	nchars_to_skip, first_word
+int	rc_read_cyber()
+errchk	rc_header_unpk, rc_skip_chars, rc_read_cyber, rc_order_cyber_bits
+
+begin
+	if (rc_read_cyber (rd, raw_header, SZ_HEADER) == EOF)
+	    return (EOF)
+
+	first_word = 1
+	call rc_order_cyber_bits (raw_header, first_word, header, LEN_PRU)
+
+	# Unpack bit stream and fill structure rp
+	iferr {
+	    call rc_header_unpk (header, rp)
+	    nchars_to_skip = (PRU_ROW_ONE(rp) - 1) * NBITS_PRU / NBITS_CHAR
+	} then {
+	    call erract (EA_WARN)
+	    # Position to first row of raster before posting error
+	    if (nchars_to_skip > 0)
+	        call rc_skip_chars (rd, nchars_to_skip)
+	    call error (1, "Bad header, attempting to skip raster")
+	}
+
+	# Position to first row of IPPS raster
+	if (nchars_to_skip > 0)
+	    call rc_skip_chars (rd, nchars_to_skip)
+
+	return (OK)
+end
+
+
+# RC_LIST_HEADER -- prints the RCOPY header information.
+
+procedure rc_list_header (rp, raster_num)
+
+pointer	rp
+int	raster_num
+
+begin
+        # Print header information from rcopy tape
+	call printf ("[%d]%7t IPPS_ID: %s\n")
+	    call pargi (raster_num)
+	    call pargstr (IPPS_ID(rp))
+	call printf ("%7t NCOLS=%d, NROWS=%d, MIN=%g, MAX=%g, NBPP=%d\n")
+	    call pargi (NCOLS(rp))
+	    call pargi (NROWS(rp))
+	    call pargr (DATA_MIN(rp))
+	    call pargr (DATA_MAX(rp))
+	    call pargi (BITS_PIXEL(rp))
+end
+
+
+# RC_UNPACK_HEADER -- unpacks header words from the char array header
+# and fills the RCOPY data structure.   A few values are checked to
+# make sure a valid IPPS raster is being read.  Offsets to various
+# header words have been defined previously.
+
+procedure rc_header_unpk (header, rp)
+
+char 	header[SZ_HEADER]
+pointer	rp
+
+begin
+	# From the reordered array, first the ID is unpacked
+	call rc_up_id (header, IPPS_ID(rp))
+
+	# An EOR marker terminates each raster
+	call rc_up_60i (header, EOR_OFFSET, PRU_EOR(rp), 1)
+
+	# The PRU containing the first data row
+	call rc_up_60i (header, FIRST_PRU_OFFSET, PRU_ROW_ONE(rp), 1)
+
+	# Most significant 30 bits of the data min are used
+	call rc_up_60r (header, MIN_OFFSET, DATA_MIN(rp), 1)
+
+	# Most significant 30 bits of the data max are used
+	call rc_up_60r (header, MAX_OFFSET, DATA_MAX(rp), 1)
+
+	# Bits per pixel is unpacked and tested
+	call rc_up_60i (header, DATA_TYPE_OFFSET, BITS_PIXEL(rp), 1)
+
+	switch (BITS_PIXEL(rp)) {
+	case 12,20,30,60:
+	    ;
+	default:
+	    call error (2, "Incorrect IPPS BITS_PIXEL")
+	}
+
+	# Number of columns is unpacked and tested
+	call rc_up_60i (header, NCOLS_OFFSET, NCOLS(rp), 1)
+	if (NCOLS(rp) <= 0)
+	    call error (2, "IPPS ncols <= 0")
+
+	# Number of Cyber words per row must be integral # of PRU's
+	call rc_up_60i (header, NWORDS_OFFSET, WRDS_PER_ROW(rp), 1)
+
+	if (mod (WRDS_PER_ROW(rp), LEN_PRU) != 0)
+	    call error (2, "Invalid IPPS NWPR")
+
+	# Number of rows is unpacked and tested
+	call rc_up_60i (header, NROWS_OFFSET, NROWS(rp), 1)
+	if (NROWS(rp) <= 0)
+	    call error (2, "IPPS nrows <= 0")
+end
diff --git a/noao/mtlocal/cyber/rrcopy/rcrimage.x b/noao/mtlocal/cyber/rrcopy/rcrimage.x
new file mode 100644
index 00000000..dc7ebcfb
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/rcrimage.x
@@ -0,0 +1,173 @@
+include	<mach.h>
+include	<imhdr.h>
+include	<error.h>
+include	"rrcopy.h"
+
+# RC_READ_IMAGE -- reads the rcopy image row by row from the tape and writes
+# the output image.  At the completion of READ_IMAGE, the tape is positioned
+# to the header record of the next tape raster.
+
+procedure rc_read_image (rd, out_fname, data_type, rp)
+
+int	rd, data_type
+char	out_fname[SZ_FNAME]
+pointer	rp
+
+pointer	sp, im, cyber_buf, spp_buf
+int	nchars_per_row, nbits_skip, nchars_to_skip, i
+long	clktime()
+
+int	rc_read_cyber()
+pointer	immap(), impl2r()
+errchk	rc_skip_chars, immap, rc_ipps_to_iraf
+
+begin
+	# Allocate buffer for rcopy image pixels
+	call smark (sp)
+	nchars_per_row = WRDS_PER_ROW(rp) * NBITS_CYBER_WORD / NBITS_CHAR
+	call salloc (cyber_buf, nchars_per_row, TY_CHAR)
+	call salloc (spp_buf, nchars_per_row, TY_CHAR)
+
+	# Map new iraf image and set up image header
+	im = immap (out_fname, NEW_IMAGE, 0)
+	IM_LEN(im, 1) = NCOLS(rp)
+	IM_LEN(im, 2) = NROWS(rp)
+	call strcpy (IPPS_ID(rp), IM_TITLE(im), SZ_IMTITLE)
+	IM_MIN(im) = DATA_MIN(rp)
+	IM_MAX(im) = DATA_MAX(rp)
+
+	# Set optimum image pixel type
+	if (data_type == NOT_SET) {
+	    switch (BITS_PIXEL(rp)) {
+		case 12:
+		    IM_PIXTYPE(im) = TY_SHORT
+		case 20:
+		    IM_PIXTYPE(im) = TY_REAL
+		case 30:
+		    IM_PIXTYPE(im) = TY_REAL
+		case 60:
+		    IM_PIXTYPE(im) = TY_REAL
+		default:
+		    call error (3, "IPPS BITS_PIXEL is incorrect")
+	    }
+	} else
+	    IM_PIXTYPE(im) = data_type
+	IM_LIMTIME(im) = clktime (long(0))
+
+	# Loop over rows to read, reorder and convert pixels. 
+	for (i=1; i <= NROWS(rp); i=i+1) {
+	    if (rc_read_cyber (rd, Memc[cyber_buf], nchars_per_row) == EOF)
+		call error (4, "Unexpected EOT when reading image")
+	    call rc_order_cyber_bits (Memc[cyber_buf], 1, Memc[spp_buf], 
+			   WRDS_PER_ROW(rp))
+	    call rc_ipps_to_iraf (Memc[spp_buf], Memr[impl2r(im,i)], NCOLS(rp), 
+				BITS_PIXEL(rp))
+        }
+	
+	# Skip from present position to end of rcopy raster
+	nbits_skip = ((PRU_EOR(rp) - PRU_ROW_ONE(rp)) * LEN_PRU -
+	   (WRDS_PER_ROW(rp) * NROWS(rp))) * NBITS_CYBER_WORD + NBITS_EOR_MARK
+
+	nchars_to_skip = nbits_skip / NBITS_CHAR
+	call rc_skip_chars (rd, nchars_to_skip)
+
+	call imunmap (im)
+	call sfree (sp)
+end
+
+
+# RC_IPPS_TO_IRAF -- performs the conversion from Cyber pixels to IRAF pixels.  
+# Each row of the rcopy image is required to occupy an integral of Cyber
+# PRU's, so the input buffer contains pixels plus filler.  The entire
+# buffer is converted and npix pixels are written to the output image.
+
+procedure rc_ipps_to_iraf (in_buf, iraf_real, npix, nbits_pixel)
+
+char	in_buf[ARB]
+real	iraf_real[npix]
+pointer	iraf_int, sp
+int	nbits_pixel, npix, bit_offset, npix_unpk, npix_cyber_wrd
+errchk	rc_up_12, rc_up_20
+
+begin
+	# Calculate and allocate (maximum) space needed on the stack. The
+	# number of pixels unpacked will always fill an integral number
+	# of Cyber words.  A maximum of 4 extraneous pixels will be unpacked.
+	call smark (sp)
+	call salloc (iraf_int, npix + 4, TY_INT)
+	bit_offset = 1
+
+	switch (nbits_pixel) {
+	case 12: 
+	    npix_cyber_wrd = 5
+	    npix_unpk = ((npix + 4) / npix_cyber_wrd) * npix_cyber_wrd
+	    call rc_up_12 (in_buf, bit_offset, Memi[iraf_int], npix_unpk)
+	    call achtir (Memi[iraf_int], iraf_real, npix)
+
+	case 20: 
+	    npix_cyber_wrd = 3
+	    npix_unpk = ((npix + 2) / npix_cyber_wrd) * npix_cyber_wrd
+	    call rc_up_20 (in_buf, bit_offset, Memi[iraf_int], npix_unpk)
+	    call achtir (Memi[iraf_int], iraf_real, npix)
+	
+	case 30: 
+	    call rc_up_30 (in_buf, bit_offset, iraf_real, npix)
+	
+	case 60: 
+	    call rc_up_60r (in_buf, bit_offset, iraf_real, npix)
+	
+	default:
+	    call error (5, "Illegal IPPS #B/P")
+	}
+
+	call sfree (sp)
+end
+
+
+# RC_SKIP_IMAGE -- skips over an RCOPY raster once the header has been
+# read.  When SKIP_IMAGE returns, the tape is positioned to the first
+# record of the next tape image.
+
+procedure rc_skip_image (rd, rp)
+
+int	rd
+pointer	rp
+int	nchars_to_skip
+errchk	rc_skip_chars
+
+begin
+        # Calculate number of chars in image
+        nchars_to_skip = ((PRU_EOR(rp) - PRU_ROW_ONE(rp)) * 
+	  LEN_PRU * NBITS_CYBER_WORD + NBITS_EOR_MARK ) / NBITS_CHAR
+        call rc_skip_chars (rd, nchars_to_skip)
+end
+
+# RC_SKIP_CHARS -- positions the tape by skipping the requested number of chars.
+ 
+procedure rc_skip_chars (rd, nchars_to_skip)
+
+int	rd, nchars_to_skip
+pointer	sp, dummy
+int	nblks_read, nchars_remaining, i
+int	rc_read_cyber()
+
+begin
+        call smark (sp)
+        call salloc (dummy, SZ_TAPE_BLK, TY_CHAR)
+
+        # Calculate the number of full blocks to skip
+        nblks_read = nchars_to_skip / SZ_TAPE_BLK
+        nchars_remaining = mod (nchars_to_skip, SZ_TAPE_BLK)
+
+	# Read from tape, a block at a time
+        for (i=1; i <= nblks_read; i=i+1) {
+            if (rc_read_cyber (rd, Memc[dummy], SZ_TAPE_BLK) == EOF)
+		call error (6, "Unexpected EOT when skipping image")
+	}
+    
+        # Read partial block from tape
+        if (rc_read_cyber (rd, Memc[dummy], nchars_remaining) == EOF)
+	    call error (7, "Unexpected EOT when skipping image")
+
+        call sfree (sp)
+end
diff --git a/noao/mtlocal/cyber/rrcopy/rrcopy.h b/noao/mtlocal/cyber/rrcopy/rrcopy.h
new file mode 100644
index 00000000..9579b623
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/rrcopy.h
@@ -0,0 +1,41 @@
+
+# Definitions for the Cyber RCOPY tape reader
+
+define 	NBITS_CHAR      (NBITS_BYTE * SZB_CHAR)	# Number of bits per char
+define 	NBITS_CYBER_WORD	60		# Number of bits per Cyber word
+define 	LEN_PRU			64		# Number of words per Cyber pru
+define	NBITS_PRU		3840		# Number of bits per Cyber pru
+define	NCHARS_NOISE	 (48 / NBITS_CHAR)	# Nchars in a Cyber noise record
+define 	NBITS_EOR_MARK		48		# Number of bits per eor marker
+define 	SZ_HEADER      ((64 * 60) / NBITS_CHAR)	# Size in chars of IPPS header
+define 	SZ_TAPE_BLK   ((512 * 60) / NBITS_CHAR) # Size in chars of tape block
+define	SZ_BUFFER	(SZ_TAPE_BLK + 100)	# Size of tape buffer for read
+define  SZ_IPPS_ID		127		# Max number of characters in ID
+define	MAX_RANGES		100	
+define	NOT_SET			0		# Flag for data_type not set
+define	BLANK			0.0		# Temporary value for blanks
+
+# Bit-offsets to IPPS header words 
+
+define	DATA_TYPE_OFFSET	(16 * 60 + 1)	# Offset to data_type (nbpp)
+define	NCOLS_OFFSET		(17 * 60 + 1)	# Offset to ncols (nppr)
+define	NWORDS_OFFSET		(18 * 60 + 1)	# Offet to nwords_per_row
+define	NROWS_OFFSET		(20 * 60 + 1)	# Offset to nrows
+define	FIRST_PRU_OFFSET	(21 * 60 + 1)	# Offset to 1st pru of raster
+define	MIN_OFFSET		(31 * 60 + 1)	# Offset to data min
+define	MAX_OFFSET		(32 * 60 + 1)	# Offset to data max
+define	EOR_OFFSET		(44 * 60 + 1)	# Offset to terminating pru
+
+# The IPPS raster descriptor structure RP:
+
+define 	LEN_RP		10 + SZ_IPPS_ID + 1
+
+define	BITS_PIXEL	Memi[$1]
+define	PRU_EOR         Memi[$1+1]
+define	WRDS_PER_ROW    Memi[$1+2]
+define	PRU_ROW_ONE     Memi[$1+3]
+define	NCOLS		Memi[$1+4]
+define	NROWS		Memi[$1+5]
+define	DATA_MIN	Memr[P2R($1+6)]
+define	DATA_MAX	Memr[P2R($1+7)]
+define	IPPS_ID		Memc[P2C($1+10)]
diff --git a/noao/mtlocal/cyber/rrcopy/rrcopy.x b/noao/mtlocal/cyber/rrcopy/rrcopy.x
new file mode 100644
index 00000000..0a6b5de7
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/rrcopy.x
@@ -0,0 +1,212 @@
+include	<mach.h>
+include "rrcopy.h"
+
+.help rc_read_cyber
+.nf ________________________________________________________________________
+RC_READ_CYBER -- Read binary chars from a file, ignoring short "noise" records.
+Data is read in chunks from the file buffer passed as a bit stream into the
+output buffer.   (See also: read_dumpf and get_cyber_words.)  The
+file buffer is refilled as necessary by calling READ; the output buffer is
+supplied by the calling procedure.  Cyber noise records (48 bits)
+are not transferred to the output buffer and so are ignored.  READ_CYBER_INIT
+must be called to initialize variables for CYBER_READ.  Variables marking the
+current position and top of the buffer are initialized.
+.endhelp ___________________________________________________________________
+
+int procedure rc_read_cyber (rd, out_buffer, maxch)
+
+int	buf_pos, buf_top
+int	rd, maxch
+char	out_buffer[ARB]
+char	block_buf[SZ_BUFFER]
+int	nchars, chunk_size, nchars_read
+int	read(), rc_read_cyber_init()
+
+begin
+	for (nchars = 0; nchars < maxch; nchars = nchars + chunk_size) {
+	    # See if it is necessary to transfer more data from the binary file
+	    # to the file buffer.  This will be necessary when all data from the
+	    # file buffer has been moved to the output buffer.
+
+	    if (buf_pos >= buf_top) {
+	        # Read the next non-noise record into block_buf; reset buf_pos
+    	        repeat {
+		    nchars_read = read (rd, block_buf, SZ_BUFFER)
+	        } until (nchars_read >= NCHARS_NOISE || nchars_read == EOF)
+		buf_pos = 1
+		buf_top = nchars_read
+	    }
+
+	    # The number of chars to output is the smaller of the number of
+	    # characters requested or the number of characters left in the 
+	    # buffer
+
+	    if (nchars_read == EOF)
+		break
+	    else
+	        chunk_size = min (maxch - nchars, buf_top - buf_pos + 1)
+    
+	    # Move data to output array, increment buffer offset
+	    call amovc (block_buf[buf_pos], out_buffer[nchars+1], chunk_size)
+	    buf_pos = buf_pos + chunk_size
+	}
+
+	if (nchars == 0)
+	    return (EOF)
+	else
+	    return (nchars)
+
+entry	rc_read_cyber_init ()
+
+	buf_pos = 1
+	buf_top = 0
+	return (OK)
+end
+
+
+.help rc_order_cyber_bits
+.nf __________________________________________________________________________
+RC_ORDER_CYBER_BITS -- Convert raw data array from a 60-bit Cyber computer into
+an SPP bit-array.  The output SPP bit-array is a bit-packed array of 60-bit
+Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on.
+The least significant Cyber bit is bit 1 in each output word and the most
+significant bit is bit 60.  [MACHDEP].
+
+When the Cyber outputs an array of 60 bit Cyber words it moves a stream of
+bits into output bytes, filling however many bytes as necessary to output a
+given number of Cyber words.  The most significant bits are output first,
+i.e., bit 60 of the first word is moved to bit 8 of the first output byte,
+bit 59 is moved to bit 7 of the first output byte, and so on.  If effect the
+Cyber byte flips each 60-bit word.
+
+To deal with Cyber words as an ordered bit stream we must reorder the bytes
+and bits so that the least significant bits are first.  This function is
+performed by the primitives CYBOOW and CYBOEW (order odd/even Cyber word)
+for individual 60-bit Cyber words.  A portable (and less efficient) version
+of order_cyber_bits is available which does not use these primitives.
+.endhelp _____________________________________________________________________
+
+
+procedure rc_order_cyber_bits (raw_cyber, first_cyber_word, bit_array,
+			    ncyber_words)
+
+char	raw_cyber[ARB]		# raw Cyber array (e.g. from tape)
+int	first_cyber_word	# first 60-bit Cyber word to be unpacked
+char	bit_array[ARB]		# output bit-array
+int	ncyber_words		# number of Cyber words to unpack
+
+bool	odd_word
+int	word, inbit, outbit
+
+begin
+	odd_word = (mod (first_cyber_word, 2) == 1)
+	inbit = (first_cyber_word - 1) * NBITS_CYBER_WORD + 1
+	outbit = 1
+
+	do word = 1, ncyber_words {
+	    # Call odd or even primitive to reorder bits and move 60-bit
+	    # ordered Cyber word to the output array.
+
+	    if (odd_word) {
+		call cyboow (raw_cyber, inbit, bit_array, outbit)
+		odd_word = false
+	    } else {
+		call cyboew (raw_cyber, inbit, bit_array, outbit)
+		odd_word = true
+	    }
+
+	    inbit  = inbit  + NBITS_CYBER_WORD
+	    outbit = outbit + NBITS_CYBER_WORD
+	}
+end
+
+
+# The portable version of order_cyber_bits follows.
+#.help order_cyber_bits
+#.nf __________________________________________________________________________
+#ORDER_CYBER_BITS -- Convert a raw data array from a 60-bit Cyber computer into
+#an SPP bit-array.  The output SPP bit-array is a bit-packed array of 60-bit
+#Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on.
+#The least significant Cyber bit is bit 1 in each output word and the most
+#significant bit is bit 60.  [MACHDEP].
+#
+#The byte stream from the Cyber contains bits 53-60 of the first word in the
+#first byte, bits 45-52 in the second byte, and so on (most significant bytes
+#first).  In essence we swap the order of the 7 8-bit bytes and the 4-bit half
+#byte in each 60 bit word.  The bits in each byte are in the correct order.
+#
+#Each successive pair of Cyber words fits into 15 bytes.  Byte 8 contains the
+#last 4 bits of word 1 in the most signficant half of the byte and the first
+#4 bits of word 2 in the first half of the byte.  In each 60 bit word we must
+#move bit segments (bytes or half bytes) as follows (for the VAX):
+#
+#Odd words (from N*60 bit-offset):
+#      [from]   [to]  [nbits]
+#	 1	53	8
+#	 9	45	8
+#	17	37	8
+#	25	29	8
+#	33	21	8
+#	41	13	8
+#	49	 5	8
+#	61	 1	4
+#
+#Even words (from N*60 bit-offset):
+#      [from]   [to]  [nbits]
+#	-3	57	4
+#	 5	49	8
+#	13	41	8
+#	21	33	8
+#	29	25	8
+#	37	17	8
+#	45	 9	8
+#	53	 1	8
+#.endhelp _____________________________________________________________________
+#
+#define	NBITS_PER_WORD	60
+#define	NSEGMENTS	8
+#
+#
+#procedure order_cyber_bits (raw_cyber, first_cyber_word, bit_array,
+#			    ncyber_words)
+#
+#char	raw_cyber[ARB]		# raw Cyber array (e.g. from tape)
+#int	first_cyber_word	# first 60-bit Cyber word to be unpacked
+#char	bit_array[ARB]		# output bit-array
+#int	ncyber_words		# number of Cyber words to unpack
+#
+#int	word, inword, inbit, outbit, temp, i
+#int	o_from[NSEGMENTS], o_to[NSEGMENTS], o_nbits[NSEGMENTS]
+#int	e_from[NSEGMENTS], e_to[NSEGMENTS], e_nbits[NSEGMENTS]
+#int	bitupk()
+#
+#data	o_from  / 1, 9,17,25,33,41,49,61/		# odd words
+#data	o_to    /53,45,37,29,21,13, 5, 1/
+#data	o_nbits / 8, 8, 8, 8, 8, 8, 8, 4/
+#data	e_from  /-3, 5,13,21,29,37,45,53/		# even words
+#data	e_to    /57,49,41,33,25,17, 9, 1/
+#data	e_nbits / 4, 8, 8, 8, 8, 8, 8, 8/
+#
+#begin
+#	do word = 1, ncyber_words {
+#	    inword = first_cyber_word + word - 1
+#	    inbit  = (inword - 1) * NBITS_PER_WORD
+#	    outbit = (  word - 1) * NBITS_PER_WORD
+#
+#	    # Move bits to the output bit array.  Segment list used depends
+#	    # on whether the word is an odd or even word.  This code will work
+#	    # even if the caller only wishes to order a single word.
+#
+#	    if (mod (inword,2) == 1) {
+#		do i = 1, NSEGMENTS {
+#		    temp = bitupk (raw_cyber, inbit + o_from[i], o_nbits[i])
+#		    call bitpak (temp, bit_array, outbit + o_to[i], o_nbits[i])
+#		}
+#	    } else {
+#		do i = 1, NSEGMENTS {
+#		    temp = bitupk (raw_cyber, inbit + e_from[i], e_nbits[i])
+#		    call bitpak (temp, bit_array, outbit + e_to[i], e_nbits[i])
+#		}
+#	    }
+#	}
+#end
diff --git a/noao/mtlocal/cyber/rrcopy/semicode.doc b/noao/mtlocal/cyber/rrcopy/semicode.doc
new file mode 100644
index 00000000..a7ad514c
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/semicode.doc
@@ -0,0 +1,310 @@
+Semicode for Cyber RCOPY Reader; Frozen at "detailed semicode" stage, Jan 84.
+
+
+#  rcopy tape descriptor
+
+struct rcopy {
+
+    real   data_min     # minimum data value
+    real   data_max     # maximum data value
+    int    nrows        # number of rows in ipps raster
+    int    ncols        # number of columns in ipps raster
+    int    data_type    # number of bits per pixel in the ipps raster
+    int    pru_eor      # pru position of level zero eor
+    int    wrds_per_row # number of 60-bit words per row; each row
+                        # occupies an integral number of 64word pru's.
+    int    pru_row_one  # relative pru ordinal of the first row of raster.
+    char   ipps_id      # id string of the ipps raster
+}
+
+procedure t_rrcopy (rcopy_file, raster_list, iraf_file)
+
+
+begin
+        # get input filename and open tape drive
+        rcopy_fd = open (rcopy_file)
+
+        # get output filename if it will be needed
+        if (make_image = yes) 
+            outfile = fetch root name of output file
+
+        # expand list of rasters to be read from tape
+        if (decode_ranges (raster_list, range, MAX_RANGES, nfiles) == ERR)
+            call error (0, "Illegal raster number list")
+
+        raster_number = 0
+        tape_pos = 1
+        while (get_next_number (range, raster_number, != EOF) {
+            # position tape to first record of raster_number
+            if (tape_pos != raster_number) {
+                iferr {
+                stat = position_rcopy (rcopy_fd, tape_pos ,raster_number)
+                    if (stat = EOF)
+                        return
+                } then
+                    call ERRACT (EA_FATAL)
+            }
+            iraffile = generate output filename from root
+            iferr { 
+                (stat = read_rcopy(rcopy_fd, iraffile, tape_pos)) 
+                if (stat = EOF)
+                    return
+            }           then {
+                call ERRACT (EA_WARN)
+                skip over rcopy raster
+            }
+        }
+        
+end
+
+int procedure position_rcopy (rcopy_fd, tape_pos, raster_number)
+
+begin
+
+        nrasters_skip = raster_number - tape_pos
+        for (i=1; i<=nrasters_skip; i=i+1) {
+            stat = read_header (rcopy_fd, rcopy)
+            if (stat = EOF)
+                return (EOF)    
+            call read_header (rcopy_fd, rcopy)
+            call skip_image (rcopy_fd, rcopy)
+    }
+end
+
+int procedure read_rcopy (rcopy_fd, iraffile, tape_pos)
+
+begin
+
+        # Read ipps raster header from rcopy tape
+        stat = read_header (rcopy_fd, rcopy)
+        if (stat = EOF)
+            return (EOF)
+
+        # Print header information from rcopy tape
+        if (print_header)
+            call print_header (rcopy)
+
+        # read image data if desired
+        if (make_image) 
+            call read_image(rcopy_fd, iraffile, rcopy)
+
+        # skip image if not to be read
+        else
+            call skip_image (rcopy_fd, rcopy)
+            
+        # increment tape position marker
+        tape_pos = tape_pos + 1
+
+
+end
+
+int procedure read_header(rcopy_fd, rcopy)
+
+begin
+        # structure rcopy contains decoded header
+        # Read ipps header (64 60-bit words = 240 chars) as a
+        # bit stream into temp.
+        NBITS_CHAR = SZB_CHAR * NBITS_BYTE
+        NBITS_CYBER_WORD = 60
+        NWORDS_CYBER_PRU = 64
+        SZ_HEADER = 240
+        stat = read_tape (rcopy_fd, raw_header, SZ_HEADER)
+        if (stat = EOF)) 
+            return (EOF)
+
+        # Unpack bit stream and fill structure rcopy
+        call unpack_header (raw_header, rcopy)
+
+        # skip to first row of raster
+        if (rcopy.pru_row_one not equal to 1) {
+            nchars_to_skip = (rcopy.pru_row_one - 1) * NWORDS_CYBER_PRU
+                * NBITS_CYBER_WORD / NBITS_CHAR
+            call skip_chars (rcopy_fd, nchars_to_skip)
+        }
+end
+
+procedure read_image (rcopy_fd, iraffile, rcopy)
+
+begin
+
+        # map new iraf image and set up image header
+        im = immap (iraffile, NEW_IMAGE)
+        im.im_len[1] = rcopy.ncols
+        im.im_len[2] = rcopy.nrows
+        im.im_title = rcopy.ipps_id
+        im.im_min = rcopy.data_min
+        im.im_max = rcopy.data_max
+
+        if (user hasn's supplied data type) {
+            switch (rcopy.data_type) {
+                case 12 :
+                    im.im_pixtype = short
+                case 20 :
+                    im.im_pixtype = real
+                case 30 :
+                    im.im_pixtype = real
+                default:
+                    call error (0, "error in data_type")
+            }
+        }
+
+        # Calculate number of chars per row; this will always be an
+        # integral number of chars because rcopy.words_per_row
+        # is always divisible by 64.
+        NBITS_CHAR = SZB_CHAR * NBITS_BYTE
+        NBITS_CYBER_WORD = 60
+        NWORDS_CYBER_PRU = 64
+        num_chars_per_row = rcopy.wrds_per_row * NBITS_CYBER_WORD / NBITS_CHAR
+
+        # Loop to read rcopy raster line by line into buf1, then
+        # convert ipps pixels to iraf pixels.
+        for(i=1; i<=rcopy.nrows; i=i+1) {
+            stat = read a single row from the internal buffer
+            if (stat = EOF) {
+                close imagefile already accumulated
+                call error (0, "unexpected EOF at row# ")
+            }
+            call ipps_to_iraf (buf1, Memr[impl2r(im,i)], rcopy)
+        }
+        
+        # Read until header of next raster into dummy buffer.
+        # Calculate offset in chars from present position to eor
+        nchars_to_skip = (((rcopy.eor - rcopy.pru_row_one) * NWORDS_CYBER_PRU
+         + (rcopy.words_per_row * rcopy.nrows)) * NBITS_CYBER_WORD + 48)
+         / NBITS_CHAR
+
+        call skip_chars (rcopy_fd, nchars_to_skip)
+end
+
+procedure ipps_to_iraf (buf1, buf2, rcopy)
+
+begin
+
+        # convert (rcopy.ncols * rcopy.data_type ) bits from buf1.
+        # This is the number of bits per row that actually represent
+        # pixels. buf1 contains pixels plus filler.
+        
+        switch (rcopy.data_type) {
+            case 12: 
+                call unpack12 (buf1, bit_offset, buf2, npix)
+            case 20:
+                call unpack20 (buf1, bit_offset, buf2, npix)
+            case 30:
+                call unpack30 (buf1, bit_offset, buf2, npix)
+            default:
+                call error (0, "illegal ipps #b/p")
+        }
+end
+
+procedure skip_image(rcopy_fd, rcopy)
+
+begin
+
+        # Calculate number of chars in image
+        nchars_to_skip = ((rcopy.eor - rcopy.pru_row_one ) * NWORDS_CYBER_PRU *
+           NBITS_CYBER_WORD + 48 ) / NBITS_CHAR
+        call skip_chars (rcopy_fd, nchars_to_skip)
+
+end
+
+procedure print_header (rcopy)
+
+begin
+        # print header information from rcopy tape
+        print, rcopy.ipps_id, rcopy.ncols, rcopy.nrows, rcopy.data_min,
+           rcopy.data_max, rcopy.ipps_data_type
+end
+
+procedure unpack_header (raw_header, rcopy)
+
+begin
+
+        get from raw_header: nrows, ncols, data_type, ipps_id, pru_eor,
+        wrds_per_row, pru_row_one, data_min, data_max
+
+        if (rcopy.data_type != 12, 20, or 30) 
+            call error (0, "invalid ipps #b/p")
+        if (nrows or ncols or pru_row_one !> 0) 
+            call error (0, "invalid ipps raster")
+        if (wrds_per_row not divisible by 64) 
+            call error (0, "invalid ipps raster")
+
+end
+
+procedure skip_chars (rcopy_fd, nchars_to_skip)
+
+begin
+
+    # calculate the number of chars in a tape block = (512 * 60) / 16   
+    # This is the number of chars to be read at one time.
+    SZ_TAPE_BLK = 1920
+
+    # calculate number of blocks to skip (type int)
+    nblks_read = nchars_to_skip / SZ_TAPE_BLK
+    nchars_remaining = mod (nchars_to_skip, SZ_TAPE_BLK)
+
+    # read chars into dummy buffer
+    for (i=1; i<=nblks_read; i=i+1) 
+        stat = read_tape (rcopy_fd, dummy, SZ_TAPE_BLK)
+    
+    stat = read_tape (rcopy_fd, dummy, nchars_remaining)
+
+    # confirm reaching eor
+    if (searching for eor) {
+        reread last 3 chars and compare with level zero eor marker
+        if (eor not confirmed)
+            call error (0, "attempted skip to eor unsuccessful")
+    }
+
+end
+
+
+.help rrcopy 2 "Program Structure"
+.sh
+RCOPY Structure Chart
+
+.nf
+procedure t_rrcopy ()
+# Returns when file list is satisfied or if EOT is encountered
+
+    int procedure read_header (rcopy_fd, rcopy)
+    #returns EOF, ERR or OK
+
+	int procedure read (rcopy_fd, raw_header, SZ_HEADER)
+	#returns EOF or OK
+
+	int procedure unpack_header (raw_header, rcopy)
+	#returns ERR or OK
+
+    int procedure skip_image (rcopy_fd, rcopy)
+    #returns ERR, EOF or OK
+
+	int procedure skip_chars (rcopy_fd, nchars_to_skip)
+	#returns EOF, ERR or OK
+    
+    procedure read_rcopy (rcopy_fd, iraffile)
+    #aborts if output filename exists and noclobber is set
+
+	int procedure read_header (rcopy_fd, rcopy)
+	#returns EOF, ERR or OK
+
+	    int procedure read (rcopy_fd, raw_header, SZ_HEADER)
+	    #returns EOF or OK
+
+	    int procedure unpack_header (raw_header, rcopy)
+	    #returns ERR or OK
+
+	procedure print_header (rcopy)
+
+	procedure read_image (rcopy_rd, iraffile, rcopy)
+	#returns EOF, or OK
+
+	    int procedure read (rcopy_rd, buf1, num_chars_per_row)
+	    #returns EOF or OK
+
+	    int procedure ipps_to_iraf
+	    #returns ERR or OK
+
+	int procedure skip_image (rcopy_rd, rcopy)
+	#returns EOF, ERR or OK
+.endhelp
diff --git a/noao/mtlocal/cyber/rrcopy/t_rrcopy.x b/noao/mtlocal/cyber/rrcopy/t_rrcopy.x
new file mode 100644
index 00000000..9bb83885
--- /dev/null
+++ b/noao/mtlocal/cyber/rrcopy/t_rrcopy.x
@@ -0,0 +1,147 @@
+include	<mach.h>
+include	<imhdr.h>
+include	<error.h>
+include	"rrcopy.h"
+
+# T_RRCOPY -- The main procedure for the RCOPY reader.  The RCOPY reader
+# converts IPPS rasters written in RCOPY format to IRAF images.  All IPPS
+# rasters on an RCOPY tape are in a single file.  Each raster header must
+# be read before the image can be either skipped or read.  T_RRCOPY gets
+# parameters from the cl and decodes the string of rasters to be read.  It
+# then calls READ_HEADER for each raster on the tape.  The header information 
+# is printed if print_header=true.  If make_image = true, the image is 
+# converted to an IRAF image by READ_IMAGE.  Otherwise, the image is skipped 
+# with SKIP_IMAGE.  T_RRCOPY terminates when the raster list is depleted or
+# the tape is at EOT.
+#
+# Modified 26-JULY-88 to allow for multiple rcopy files on a single tape.
+# This allows for rcopy format data to be archived in multiple files on
+# one tape.  The task is still run once per input file.  The user is queried
+# (hidden parameter) for the data file to be read.  The tape file is actually
+# datafile + 1 because of the ANSI label on each rrcopy tape.  (ShJ)
+
+procedure t_rrcopy ()
+
+pointer	sp, rp
+bool	make_image, print_header, bad_header
+char 	rcopy_file[SZ_FNAME], iraf_file[SZ_FNAME]
+char 	out_fname[SZ_FNAME], raster_list[SZ_LINE]
+int 	rd, ras_number, current_ras, nras, stat, tapefile
+int	ranges[3, MAX_RANGES], data_type, init
+
+bool	clgetb()
+char	clgetc()
+int	get_data_type(), position_rcopy(), rc_read_cyber_init(), clgeti()
+int	mtopen(), decode_ranges(), get_next_number(), rc_header_read(), strlen()
+int	mtfile()
+
+begin
+	# Allocate space on stack for program data structure
+	call smark (sp)
+	call salloc (rp, LEN_RP, TY_STRUCT)
+
+	# Get input filename and open tape drive to second file, skipping label
+	call clgstr ("rcopy_file", rcopy_file, SZ_FNAME)
+	if (mtfile (rcopy_file) == YES) {
+	    tapefile = clgeti ("datafile") + 1
+	    call mtfname (rcopy_file, tapefile, rcopy_file, SZ_FNAME)
+	}
+	rd = mtopen (rcopy_file, READ_ONLY, SZ_BUFFER)
+	init = rc_read_cyber_init()
+
+	# Get output root filename if it will be needed
+	make_image = clgetb ("make_image")
+	if (make_image) {
+	    call clgstr ("iraf_file", iraf_file, SZ_FNAME)
+	    data_type = get_data_type (clgetc ("data_type"))
+	    if (data_type == ERR)
+		data_type = NOT_SET
+	} 
+
+	# Set options
+	print_header = clgetb ("print_header")
+
+	# Expand list of rasters to be read from tape
+	call clgstr ("raster_list", raster_list, SZ_LINE)
+	if (decode_ranges (raster_list, ranges, MAX_RANGES, nras) == ERR)
+	    call error (0, "Illegal raster number list")
+
+	ras_number = 0
+	current_ras = 1
+	while (get_next_number (ranges, ras_number) != EOF) {
+	    # Position tape to first record of ras_number
+	    if (current_ras != ras_number) {
+	        iferr (stat = position_rcopy (rd, current_ras, ras_number, rp))
+		    call erract (EA_FATAL)
+		if (stat == EOF)
+		    break
+	    }
+	    
+	    # Assume header is good
+	    bad_header = false
+ 	    iferr {
+ 	        stat = rc_header_read (rd, rp)
+	    } then {
+		# Error reading header; will attempt to skip raster
+		bad_header = true
+		call erract (EA_WARN)
+	    }
+
+	    if (stat == EOF) {
+	        call printf ("\nRCOPY tape at End of Tape\n")
+		break
+	    }
+
+	    if (print_header)
+		call rc_list_header (rp, ras_number)
+	    call flush (STDOUT)
+
+	    if (make_image && ! bad_header) {
+		# Generate output filename
+	        call strcpy (iraf_file, out_fname, SZ_FNAME)
+		if (nras > 1) {
+		    call sprintf (out_fname[strlen(out_fname)+1], SZ_FNAME,
+				  "%03d")
+		        call pargi (ras_number)
+		}
+		iferr (call rc_read_image (rd, out_fname, data_type, rp))
+		    call erract (EA_FATAL)
+	    } else
+		iferr (call rc_skip_image (rd, rp))
+		    call erract (EA_FATAL)
+		
+	    # Increment tape position
+	    current_ras = current_ras + 1
+	}
+
+	# Return space allocated for rp, close tape unit
+	call close (rd)
+	call sfree (sp)
+end
+
+
+# POSITION_RCOPY -- Position the tape to the first
+# record of the next raster to be read.  Each raster header must
+# be read; each image can then be skipped.
+
+int procedure position_rcopy (rd, current_ras, ras_number, rp)
+
+int	rd, current_ras, ras_number
+pointer	rp
+int	nras_skip, i, stat
+int	rc_header_read()
+errchk	rc_skip_image
+
+begin
+        nras_skip = ras_number - current_ras
+        for (i=1; i <= nras_skip; i=i+1) {
+	    stat = rc_header_read (rd, rp)
+	    if (stat == EOF) {
+		call printf ("Cannot position RCOPY tape beyond EOF\n")
+		return (EOF)
+	    }
+            call rc_skip_image (rd, rp)
+	    current_ras = current_ras + 1
+        }
+	return (OK)
+end