Initial commit

104 files changed, 10918 insertions, 0 deletions

diff --git a/noao/imred/vtel/README b/noao/imred/vtel/README
new file mode 100644
index 00000000..8f0be8f3
--- /dev/null
+++ b/noao/imred/vtel/README
@@ -0,0 +1,81 @@
+This is the home directory for the Kitt Peak vacuum telescope
+reduction programs.
+
+README		this file
+Revisions	revisions file
+asciilook	lookup table for ascii values into the pixelfont
+d1900.x		calculate number of days since turn of century
+decodeheader.x	decode/print vacuum telescope tape header
+destreak.par	
+destreak.x	destreak 10830 full disk helium grams
+destreak5.cl	script for processing 10830 tape containing 5 grams
+destreak5.par
+dicoplot.h	header file containing defines for DICOPLOT
+dicoplot.par
+dicoplot.x	program to make Carrington rotation mape on the Dicomed
+doc		documentation directory
+ephem.x		program to calculate solar ephemeris data
+fitslogr.cl	script, make a log file of a fits tape (daily grams)
+fitslogr.par
+getsqib.par
+getsqib.x	get the squibby brightness image from a full disk gram
+gryscl.dico	greyscale lookup table for use with DICOPLOT
+imfglexr.x	Get Line with EXtension Real for use with IMFilt
+imfilt.x	convolve an image with gaussian kernel, used in destreak
+imratio.x	find the ratio between two images, used in merge
+imtext.x	subroutine to load text into an image by overwriting pixels
+lstsq.x		least squares fitting subroutine
+makehelium.cl	script to process a helium 10830 tape into daily grams (180)
+makehelium.par
+makeimages.cl	script to process a magnetogram tape into daily grams (180)
+makeimages.par
+merge.par
+merge.x		program to merge daily grams into Carrington rotation maps
+mkpkg		make the package
+mrotlogr.cl	script, make a log file of a fits tape (Carrington rotations)
+mrotlogr.par
+mscan.par
+mscan.x		read vacuum telescope area scan tapes
+numeric.h	header file for numeric subroutine
+numeric.x	subroutine to calculate derivitives of latitude and longitude
+		with respect to x and y respectively (used in rmap)
+pimtext.par
+pimtext.x	program to put text into images by overwriting pixels
+pixbit.x	subroutine that looks up text pixel format in pixelfont
+pixelfont	pixel font for use with pimtext (no lower case, no decenders)
+putsqib.par
+putsqib.x	program to put the squibby brightness back in a full disk gram
+quickfit.par
+quickfit.x	fit an ellipse to the limb of the sun
+readheader.x    read a vacuum telescope header
+readss1.x	subroutine to read a type 1 area scan
+readss2.x	subroutine to read a type 2 area scan
+readss3.x	subroutine to read a type 3 area scan
+readss4.x	subroutine to read a type 4 area scan
+readsubswath.x	subroutine to read a sub-swath
+readvt.par
+readvt.x	read full disk grams from tape
+rmap.par
+rmap.x		map full disk grams into daily grams (180x180)
+syndico.x	Make dicomed print of daily grams 18 cm across.
+tcopy.par
+tcopy.x		tape to tape copy program
+trim.par
+trim.x		trim a full disk gram using squibby brightness info
+unwrap.par
+unwrap.x	program to remove binary wrap-around from images
+vt.h
+vtblink.cl	script to blink images on the IIS to check registration
+vtblink.par
+vtel.cl		load the vacuum telescope package
+vtel.hd		info about locations of various files
+vtel.men	menu for package
+vtel.par
+vtexamine.par
+vtexamine.x	program to examine a vacuum telescope tape (tell about record
+		lengths, header info, number of files, etc.)
+writetape.cl	script to write five full disk grams to tape
+writetape.par
+writevt.par
+writevt.x	program to write a full disk gram to tape in mountain format
+x_vtel.x	package parent program
diff --git a/noao/imred/vtel/Revisions b/noao/imred/vtel/Revisions
new file mode 100644
index 00000000..054bb80e
--- /dev/null
+++ b/noao/imred/vtel/Revisions
@@ -0,0 +1,209 @@
+This is the vacuum telescope package revisions file.
+
+mkpkg
+    Added some missing file dependencies and removed unnecessary ones from
+    the mkpkg file. (9/30/99, Davis)
+
+doc/dicoplot.hlp
+doc/readvt.hlp
+doc/unwrap.hlp
+doc/pimtext.hlp
+    Fixed minor formating problems.  (4/22/99, Valdes)
+
+=======
+V2.11.1
+=======
+
+May 16, 1989 by Dyer Lytle mods to 'readvt', 'syndico', and 'mscan'
+
+Fixed readvt to work with tape drives over the network [(if (mtfile(...].
+Modified syndico to take advantage of the disk-center info in the image
+header.
+
+Modified mscan to be much faster by taking out the geometrical correction.
+Also simplified it by removing the date/time pimtext call.  Also made it
+create only the images needed.  Also made it have a short file name option.
+Also made it work on tape drives over the net.
+
+
+June 5, 1988 by Dyer Lytle modification to PUTSQIB
+
+PUTSQIB had code in it for triming the limb as well as merging the two
+images.  I simplified the program to just make the merge.  The task TRIM
+can be used to trim the limb, and do a better job of it at that.
+
+September 29, 1987 by Dyer Lytle add SYNDICO to package
+
+Added this new program for makeing dicomed prints of daily
+grams 18 cm across.
+
+July 17, 1987 by Dyer Lytle fix bug in numeric.x
+
+There was a bug in the way an error flag was being set that made
+the program fail with a 'divide by zero' error on some data sets.
+
+June 8, 1987  by Dyer Lytle  Overhaul of the package
+
+Major modifications were made to the code to make it conform to IRAF
+standards.  Dynamic memory allocation replaced fixed memory allocation
+in many places.  Readvt was modified to accept templates for input
+and output file names.  New structures were provided for the vacuum
+telescope header, the tapeio buffer, and to reduce the argument count
+for the subroutine 'numeric'.  Vtfix was dropped from the package
+since 'readvt' was modified to check for long records by doing its
+own buffering.  Unwrap was updated to a new, more general and powerful
+version.  A major bug was found and fixed in 'rmap' which was causing
+the total mapped pixel count to be off by about 20%.
+
+June 10, 1986  by Dyer Lytle  Modification of PIMTEXT
+
+Pimtext was modified to allow the user to magnify the text in x and/or y
+and to get the date and/or time from a reference image if desired.
+
+May 21, 1986  by Dyer Lytle  Addition of PIMTEXT to package
+
+Pimtext was added to the vacuum telescope package.  This program allows
+the user to insert text directly into images.  The default action of the
+program is to look up the date and time in the image headers and insert
+this information in the lower left corner of each image.  The user can
+modify the parameters to write any text string.
+
+May 15, 1986  by Dyer Lytle  Modification to Mscan
+
+Mscan was modified to write the date and time into the images using
+a pixel font.  A hidden argument controls this option.  The characters
+are written into the image itself to speed up the moviemaking process.
+Various hidden parameters were added to allow the user to specify
+things about the text such as postition, pixel value, background fill,
+and background value.
+
+May 7, 1986  by Dyer Lytle  Modification to Makeimages and Destreak5
+
+Makeimages and Destreak5 were modified to accept as another argument
+the input scratch disk on which the input files are to be expected.
+
+February 19, 1986  by Dyer Lytle  Modification to Fitslogr
+
+Rfits was changed to produce a short header by default instead of
+a long header.  I changed fitslogr to force the long header it needs.
+
+February 6, 1986  by Dyer Lytle  Modification to Dicoplot
+
+Dicoplot was plotting all of the dates in the input image header
+file.  Sometimes, this list includes dates which should appear
+off the plot, before the zero or after the 360 degree marks.
+The modification involved teaching the program to dump these
+extra dates instead of putting them on the plots.
+
+January 30, 1986  by Dyer Lytle  Modification to vtfix
+
+Vtfix was originally set up to correct extra long records on
+vacuum telescope tapes.  It looked to record lengths of 10242
+bytes and truncated them to 10240 bytes.  Today I found a tape
+with lots of different record lengths all larger than 10240 so
+I modified vtfix to look for records with lengths longer than
+10240 bytes and truncate them to 10240.
+
+January 29, 1986  by Dyer Lytle  Modification to makehelium.
+
+Makehelium was modified to automatically delete the absolute
+value image output from RMAP since this image is junk anyway.
+
+January 29, 1986  by Dyer Lytle  Bug fix and mods to dicoplot.
+
+Dicoplot had a bug which caused the Ratio (POLARITY) images to
+come out zero.  This was corrected.  Also some of the constants
+in GREYMAP were changed to increase the contrast in the weights
+image and in the abs. flux image.  The greyscale as drawn on the
+images was modified to not have white boxes around each grey level
+and to have the number associated with each grey level printed on the
+plot.
+
+January 28, 1986  by Dyer Lytle  Modifications to mscan.
+
+Mscan was using too much memory when processing large images.
+This was causing a lot of page fault errors on VMS.  A modification
+was made to mscan to use fixed size subrasters, decreasing the
+memory needs drastically.
+
+January 20, 1986  by Dyer Lytle  Modifications to readss4.x.
+
+Readss4, which is a subroutine called by mscan to read type 4
+sector scans was set up to add the average field to each pixel
+of the output image.  This was found to be useful only in the
+special case of type 4 intensity scans and was removed.
+"It wasn't a BUG, it was a FEATURE!"
+
+January 20, 1986  by Dyer Lytle  Modifications to destreak.x.
+
+Destreak was set up to use a temporary image for data storage
+between the two destreaking passes.  The temporary image was
+hardwired into the name "tempim".  This was found to unacceptable
+since two or more destreaking jobs run at the same time would have
+a collision at "tempim".  The temporary image was made into an input
+parameter.
+
+January 20, 1986  by Dyer Lytle  Modifications to CL scripts.
+
+The CL scripts makeimages.cl, makehelium.cl, destreak5.cl, and
+writetape.cl were modified to check for the existence of each file
+before it tries to use it.  An error message is output if an image
+cannot be accessed.
+
+January 20, 1986  by Dyer Lytle  Modification to vtblink.cl
+
+Vtblink was modified so that the command "stat" can be entered to the
+"next image" prompt and the script will list which images are loaded
+into which IIS memory plane.
+
+January 20, 1986  by Dyer Lytle  Modification to merge.x
+
+Merge was not set up to handle the differences between the magnetogram
+reduction and the 10830 reduction.  Magnetogram data has three(3) images
+per day and 10830 data has two(2) images per day.  The extra image for
+magnetogram data is the absolute value immage.  Merge was designed to
+expect all three images and to produce four(4) output images.  When
+10830 data is input merge should expect two input images per day and
+only produce two output images.  This modification was made.
+Also the output images were set up such that the data and absolute
+value images were output without being divided by the weight image.
+This was changed since no information is lost by doing this division
+since the weight image is also saved.  Merge was also restructured
+quite a bit but is still a mess and needs rewriting, but it works.
+
+January 20, 1986  by Dyer Lytle  Modification to rmap.x
+
+Rmap was changed to calculate the average field, the average absolute
+field, and the total number of pixels for each gram reduced.
+These parameters are stored in the reduced data image header as
+MEAN_FLD, MEANAFLD, and NUM_PIX.
+
+January 10, 1986  by Dyer Lytle  Bug fix in tcopy.
+
+Tcopy was reporting errors incorrectly.  The record number identified
+with the error was one less than the actual error record.
+
+January 10, 1986  by Dyer Lytle  Modification to decodeheader.x.
+
+Changed the format used by decodeheader to print out the date and time,
+the format was of variable width depending on the size of the number printed.
+The new format has fixed length fields.
+
+January 9, 1986   by Dyer Lytle   Modification to merge.
+
+Merge was modified to expect the images in the textfile 'mergelist' to be in the
+order (data, abs value, weights) instead of (data, weights, abs value).
+
+January 3, 1986   by Dyer Lytle   Correction to dicoplot.
+
+Dicoplot had, for some integer expressions, TRUE/FALSE instead of YES/NO.
+This works fine on the UNIX system but was found to fail on VMS.
+
+January 3, 1986   by Dyer Lytle   Correction to mscan.
+
+Mscan was not reading type one(1) area scans properly.  The error occurred
+in readss1 where a temporary array was being salloced with the wrong length.
+The correction involved replacing "ny" by "2*ny".
+Also, readss1 and readss3 had a rather contrived error recovery mechanism built
+in, I removed this and will add a more general and reliable error procedure
+based on the fset(VALIDATE) call in a later revision.
diff --git a/noao/imred/vtel/asciilook.inc b/noao/imred/vtel/asciilook.inc
new file mode 100644
index 00000000..68974d34
--- /dev/null
+++ b/noao/imred/vtel/asciilook.inc
@@ -0,0 +1,19 @@
+data	(asciilook[i], i=1,7)     / 449, 449, 449, 449, 449, 449, 449 /
+data	(asciilook[i], i=8,14)    / 449, 449, 449, 449, 449, 449, 449 /
+data	(asciilook[i], i=15,21)   / 449, 449, 449, 449, 449, 449, 449 /
+data	(asciilook[i], i=22,28)   / 449, 449, 449, 449, 449, 449, 449 /
+data	(asciilook[i], i=29,35)   / 449, 449, 449, 449, 001, 008, 015 /
+data	(asciilook[i], i=36,42)   / 022, 029, 036, 043, 050, 057, 064 /
+data	(asciilook[i], i=43,49)   / 071, 078, 085, 092, 099, 106, 113 /
+data	(asciilook[i], i=50,56)   / 120, 127, 134, 141, 148, 155, 162 /
+data	(asciilook[i], i=57,63)   / 169, 176, 183, 190, 197, 204, 211 /
+data	(asciilook[i], i=64,70)   / 218, 225, 232, 239, 246, 253, 260 /
+data	(asciilook[i], i=71,77)   / 267, 274, 281, 288, 295, 302, 309 /
+data	(asciilook[i], i=78,84)   / 316, 323, 330, 337, 344, 351, 358 /
+data	(asciilook[i], i=85,91)   / 365, 372, 379, 386, 393, 400, 407 /
+data	(asciilook[i], i=92,98)   / 414, 421, 428, 435, 442, 449, 232 /
+data	(asciilook[i], i=99,105)  / 239, 246, 253, 260, 267, 274, 281 /
+data	(asciilook[i], i=106,112) / 288, 295, 302, 309, 316, 323, 330 /
+data	(asciilook[i], i=113,119) / 337, 344, 351, 358, 365, 372, 379 /
+data	(asciilook[i], i=120,126) / 386, 393, 400, 407, 449, 449, 449 /
+data	(asciilook[i], i=127,128) / 449, 449/
diff --git a/noao/imred/vtel/d1900.x b/noao/imred/vtel/d1900.x
new file mode 100644
index 00000000..7af25a4b
--- /dev/null
+++ b/noao/imred/vtel/d1900.x
@@ -0,0 +1,15 @@
+# D1900 -- Function to return the number of days since the turn of the
+# century.
+
+int procedure d1900 (month, day, year)
+
+int	month, day, year		# m,d,y of date
+
+int	mac[12]
+data	mac/0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334/
+
+begin
+	d1900 = 365 * year + (year - 1) / 4 + mac[month] + day
+	if (month >= 3 && mod(year,4) == 0)
+	    d1900 = d1900 + 1
+end
diff --git a/noao/imred/vtel/decodeheader.x b/noao/imred/vtel/decodeheader.x
new file mode 100644
index 00000000..5d54753d
--- /dev/null
+++ b/noao/imred/vtel/decodeheader.x
@@ -0,0 +1,67 @@
+include <mach.h>
+include	"vt.h"
+
+# DECODEHEADER -- Unpack date and time, and, if 'verbose' flag is set,
+# display some information to the user.
+
+procedure decodeheader (hbuf, hs, verbose)
+
+pointer	hbuf		# header data input buffer pointer (short, SZ_VTHDR)
+pointer	hs		# header data structure
+bool	verbose		# verbose flag
+
+int	hour, minute, second
+int	bitupk()
+
+begin
+	# Unpack date, time.  The constants below are explained in the
+	# description of the image header and how it is packed.  If any
+	# changes are made the following code will have to be rewritten.
+
+	# Month. The month and day are stored in the first header word.
+	VT_HMONTH[hs] = (bitupk (int(Mems[hbuf]), 13, 4)) * 10 +
+	    bitupk (int(Mems[hbuf]), 9, 4)
+
+	# Day.
+	VT_HDAY[hs] = (bitupk (int(Mems[hbuf]), 5, 4)) * 10 +
+	    bitupk (int(Mems[hbuf]), 1, 4)
+
+	# Year. The year is stored in the second header word.
+	VT_HYEAR[hs] = (bitupk (int(Mems[hbuf+1]), 13, 4)) * 10 +
+	    bitupk (int(Mems[hbuf+1]), 9, 4)
+
+	# Time (seconds since midnight).  Stored in the third and forth words.
+	VT_HTIME[hs] = (bitupk (int(Mems[hbuf+2]), 1, 2)) * 2**15 +
+	    bitupk (int(Mems[hbuf+3]), 1, 15)
+
+	# Store other header parameters. Stored one per word.
+	VT_HWVLNGTH[hs]  = Mems[hbuf+4]	# Wavelength (angstroms)
+	VT_HOBSTYPE[hs]  = Mems[hbuf+5]	# Observation type (0,1,2,3,or 4)
+	VT_HAVINTENS[hs] = Mems[hbuf+6]	# Average intensity
+	VT_HNUMCOLS[hs]  = Mems[hbuf+7]	# Number of columns
+	VT_HINTGPIX[hs]  = Mems[hbuf+8]	# Integrations per pixel
+	VT_HREPTIME[hs]  = Mems[hbuf+9]	# Repitition time
+
+	# Calculate the time in hours, minutes, and seconds instead of
+	# seconds since midnight.
+
+	hour = int(VT_HTIME[hs]/3600)
+	minute = int((VT_HTIME[hs] - hour * 3600)/60)
+	second = VT_HTIME[hs] - hour * 3600 - minute * 60
+
+	# If verbose, print out some header info on one line no <CR>.
+	if (verbose) {
+	    call printf ("%02d/%02d/%02d %02d:%02d:%02d")
+		call pargi (VT_HMONTH[hs])
+		call pargi (VT_HDAY[hs])
+		call pargi (VT_HYEAR[hs])
+		call pargi (hour)
+		call pargi (minute)
+		call pargi (second)
+	    call printf (" wvlngth %d obstype %d numcols %d")
+		call pargi (VT_HWVLNGTH[hs])
+		call pargi (VT_HOBSTYPE[hs])
+		call pargi (VT_HNUMCOLS[hs])
+	    call flush (STDOUT)
+	}
+end
diff --git a/noao/imred/vtel/dephem.x b/noao/imred/vtel/dephem.x
new file mode 100644
index 00000000..6c8c315d
--- /dev/null
+++ b/noao/imred/vtel/dephem.x
@@ -0,0 +1,139 @@
+# EPHEM -- Calculate ephemeris data for the sun, return latitude and
+# longitude of sub-earth point.
+
+procedure ephem (month, day, year, hour, minute, second, image_r,
+	bn_degrees, cldc_degrees, verbose)
+ 
+int	month			# time of observation
+int	day			#
+int	year			#
+int	hour			#
+int	minute			#
+int	second			#
+real	image_r			# image radius
+real	bn_degrees		# solar latitude of sub-earth point (degrees)
+real	cldc_degrees		# Carrington longitude of disk center
+bool	verbose			# verbose flag
+
+double	radians_per_degree, pi, two_pi, st, d, dd
+double	ma, sin_ma, sin_two_ma, ml, e, e_squared, e_cubed
+double	ep, ea, r, image_r_squared, tl
+double	lan, bn, p, p_degrees
+double	sl1, sl2, cldc, cos_bn, x, cl1
+double	sin_three_ma, sec_bn, y
+double	dd_squared, dd_cubed, c, s, cl2, sln
+int	mac[12]
+
+data	mac/0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334/
+
+begin
+	# This version ignores lunar and planetary perturbations.
+	radians_per_degree = .017453292519943d+0
+	pi = 3.1415926536d+0
+	two_pi = pi + pi
+
+	d = double(365 * year + (year - 1)/4 + mac[month] + day)
+	if (month >= 3 && mod(year, 4) == 0)
+	    d = d + 1.d+0
+	st = double(second / 3600. + minute / 60. + hour)
+	d = d + st/24.d+0 -.5d+0
+	dd = d / 10000.d+0
+	dd_squared = dd * dd
+	dd_cubed = dd * dd * dd
+
+	# Mean anomaly.
+	ma = radians_per_degree * (358.475845d+0 + .985600267d+0 *
+	    d - 1.12d-5 * dd_squared - 7.d-8 * dd_cubed)
+	ma = mod(ma, two_pi)
+	sin_ma = sin(ma)
+	sin_two_ma = sin(2.d+0 * ma)
+	sin_three_ma = sin(3.d+0 * ma)
+
+	# Mean longitude.
+	ml = radians_per_degree *
+	    (279.696678d+0 + .9856473354d+0 * d + 2.267d-5 *  dd_squared)
+	ml = mod(ml, two_pi)
+
+	# Ecentricity.
+	e = 0.01675104d+0 - 1.1444d-5 * dd - 9.4d-9 * dd_squared
+	e_squared = e * e
+	e_cubed = e_squared * e
+
+	# Obliquity.
+	ep = radians_per_degree * (23.452294d+0 -
+	    3.5626d-3 * dd - 1.23d-7 * dd_squared + 1.03d-8 * dd_cubed)
+
+	# Eccentric anomaly.
+	ea = ma + (e - e_cubed/8.d+0) * sin_ma + e_squared * sin_two_ma/2.d+0 +
+	    3.d+0 * e_cubed * sin_three_ma/8.d+0
+
+	# Radius vector.
+	r = 1.00000003d+0 * (1.d+0 - e * cos(ea))
+
+	# Image radius.
+	image_r = real(961.18d+0 / r)
+	image_r_squared = double(image_r * image_r)
+
+	# True longitude.
+	tl = ml + (2.d+0 * e - e_cubed/4.d+0) * sin_ma + 5.d+0 * e_squared *
+	    sin_two_ma/4.d+0 + 13.d+0 * e_cubed * sin_three_ma/12.d+0
+	tl = mod(tl, two_pi)
+
+	# Longitude of ascending node of solar equator.
+	lan = radians_per_degree * (73.666667d+0 + 0.0139583d+0 *
+	    (year + 50.d+0))
+
+	# Solar latitude of sub-earth point.
+	bn = asin(sin(tl - lan) * .12620d+0)
+	bn_degrees = real(bn / radians_per_degree)
+	if (verbose) {
+	    call printf("B0 (degrees) = %10.5f\n")
+	        call pargr(bn_degrees)
+	}
+
+	# Position angle of rotation axis.
+	p = atan(-cos(tl) * tan(ep)) + atan(-cos(tl - lan) * .12722d+0)
+	p_degrees = p/radians_per_degree
+	if (verbose) {
+	    call printf("P-angle (degrees) = %10.5f\n")
+	        call pargr(real(p_degrees))
+	}
+
+	# Carrington longitude of disk center.
+	sl1 = (d + 16800.d+0) * 360.d+0/25.38d+0
+	sl2 = mod(sl1, 360.d+0)
+	sln = 360.d+0 - sl2
+	sln = radians_per_degree * sln
+
+	cos_bn = cos(bn)
+	sec_bn = 1.d+0/cos_bn
+	c = +1.d+0
+	s = +1.d+0
+	x = -sec_bn * cos(tl - lan)
+	if (x < 0.)
+	    c = -1.d+0
+	y = -sec_bn * sin(tl - lan) * .99200495d+0
+	if (y < 0.)
+	    s = -1.d+0
+
+	cl1 = tan(tl - lan) * 0.99200495d+0
+	cl2 = atan(cl1)
+	if (s == 1.d+0 && c == 1.d+0)
+	    cldc = sln + cl2
+	if (s == -1.d+0 && c == -1.d+0)
+	    cldc = sln + cl2 + pi
+	if (s == 1.d+0 && c == -1.d+0)
+	    cldc = sln + cl2 + pi
+	if (s == -1.d+0 && c == 1.d+0)
+	    cldc = sln + cl2
+	if (cldc < 0.d+0)
+	    cldc = cldc + two_pi
+	if (cldc > two_pi)
+	    cldc = mod(cldc, two_pi)
+
+	cldc_degrees = real(cldc / radians_per_degree)
+	if (verbose) {
+	    call printf ("L0 (degrees) = %10.5f\n")
+	        call pargr (cldc_degrees)
+	}
+end
diff --git a/noao/imred/vtel/destreak.par b/noao/imred/vtel/destreak.par
new file mode 100644
index 00000000..4b03ee85
--- /dev/null
+++ b/noao/imred/vtel/destreak.par
@@ -0,0 +1,5 @@
+heimage,s,q,,,,Helium 10830 image to be destreaked
+heout,s,q,,,,Output image
+tempim,s,q,,,,Temporary image
+verbose,b,h,no,,,Print out header data and give progress reports
+threshold,i,h,3,,,Squibby brightness threshold defining the limb
diff --git a/noao/imred/vtel/destreak.x b/noao/imred/vtel/destreak.x
new file mode 100644
index 00000000..5002bab9
--- /dev/null
+++ b/noao/imred/vtel/destreak.x
@@ -0,0 +1,432 @@
+include <mach.h>
+include <imhdr.h>
+include <imset.h>
+include "vt.h"
+
+define	WINDEXC		800.	# constant for weight index calculation
+define	WINDEX6TH	75.	# constant for weight index calculation
+define	LIMBR		.97	# Limb closeness rejection coefficient.
+define	SOWTHRESH	20.	# Sum of weights threshold.
+define	SZ_WT10830	1024	# size of weight table for destreak
+define	FCORRECT	.9375	# fractional term for lattitude correction
+
+# Structure for least square fitting parameters.
+
+define	VT_LENSQSTRUCT	8		# Length of VT sq structure
+
+# Pointers
+define	VT_SQ1P		Memi[$1]	# pointers to arrays for least
+define	VT_SQ1Q1P	Memi[$1+1]	# squares fit
+define	VT_SQ1Q2P	Memi[$1+2]	#
+define	VT_SQ1Q3P	Memi[$1+3]	#
+define	VT_SQ2Q2P	Memi[$1+4]	#
+define	VT_SQ2Q3P	Memi[$1+5]	#
+define	VT_SQ3Q3P	Memi[$1+6]	#
+define	VT_NUMDATAP	Memi[$1+7]	#
+
+# Macro definitions
+define	VT_SQ1		Memr[VT_SQ1P($1)+$2-1]
+define	VT_SQ1Q1	Memr[VT_SQ1Q1P($1)+$2-1]
+define	VT_SQ1Q2	Memr[VT_SQ1Q2P($1)+$2-1]
+define	VT_SQ1Q3	Memr[VT_SQ1Q3P($1)+$2-1]
+define	VT_SQ2Q2	Memr[VT_SQ2Q2P($1)+$2-1]
+define	VT_SQ2Q3	Memr[VT_SQ2Q3P($1)+$2-1]
+define	VT_SQ3Q3	Memr[VT_SQ3Q3P($1)+$2-1]
+define	VT_NUMDATA	Memi[VT_NUMDATAP($1)+$2-1]
+
+
+# DESTREAK -- Destreak 10830 grams.  On a 10830 full disk image.  For
+# each diode, based on the data from that diode calculate coefficients for
+# a best fit function and subtract this function from the data.  Apply a
+# spatial filter to the resulting image.
+
+procedure t_destreak()
+
+char	heimage[SZ_FNAME]		# input image
+char	heout[SZ_FNAME]	    		# output image
+char	tempim[SZ_FNAME]	    	# temporary image
+bool	verbose				# verbose flag
+real	el[LEN_ELSTRUCT]		# ellipse parameters data structure
+int	threshold			# squibby brightness threshold
+
+int	diode, npix, i, line
+int	kxdim, kydim
+real	kernel[3,9]
+pointer	weights
+pointer	lgp1, lpp
+pointer	heim, heoutp
+pointer	a, c
+pointer	sqs, sp
+
+bool	clgetb()
+int	clgeti()
+real	imgetr()
+pointer	imgl2s(), impl2s(), immap()
+errchk	immap, imgl2s, impl2s, imfilt
+
+begin
+	call smark (sp)
+	call salloc (sqs, VT_LENSQSTRUCT, TY_STRUCT)
+	call salloc (VT_SQ1P(sqs), DIM_VTFD, TY_REAL)
+	call salloc (VT_SQ1Q1P(sqs), DIM_VTFD, TY_REAL)
+	call salloc (VT_SQ1Q2P(sqs), DIM_VTFD, TY_REAL)
+	call salloc (VT_SQ1Q3P(sqs), DIM_VTFD, TY_REAL)
+	call salloc (VT_SQ2Q2P(sqs), DIM_VTFD, TY_REAL)
+	call salloc (VT_SQ2Q3P(sqs), DIM_VTFD, TY_REAL)
+	call salloc (VT_SQ3Q3P(sqs), DIM_VTFD, TY_REAL)
+	call salloc (VT_NUMDATAP(sqs), DIM_VTFD, TY_INT)
+	call salloc (a, DIM_VTFD, TY_REAL)
+	call salloc (c, DIM_VTFD, TY_REAL)
+	call salloc (weights, SZ_WT10830, TY_REAL)
+	
+	# Get parameters from the cl.
+
+	call clgstr ("heimage", heimage, SZ_FNAME)
+	call clgstr ("heout", heout, SZ_FNAME)
+	call clgstr ("tempim", tempim, SZ_FNAME)
+	verbose = clgetb ("verbose")
+	threshold = clgeti("threshold")
+
+	# Open the images
+	heim = immap (heimage, READ_WRITE, 0)
+	heoutp = immap (tempim, NEW_COPY, heim)
+
+	# Ellipse parameters.
+	E_XCENTER[el] = imgetr (heim, "E_XCEN")
+	E_YCENTER[el] = imgetr (heim, "E_YCEN")
+	E_XSEMIDIAMETER[el] = imgetr (heim, "E_XSMD")
+	E_YSEMIDIAMETER[el] = imgetr (heim, "E_XSMD")
+
+	# Generate the weight array.
+	do i = 1, SZ_WT10830
+	    Memr[weights+i-1] = exp((real(i) - WINDEXC)/WINDEX6TH)
+
+	# Set the sq arrays and the a and c arrays to zero.
+	call aclrr (VT_SQ1(sqs,1), DIM_VTFD)
+	call aclrr (VT_SQ1Q1(sqs,1), DIM_VTFD)
+	call aclrr (VT_SQ1Q2(sqs,1), DIM_VTFD)
+	call aclrr (VT_SQ1Q3(sqs,1), DIM_VTFD)
+	call aclrr (VT_SQ2Q2(sqs,1), DIM_VTFD)
+	call aclrr (VT_SQ2Q3(sqs,1), DIM_VTFD)
+	call aclrr (VT_SQ3Q3(sqs,1), DIM_VTFD)
+	call aclri (VT_NUMDATA(sqs,1), DIM_VTFD)
+	call aclrr (Memr[a], DIM_VTFD)
+	call aclrr (Memr[c], DIM_VTFD)
+
+	# for all lines in the image {
+	#    calculate which diode this line corresponds to
+	#    get the line from the image
+	#    sum the q's for this line
+	# }
+
+	npix = IM_LEN(heim,1)
+	do line = 1, DIM_VTFD {
+	    diode = mod((line - 1), SWTH_HIGH) + 1
+	    lgp1 = imgl2s (heim, line)
+	    call qsumq (Mems[lgp1], npix, el, threshold, weights, LIMBR,
+		line, sqs)
+	}
+
+	# Fit the function to the data for each line. 
+	do line = 1, DIM_VTFD {
+	    call qfitdiode(sqs, line, npix, Memr[a+line-1], Memr[c+line-1],
+		threshold, verbose)
+	    if (verbose) {
+		call printf ("line = %d\n")
+		    call pargi (line)
+		call flush (STDOUT)
+	    }
+	}
+
+	# For each image line subtract the function from the data.
+	do line = 1, DIM_VTFD {
+	    diode = mod((line - 1), SWTH_HIGH) + 1
+	    lgp1 = imgl2s (heim, line)
+	    lpp  = impl2s (heoutp, line)
+	    call qrfunct(Mems[lgp1], Mems[lpp], npix, el, threshold,
+		Memr[a+line-1], Memr[c+line-1], LIMBR, line)
+	}
+
+	# Switch images
+	call imunmap (heim)
+	call imunmap (heoutp)
+	heim = immap (tempim, READ_WRITE, 0)
+	heoutp = immap (heout, NEW_COPY, heim)
+
+	# Call the spacial filter program.
+
+	# First we have to load up the filter kernel
+	kxdim = 3
+	kydim = 9
+	kernel[1,1] = .017857
+	kernel[1,2] = .017857
+	kernel[1,3] = .035714
+	kernel[1,4] = .035714
+	kernel[1,5] = .035714
+	kernel[1,6] = .035714
+	kernel[1,7] = .035714
+	kernel[1,8] = .017857
+	kernel[1,9] = .017857
+	kernel[2,1] = .017857
+	kernel[2,2] = .053571
+	kernel[2,3] = .071428
+	kernel[2,4] = .071428
+	kernel[2,5] = .071428
+	kernel[2,6] = .071428
+	kernel[2,7] = .071428
+	kernel[2,8] = .053571
+	kernel[2,9] = .017857
+	kernel[3,1] = .017857
+	kernel[3,2] = .017857
+	kernel[3,3] = .035714
+	kernel[3,4] = .035714
+	kernel[3,5] = .035714
+	kernel[3,6] = .035714
+	kernel[3,7] = .035714
+	kernel[3,8] = .017857
+	kernel[3,9] = .017857
+
+	if (verbose) {
+	    call printf ("filtering\n")
+	    call flush(STDOUT)
+	}
+	call imfilt(heim, heoutp, kernel, kxdim, kydim, el)
+
+	# Unmap the images.
+	call imunmap(heim)
+	call imunmap(heoutp)
+
+	call sfree (sp)
+
+end
+
+
+# QFITDIODE -- Calculate the coefficients of the best fit functions.
+
+procedure qfitdiode (sqs, line, npix, a, c, threshold, verbose)
+
+pointer	sqs						# q's structure
+int	line						# line in image
+int	npix						# number of pixels
+real	a, c						# returned coeffs
+int	threshold					# sqib threshold
+bool	verbose						# verbose flag
+
+int	i, j
+real	zz[4,4], limbr
+
+begin
+	# If the number of points is insufficient, skip.
+	if (VT_NUMDATA(sqs,line) < 50) {
+	    a = 0.0
+	    c = 0.0
+	    return
+	}
+
+	# First set the out arrays equal to the in arrays, initialize limbr.
+	limbr = LIMBR
+
+
+	# Clear the z array.
+	do i = 1,4 
+	    do j = 1,4
+		zz[i,j] = 0.0
+
+	# Fill the z array.
+	zz[1,2] = VT_SQ1Q1(sqs,line)
+	zz[1,3] = VT_SQ1Q2(sqs,line)
+	zz[1,4] = VT_SQ1Q3(sqs,line)
+	zz[2,3] = VT_SQ2Q2(sqs,line)
+	zz[2,4] = VT_SQ2Q3(sqs,line)
+	zz[3,4] = VT_SQ3Q3(sqs,line)
+
+	# Do the fit if the sum of weights is sufficient.
+	if (VT_SQ1(sqs,line) > SOWTHRESH)
+	    call lstsq(zz,4,VT_SQ1(sqs,line))
+	else {
+	    zz[3,1] = 0.0
+	    zz[3,2] = 0.0
+	}
+
+	# Coefficients are:
+	if (verbose) {
+	    call printf ("a = %g, c = %g ")
+	    call pargr(zz[3,1])
+	    call pargr(zz[3,2])
+	    call flush(STDOUT)
+	}
+	c = zz[3,1]
+	a = zz[3,2]
+end
+
+
+# SUMQ -- Sum up the values of the Qs for the least squares fit.
+
+procedure qsumq (in, npix, el, threshold, weights, limbr, y, sqs)
+
+short	in[npix]			# array to sum from
+pointer	weights				# weights
+real	el[LEN_ELSTRUCT]		# limb fit ellipse struct
+real	limbr				# limb closeness rejection coefficient
+int	npix				# numpix in im line
+int	threshold			# sqib threshold
+int	y				# line in image
+pointer	sqs				# pointer to q's structure
+
+real	q1, q2, q3
+int	i, windex, itemp
+real	rsq, r4th, r6th, r8th
+real	x, xfr, yfr, data
+short	k
+
+int	and()
+short	shifts()
+
+begin
+	k = -4
+
+	# First, calculate the y fractional radius squared.
+	yfr = (abs(real(y) - E_YCENTER[el]))**2 / (E_YSEMIDIAMETER[el]**2)
+
+	# Do this for all the pixels in this row.
+	do i = 1, npix {
+	    # Calculate the x fractional radius squared.
+	    x = real(i)
+	    xfr = (abs(x - E_XCENTER[el]))**2 / E_XSEMIDIAMETER[el]**2
+
+	    # If off the disk, skip.
+	    if (xfr > 1.0) {
+		next
+	    }
+
+	    # Check to see if the brightness of this data point is above the
+	    # threshold, if not, skip.
+
+	    itemp = in[i]
+	    if (and(itemp,17B) < threshold)
+		next
+
+	    # Strip off the squibby brightness, if data too big skip.
+	    data = real(shifts(in[i], k))
+	    if (data > 100.)
+		next
+	    
+	    # Calculate the radius squared. (fractional)
+	    rsq = xfr + yfr
+
+	    # Check to see if the data point is on the disk.
+	    if (rsq > limbr)
+		next
+
+	    r4th = rsq * rsq
+	    r6th = rsq * r4th
+	    r8th = r4th * r4th
+
+	    # Calculate the weight index.
+	    windex = WINDEXC + data + WINDEX6TH * r6th
+	    if (windex < 1)
+		windex = 1
+	    if (windex > SZ_WT10830)
+		windex = SZ_WT10830
+
+	    # Calculate the Qs.
+	    q1 = Memr[weights+windex-1]
+	    q2 = q1 * r6th
+	    q3 = q1 * data
+	    VT_SQ1(sqs,y) = VT_SQ1(sqs,y) + q1
+	    VT_SQ1Q1(sqs,y) = VT_SQ1Q1(sqs,y) + q1 * q1
+	    VT_SQ1Q2(sqs,y) = VT_SQ1Q2(sqs,y) + q1 * q2
+	    VT_SQ1Q3(sqs,y) = VT_SQ1Q3(sqs,y) + q1 * q3
+	    VT_SQ2Q2(sqs,y) = VT_SQ2Q2(sqs,y) + q2 * q2
+	    VT_SQ2Q3(sqs,y) = VT_SQ2Q3(sqs,y) + q2 * q3
+	    VT_SQ3Q3(sqs,y) = VT_SQ3Q3(sqs,y) + q3 * q3
+	    VT_NUMDATA(sqs,y) = VT_NUMDATA(sqs,y) + 1
+	}
+end
+	
+	
+# QRFUNCT -- Remove FUNCTion. Remove the calculated function from the data
+# from a particular diode.  Each data point is checked to see if it is on
+# disk.  If it is not then the input pixel is copied to the output array.
+# if it is on the disk, the function defined by a and c is subtracted from
+# the data point before it is copied to the output array.
+
+procedure qrfunct (in, out, npix, el, threshold, a, c, limbr, y)
+
+short	in[npix]		# inline without fit removed
+short	out[npix]		# inline with fit removed
+real	el[LEN_ELSTRUCT]	# ellipse parameter struct
+real	a, c			# fit coefficients
+real	limbr			# limb closeness coefficient
+int	y			# line of image
+int	npix			# number of pixels in this line
+int	threshold		# sqib threshold
+
+int	i
+short	fvalue
+short	data
+real	x, xfr, yfr, rsq, y4th, y6th
+short	correction
+short	k, kk
+
+short 	shifts()
+
+begin
+	k = -4
+	kk = 4
+
+	# If a and c have zeros, skip.
+	if (abs(a) < EPSILONR && abs(c) < EPSILONR) {
+	    do i = 1, npix {
+		out[i] = in[i]   # leave original data.
+	    }
+	    return
+	}
+
+	# First, calculate the y fractional radius.
+	yfr = (abs(real(y) - E_YCENTER[el]))**2 / (E_YSEMIDIAMETER[el]**2)
+
+	# Calculate the correction.
+	y4th = yfr*yfr
+	y6th = y4th*yfr
+	correction = short(FCORRECT*(6.0*yfr + 8.0*y4th + 16.0*y6th))
+
+	# Do this for all the pixels in the row.
+	do i = 1, npix {
+	    # Calculate the x fractional radius.
+	    x = real(npix/2 - i + 1)
+	    xfr = (abs(real(i) - E_XCENTER[el]))**2 / E_XSEMIDIAMETER[el]**2
+
+	    # If off the disk, skip.
+	    if (xfr > 1.0) {
+		out[i] = in[i]		# leave original data
+		next
+	    }
+
+	    # Check to see if the brightness of this data point is above the
+	    # threshold, if not, skip.
+
+	    if (and(int(in[i]),17B) < threshold) {
+		out[i] = in[i]		# leave original data
+		next
+	    }
+
+	    # Strip off the squibby brightness
+	    data = shifts(in[i], k)
+	    
+	    # Calculate the radius squared. (fractional)
+	    rsq = xfr + yfr
+
+	    # Check to see if the data point is on the disk.
+	    if (rsq > 1.0) {
+		out[i] = in[i]		# leave original data
+		next
+	    }
+
+	    # Calculate the function value.  Subtract it from the data value.
+	    fvalue = short(a * rsq**3 + c)   # a * r**6 + c
+	    data = data - fvalue + correction
+	    # data + squib bright
+	    out[i] = shifts(data, kk) + short(and(int(in[i]),17B))
+	}
+end
diff --git a/noao/imred/vtel/destreak5.cl b/noao/imred/vtel/destreak5.cl
new file mode 100644
index 00000000..40a3be55
--- /dev/null
+++ b/noao/imred/vtel/destreak5.cl
@@ -0,0 +1,91 @@
+#{ DESTREAK5 -- Destreak all five images from a vacuum telescope tape.  The
+# script accepts the general input image filename and the general output
+# image filename from the user (and now the scratch disk).  Destreak5
+# appends a digit [1-5] to the file name for each file read and each
+# corresponding file  written.
+
+# getinput,s,a,,,,General input filename for the 5 images
+# getoutput,s,a,,,,General output filename for the 5 images
+# inim,s,h
+# outim,s,h
+
+{
+
+	inim = getinput
+	outim = getoutput
+
+	if (access("vtelscr$"//inim//"001")) {
+	    readvt ("vtelscr$"//inim//"001", inim//"tmp1")
+	    quickfit (inim//"tmp1001",verbose=yes)
+	    delete ("vtelscr$"//inim//"001")
+	    getsqib (inim//"tmp1001", inim//"sqib1")
+	    destreak (inim//"tmp1001", inim//"temp1", inim//"tmpr1")
+	    imdelete (inim//"tmp1001")
+	    imdelete (inim//"tmpr1")
+	    putsqib (inim//"temp1", inim//"sqib1", outim//"1")
+	    imdelete (inim//"temp1")
+	    imdelete (inim//"sqib1")
+	} else {
+	    print ("vtelscr$"//inim//"001 not accessable")
+	}
+
+	if (access("vtelscr$"//inim//"002")) {
+	    readvt ("vtelscr$"//inim//"002", inim//"tmp2")
+	    quickfit (inim//"tmp2001",verbose=yes)
+	    delete ("vtelscr$"//inim//"002")
+	    getsqib (inim//"tmp2001", inim//"sqib2")
+	    destreak (inim//"tmp2001", inim//"temp2", inim//"tmpr2")
+	    imdelete (inim//"tmp2001")
+	    imdelete (inim//"tmpr2")
+	    putsqib (inim//"temp2", inim//"sqib2", outim//"2")
+	    imdelete (inim//"temp2")
+	    imdelete (inim//"sqib2")
+	} else {
+	    print ("vtelscr$"//inim//"002 not accessable")
+	}
+
+	if (access("vtelscr$"//inim//"003")) {
+	    readvt ("vtelscr$"//inim//"003", inim//"tmp3")
+	    quickfit (inim//"tmp3001",verbose=yes)
+	    delete ("vtelscr$"//inim//"003")
+	    getsqib (inim//"tmp3001", inim//"sqib3")
+	    destreak (inim//"tmp3001", inim//"temp3", inim//"tmpr3")
+	    imdelete (inim//"tmp3001")
+	    imdelete (inim//"tmpr3")
+	    putsqib (inim//"temp3", inim//"sqib3", outim//"3")
+	    imdelete (inim//"temp3")
+	    imdelete (inim//"sqib3")
+	} else {
+	    print ("vtelscr$"//inim//"003 not accessable")
+	}
+
+	if (access("vtelscr$"//inim//"004")) {
+	    readvt ("vtelscr$"//inim//"004", inim//"tmp4")
+	    quickfit (inim//"tmp4001",verbose=yes)
+	    delete ("vtelscr$"//inim//"004")
+	    getsqib (inim//"tmp4001", inim//"sqib4")
+	    destreak (inim//"tmp4001", inim//"temp4", inim//"tmpr4")
+	    imdelete (inim//"tmp4001")
+	    imdelete (inim//"tmpr4")
+	    putsqib (inim//"temp4", inim//"sqib4", outim//"4")
+	    imdelete (inim//"temp4")
+	    imdelete (inim//"sqib4")
+	} else {
+	    print ("vtelscr$"//inim//"004 not accessable")
+	}
+
+	if (access("vtelscr$"//inim//"005")) {
+	    readvt ("vtelscr$"//inim//"005", inim//"tmp5")
+	    quickfit (inim//"tmp5001",verbose=yes)
+	    delete ("vtelscr$"//inim//"005")
+	    getsqib (inim//"tmp5001", inim//"sqib5")
+	    destreak (inim//"tmp5001", inim//"temp5", inim//"tmpr5")
+	    imdelete (inim//"tmp5001")
+	    imdelete (inim//"tmpr5")
+	    putsqib (inim//"temp5", inim//"sqib5", outim//"5")
+	    imdelete (inim//"temp5")
+	    imdelete (inim//"sqib5")
+	} else {
+	    print ("vtelscr$"//inim//"004 not accessable")
+	}
+}
diff --git a/noao/imred/vtel/destreak5.par b/noao/imred/vtel/destreak5.par
new file mode 100644
index 00000000..41accc84
--- /dev/null
+++ b/noao/imred/vtel/destreak5.par
@@ -0,0 +1,4 @@
+getinput,s,a,,,,Root input filename for the 5 images 
+getoutput,s,a,,,,Root output filename for the 5 images 
+inim,s,h
+outim,s,h
diff --git a/noao/imred/vtel/dicoplot.h b/noao/imred/vtel/dicoplot.h
new file mode 100644
index 00000000..592fc8c8
--- /dev/null
+++ b/noao/imred/vtel/dicoplot.h
@@ -0,0 +1,35 @@
+# for the following it is assumed the scale of the coordinate system is zero
+# to one in both x and y. (0.0,0.0) to (1.0,1.0)
+# coordinates of first image (bottom-left-x, bottom-left-y, top-right-x, t-r-y)
+define IM1BL_X	.242
+define IM1BL_Y	.142
+define IM1TR_X	.452
+define IM1TR_Y	.822
+
+# coordinates of second image
+define IM2BL_X	.525
+define IM2BL_Y	.142
+define IM2TR_X	.735
+define IM2TR_Y	.822
+
+# coordinates of greyscale box
+define IMGBL_X	.229
+define IMGBL_Y	.867
+define IMGTR_X	.748
+define IMGTR_Y	.902
+
+# coordinates of outside boundary of entire plot
+define IMDBL_X	.210
+define IMDBL_Y	.076
+define IMDTR_X	.810
+define IMDTR_Y	.950
+
+# length of tics when labeling axes
+define TICLENGTH .002
+
+#image types
+define T10830	1
+define TFLUX	4
+define TWEIGHT	3
+define TABSFLX	2
+define TPLRTY	5
diff --git a/noao/imred/vtel/dicoplot.par b/noao/imred/vtel/dicoplot.par
new file mode 100644
index 00000000..e8348a76
--- /dev/null
+++ b/noao/imred/vtel/dicoplot.par
@@ -0,0 +1,4 @@
+image1,s,q,,,,Image1
+image2,s,q,,,,Image2
+rotnum,i,q,,,,carrington rotation number
+device,s,h,dicomed,,,plot device
diff --git a/noao/imred/vtel/dicoplot.x b/noao/imred/vtel/dicoplot.x
new file mode 100644
index 00000000..3754bb06
--- /dev/null
+++ b/noao/imred/vtel/dicoplot.x
@@ -0,0 +1,522 @@
+include <mach.h>
+include <imhdr.h>
+include <imset.h>
+include <math/curfit.h>
+include <gset.h>
+include "dicoplot.h"
+include "vt.h"
+
+# DICOPLOT -- Make dicomed (or other graphics device) plots of Carrington
+# rotation maps.  The output of this program is a metacode file called
+# "metacode" which can be plotted on whichever graphics device the user
+# chooses.  Before the program is run, STDGRAPH should be set to the target
+# device.
+
+procedure t_dicoplot()
+
+char	image1[SZ_FNAME]			# first image to draw
+char	image2[SZ_FNAME]			# second image to draw
+int	rotnum					# carrington rotation number
+char	device[SZ_FNAME]			# plot device
+
+int	type1, type2				# types of the two images
+pointer	imout1
+pointer	imout2
+int	count, obsdate
+int	i, longitude, latitude, month, day, year
+int	xresolution, yresolution
+real	delta_gray, delta_long, delta_gblock, x, y
+real	offset, longituder
+real	mapx1, mapx2, mapy1, mapy2
+char	ltext[SZ_LINE]
+char	system_id[SZ_LINE]
+
+bool	up, pastm
+int	dateyn
+
+short	gray[16]
+pointer	imgray1
+pointer	imgray2
+pointer	gp, p, sp
+pointer	im1, im2
+pointer	subras1, subras2
+
+pointer	imgs2r()
+pointer	immap()
+pointer	gopen()
+int	imaccf()
+int	ggeti()
+real	imgetr()
+int	clgeti(), imgeti()
+errchk	gopen, immap, imgs2r, sysid
+
+begin
+	call smark (sp)
+	call salloc (imout1, DIM_SQUAREIM*DIM_XCARMAP, TY_REAL)
+	call salloc (imout2, DIM_SQUAREIM*DIM_XCARMAP, TY_REAL)
+	call salloc (imgray1, DIM_SQUAREIM*DIM_XCARMAP, TY_SHORT)
+	call salloc (imgray2, DIM_SQUAREIM*DIM_XCARMAP, TY_SHORT)
+
+	# Get parameters from the cl.
+	call clgstr ("image1", image1, SZ_FNAME)
+	call clgstr ("image2", image2, SZ_FNAME)
+	rotnum = clgeti ("rotnum")
+	call clgstr ("device", device, SZ_FNAME)
+
+	# Open the output file.
+	gp = gopen (device, NEW_FILE, STDPLOT)
+
+	# Open the images
+	im1 = immap (image1, READ_ONLY, 0)
+	im2 = immap (image2, READ_ONLY, 0)
+
+	# Find out what kind of images we have.
+	call gimtype (im1, type1)
+	call gimtype (im2, type2)
+
+	# Draw boxes around the grayscale and the data images.
+	call box (gp, IM1BL_X, IM1BL_Y, IM1TR_X, IM1TR_Y)
+	call box (gp, IM2BL_X, IM2BL_Y, IM2TR_X, IM2TR_Y)
+
+	delta_gblock = (IMGTR_X - IMGBL_X)/16.
+	y = IMGBL_Y - .005
+	do i = 1, 16 {
+	    x = IMGBL_X + real(i-1) * delta_gblock + delta_gblock/2.
+	    call sprintf (ltext, SZ_LINE, "%d")
+		call pargi ((i-1)*int((254./15.)+0.5))
+	    call gtext (gp, x, y, ltext, "v=t;h=c;s=.20")
+	}
+
+
+	# Draw tic marks and labels on the image boxes.
+	# First the longitudes.
+
+	delta_long = (IM1TR_Y-IM1BL_Y)/36.
+	longitude = 0
+	do i = 1,37 {
+	    call sprintf (ltext, SZ_LINE, "%d")
+		call pargi (longitude)
+	    y = IM1TR_Y - real(i-1)*delta_long
+	    x = IM1TR_X
+	    call gline (gp, x,y,x+TICLENGTH,y)
+	    x = IM1BL_X
+	    call gline (gp, x,y,x-TICLENGTH,y)
+	    call gtext (gp, x-.005, y, ltext, "v=c;h=r;s=.25;u=0")
+	    x = IM2TR_X
+	    call gline (gp, x,y,x+TICLENGTH,y)
+	    x = IM2BL_X
+	    call gline (gp, x,y,x-TICLENGTH,y)
+	    call gtext (gp, x-.005, y, ltext, "v=c;h=r;s=.25;u=0")
+	    longitude = longitude + 10
+	}
+
+	# Now the latitudes.
+	# First draw the tics and labels at 0 degrees on both images
+
+	latitude = 0
+	call sprintf (ltext, SZ_LINE, "%d")
+	    call pargi (latitude)
+	x = (IM1BL_X + IM1TR_X)/2.
+	y = IM1TR_Y
+	call gline (gp, x, y, x, y+TICLENGTH)
+	call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0")
+	y = IM1BL_Y
+	call gline (gp, x, y, x, y-TICLENGTH)
+	x = (IM2BL_X + IM2TR_X)/2.
+	y = IM2TR_Y
+	call gline (gp, x, y, x, y+TICLENGTH)
+	call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0")
+	y = IM2BL_Y
+	call gline (gp, x, y, x, y-TICLENGTH)
+
+	# Now the north latitudes.
+	do i = 1,4 {
+	    switch (i) {
+	    case 1:
+		latitude = 20
+	    case 2:
+		latitude = 40
+	    case 3:
+		latitude = 60
+	    case 4:
+		latitude = 90
+	    }
+	    offset = ((IM1TR_X - IM1BL_X)/2.) * sin(real(latitude)*3.1415/180.)
+	    x = IM1BL_X + ((IM1TR_X - IM1BL_X)/2.) + offset
+	    y = IM1TR_Y
+	    call sprintf (ltext, SZ_LINE, "%s%d")
+		call pargstr ("N")
+	        call pargi (latitude)
+	    call gline (gp, x, y, x, y+TICLENGTH)
+	    call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0")
+	    y = IM1BL_Y
+	    call gline (gp, x, y, x, y-TICLENGTH)
+	    x = x + IM2BL_X - IM1BL_X
+	    y = IM2TR_Y
+	    call gline (gp, x, y, x, y+TICLENGTH)
+	    call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0")
+	    y = IM2BL_Y
+	    call gline (gp, x, y, x, y-TICLENGTH)
+	}
+
+	# Finally the south latitudes.
+	do i = 1,4 {
+	    switch (i) {
+	    case 1:
+		latitude = -20
+	    case 2:
+		latitude = -40
+	    case 3:
+		latitude = -60
+	    case 4:
+		latitude = -90
+	    }
+	    offset = ((IM2TR_X - IM2BL_X)/2.) * sin(real(latitude)*3.1415/180.)
+	    x = IM1BL_X + ((IM1TR_X - IM1BL_X)/2.) + offset
+	    y = IM1TR_Y
+	    call sprintf (ltext, SZ_LINE, "%s%d")
+		call pargstr ("S")
+	        call pargi (-latitude)
+	    call gline (gp, x, y, x, y+TICLENGTH)
+	    call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0")
+	    y=IM1BL_Y
+	    call gline (gp, x, y, x, y-TICLENGTH)
+	    x = x + IM2BL_X - IM1BL_X
+	    y = IM2TR_Y
+	    call gline (gp, x, y, x, y+TICLENGTH)
+	    call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0")
+	    y=IM2BL_Y
+	    call gline (gp, x, y, x, y-TICLENGTH)
+	}
+
+	# Put the titles on.
+	# We got the carrington rotation number from the cl.
+
+	call sprintf (ltext, SZ_LINE, "CARRINGTON ROTATION %d %s")
+	    call pargi (rotnum)
+	switch (type1) {
+	case T10830:
+	    call pargstr ("10830")
+	case TABSFLX:
+	    call pargstr ("ABS. FLUX")
+	case TWEIGHT:
+	    call pargstr ("WEIGHT")
+	case TFLUX:
+	    call pargstr ("FLUX")
+	case TPLRTY:
+	    call pargstr ("POLARITY")
+	}
+
+	x = IM1TR_X+.025
+	y = IM1BL_Y + (IM1TR_Y - IM1BL_Y) / 2.
+	call gtext (gp, x, y, ltext, "v=c;h=c;s=.5;u=0")
+	call sprintf (ltext, SZ_LINE, "CARRINGTON ROTATION %d %s")
+	    call pargi (rotnum)
+	switch (type2) {
+	case T10830:
+	    call pargstr ("10830")
+	case TABSFLX:
+	    call pargstr ("ABS. FLUX")
+	case TWEIGHT:
+	    call pargstr ("WEIGHT")
+	case TFLUX:
+	    call pargstr ("FLUX")
+	case TPLRTY:
+	    call pargstr ("POLARITY")
+	}
+
+	x = IM2TR_X+.025
+	y = IM2BL_Y + (IM2TR_Y - IM2BL_Y) / 2.
+	call gtext (gp, x, y, ltext, "v=c;h=c;s=.5;u=0")
+
+	# Put on the dates at the appropriate longitudes.
+	# Get the dates and longitudes from the image header.
+	# Read dates until we run out.
+	# This code alternates between long and short tics for the dates.
+	# For this to work it is assumed that the dates are in
+	# cronological order.
+
+	# Get the first date and longitude from the image header to check
+	# whether or not there are any dates.
+
+	count = 1
+	call sprintf (ltext, SZ_LINE, "DATE%04d")
+	    call pargi (count)
+	dateyn = imaccf (im1, ltext)
+	if (dateyn == NO)
+	    call error(0, "no dates in image header")
+	obsdate = imgeti (im1, ltext)
+	call sprintf (ltext, SZ_LINE, "LONG%04d")
+	    call pargi (count)
+	longituder = imgetr (im1, ltext)
+	longitude = int(longituder + .5)
+
+	# If we find some dates near the beginning of the list which have
+	# longitudes smaller than 180, they probably are some "extra" grams
+	# merged in to fill out the plot, don't plot these dates because they
+	# are really off the image and will come out in the wrong place if we
+	# allow them to be plotted.
+
+	while (longitude < 180) {
+	    count = count + 1
+	    call sprintf (ltext, SZ_LINE, "DATE%04d")
+	        call pargi (count)
+	    dateyn = imaccf (im1, ltext)
+	    if (dateyn == NO)
+		break
+	    obsdate = imgeti (im1, ltext)
+	    call sprintf (ltext, SZ_LINE, "LONG%04d")
+		call pargi (count)
+	    longituder = imgetr (im1, ltext)
+	    longitude = int(longituder + .5)
+	}
+
+	# Calculate the month/day/year.
+	month = obsdate/10000
+	day = obsdate/100 - 100 * (obsdate/10000)
+	year = obsdate - 100 * (obsdate/100)
+
+	up = FALSE
+	pastm = FALSE
+
+	while (dateyn == YES) {
+
+	    # We check to see whether or not we have gotten past 180 degrees
+	    # so that if we find some images near the end of the list with
+	    # longitudes greater than 180 degrees we will know not to plot 
+	    # them since they are off the image.  Longitudes of images in the
+	    # image merge list decrease as we go down the list.
+
+	    # Past the middle yet?
+	    if (longitude < 180)
+		pastm = true
+
+	    # Figure out where this longitude is in y on the image.
+	    y = real(IM1BL_Y) + ((360. - real(longitude))/360.) *
+	        real(IM1TR_Y - IM1BL_Y)
+	    x = real(IM1TR_X)
+
+	    # Draw the tic and the label.
+	    if (!up)
+	        call gline (gp, x, y, x+.005, y)
+	    else
+	        call gline (gp, x, y, x+.011, y)
+	    call sprintf(ltext, SZ_LINE, "%d/%d/%d")
+	        call pargi(month)
+	        call pargi(day)
+	        call pargi(year)
+	    if (!up)
+	        call gtext (gp, x+.006, y, ltext, "v=c;h=l;s=.20;u=0")
+	    else
+	        call gtext (gp, x+.012, y, ltext, "v=c;h=l;s=.20;u=0")
+
+	    # Do the other image.
+	    x = real(IM2TR_X)
+	    if (!up)
+	        call gline (gp, x, y, x+.005, y)
+	    else
+	        call gline (gp, x, y, x+.011, y)
+	    if (!up)
+	        call gtext (gp, x+.006, y, ltext, "v=c;h=l;s=.20;u=0")
+	    else
+	        call gtext (gp, x+.012, y, ltext, "v=c;h=l;s=.20;u=0")
+
+	    # Toggle up switch.
+	    up = !up
+
+	    count = count + 1
+	    call sprintf (ltext, SZ_LINE, "DATE%04d")
+	        call pargi (count)
+	    dateyn = imaccf (im1, ltext)
+
+	    if (dateyn == YES) {
+		# Calculate the month/day/year.
+	        obsdate = imgeti (im1, ltext)
+		month = obsdate/10000
+		day = obsdate/100 - 100 * (obsdate/10000)
+		year = obsdate - 100 * (obsdate/100)
+
+		# Read in the next longitude.
+	        call sprintf (ltext, SZ_LINE, "LONG%04d")
+	            call pargi (count)
+	        longituder = imgeti (im1, ltext)
+		longitude = int(longituder + .5)
+
+		# If we are past the middle and find a longitude in the list
+		# which is greater than 180 degrees, do not plot this date
+		# since it is off the image and will be plotted in the wrong
+		# place.
+
+		if (pastm && longitude > 180)
+		    dateyn = NO
+	    }
+	}	    # End of while loop on dates/longitudes.
+
+	# Fill in the gray scale.
+	delta_gray = 254./15.
+	do i = 1, 16 {
+	    gray[i] = 1.+real(i-1)*delta_gray+0.5
+	}
+	call gpcell (gp, gray, 16, 1, IMGBL_X, IMGBL_Y, IMGTR_X, IMGTR_Y)
+	
+	# Now map the input images from 360x180 to 180x360 and put them
+	# out to the image. We also map the data values into the appropriate
+	# gray scale.
+
+	# Get subrasters of the images.
+	subras1 = imgs2r (im1, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+	subras2 = imgs2r (im2, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+	
+	# Call the image maping routine on both images.
+	call remap (Memr[subras1], DIM_XCARMAP, DIM_SQUAREIM, Memr[imout1])
+	call remap (Memr[subras2], DIM_XCARMAP, DIM_SQUAREIM, Memr[imout2])
+
+	# Call the gray scale mapper.
+	call graymap (Memr[imout1], DIM_SQUAREIM, DIM_XCARMAP, Mems[imgray1],
+	    type1)
+	call graymap (Memr[imout2], DIM_SQUAREIM, DIM_XCARMAP, Mems[imgray2],
+	    type2)
+
+	# Put the images out to the final image.
+	xresolution = ggeti (gp, "xr")
+	yresolution = ggeti (gp, "yr")
+	mapx1 = IM1BL_X
+	mapx2 = IM1TR_X
+	mapy1 = IM1BL_Y
+	mapy2 = IM1TR_Y
+	call gpcell (gp, Mems[imgray1], DIM_SQUAREIM, DIM_XCARMAP, mapx1, mapy1,
+	    mapx2, mapy2)
+	mapx1 = IM2BL_X
+	mapx2 = IM2TR_X
+	mapy1 = IM2BL_Y
+	mapy2 = IM2TR_Y
+	call gpcell (gp, Mems[imgray2], DIM_SQUAREIM, DIM_XCARMAP, mapx1, mapy1,
+	    mapx2, mapy2)
+
+	# Put the system identification on the plot.
+	call sysid (system_id, SZ_LINE)
+	call gtext (gp, .51, .076, system_id, "h=c;s=0.45")
+
+	# Close the graphics pointer.
+	call gclose(gp)
+	call close(p)
+
+	call sfree (sp)
+end
+
+
+# BOX -- Draw a box around the square described by x1, y1 (bottom left corner)
+# and x2, y2 (top right corner).
+
+procedure box(gp, x1, y1, x2, y2)
+
+real	x1, y1		# bottom left corner position
+real	x2, y2		# top right corner position
+pointer	gp		# graphics pointer
+
+begin
+	call gline (gp, x1, y1, x1, y2)
+	call gline (gp, x1, y2, x2, y2)
+	call gline (gp, x2, y2, x2, y1)
+	call gline (gp, x2, y1, x1, y1)
+end
+
+
+# REMAP -- Reformat a 360x180 image into a 180x360 image by rotating the image
+# by 90 degrees clockwise.
+
+procedure remap (inim, x, y, outim)
+
+real	inim[x,y]		# input image
+real	outim[y,x]		# output image
+int	x, y			# size of images
+
+int	i, j	
+
+begin
+	do i = 1, x
+	    do j = 1, y
+		outim[j,x-i+1] = inim[i,j]
+end
+
+
+# GREYMAP -- Map an integer image into a short integer image using a specific
+# scaling algorithm to make the full scale 1 to 256.
+
+procedure graymap (inim, x, y, outim, type)
+
+real	inim[x,y]		# input image
+int	x, y			# size of images
+int	type			# type of image
+short	outim[x,y]		# output image
+
+real	zpp[5], zcc[5], zp, zc	# parameters for different image types
+int	i, j, index
+short	ztbl[512]		# grayscale map array, (in gryscl.inc)
+
+data	zpp /.25, .80, 0.2, 1.0, 100. /
+data	zcc /384., 80., 0., 128., 128. /
+include	"gryscl.inc"
+
+begin
+	# If the image is not a 10830 gram then just multiply each pixel
+	# by a constant and then add another constant. (different constants
+	# for flux, abs. flux, weight, and polarity)
+	# If it is a 10830 gram then multiply and add as above, then use
+	# the result as an index into a lookup table.  The table is enumerated
+	# above.
+
+	zp = zpp[type]
+	zc = zcc[type]
+	do i = 1, x {
+	    do j = 1, y {
+		outim[i,j] = inim[i,j] * zp + zc
+		if (type == 1) {                      # if this is a 10830 gram:
+		    if (outim[i,j] <= 0)	      # make it fit in the table
+			outim[i,j] = 1
+		    if (outim[i,j] > 512)
+			outim[i,j] = 512
+		    index = outim[i,j]
+		    outim[i,j] = ztbl[index] + 10     # look it up in the table.
+		}
+		if (outim[i,j] <= 0)                  # check boundaries
+		    outim[i,j] = 1
+		if (outim[i,j] >= 255)
+		    outim[i,j] = 254
+	    }
+	}
+end
+
+
+# GIMTYPE -- Get IMage TYPE.  Using information in the image header determine
+# what type of image it is. 1 = 10830, 2 = ABS. FLUX, 3 = WEIGHTS,
+# 4 = ABS. VALUE, 5 = POLARITY.
+
+procedure gimtype (im, type)
+
+pointer	im		# image pointer
+int	type		# type
+
+int	wavelength, imgeti()
+int	weightyn, absyn, polarityyn
+int	imaccf()
+
+begin
+	wavelength = imgeti (im, "WV_LNGTH")
+	weightyn = imaccf (im, "WEIGHTS")
+	absyn = imaccf (im, "ABS_VALU")
+	polarityyn = imaccf (im, "POLARITY")
+
+	if (weightyn == NO && absyn == NO && polarityyn == NO) {
+	    if (wavelength == 10830)
+		type = T10830
+	    if (wavelength == 8688)
+		type = TFLUX
+	}
+	if (weightyn == YES)
+	    type = TWEIGHT
+	if (absyn == YES)
+	    type = TABSFLX
+	if (polarityyn == YES)
+	    type = TPLRTY
+end
diff --git a/noao/imred/vtel/doc/destreak.hlp b/noao/imred/vtel/doc/destreak.hlp
new file mode 100644
index 00000000..ef05d905
--- /dev/null
+++ b/noao/imred/vtel/doc/destreak.hlp
@@ -0,0 +1,50 @@
+.help destreak Dec84 noao.imred.vtel
+.ih
+NAME
+destreak -- Remove streaks from Helium 10830 grams
+.ih
+USAGE
+destreak input_image output_image
+.ih
+PARAMETERS
+.ls input_image
+Image to be destreaked.
+.le
+.ls output_image
+Name to give destreaked output image (must be a separate image).
+.le
+.ls tempim
+Temporary image used for pixel storage between destreak passes.
+.le
+.ls verbose=no
+Flag to signal program that it should produce verbose output.
+.le
+.ls threshold = 4
+Squibby brightness threshold to use in determining limb points.
+.le
+.ih
+DESCRIPTION
+The helium 10830 grams as taken by the vacuum telescope have horizontal
+streaks caused by the detecting apparatus.  Destreak removes these streaks
+and the limb darkening
+using a two pass procedure.  First, for each diode, a function of the form
+'a + b*r**4', where r is the radius from disk center and a, b are parameters,
+is fit to the intensity distribution and is then subtracted from the data.
+Then a spatial filter is applied to the result and the final image is
+written to disk.  The full disk images are 2048 x 2048 and are taken using
+a 512 diode array which is scanned from west to east across the solar disk
+4 times.  Thus, data from a particular diode consists of four lines of the 
+image.
+.ih
+EXAMPLES
+1. To destreak "image1", put the output in "image2", put the temporary image in
+"temp2", and see verbose output, the command would be:
+
+.nf
+	vt> destreak image1 image2 temp2 v+
+.fi
+
+.ih
+SEE ALSO
+readvt, writevt, quickfit, getsqib, putsqib
+.endhelp
diff --git a/noao/imred/vtel/doc/destreak5.hlp b/noao/imred/vtel/doc/destreak5.hlp
new file mode 100644
index 00000000..8bf383fa
--- /dev/null
+++ b/noao/imred/vtel/doc/destreak5.hlp
@@ -0,0 +1,43 @@
+.help destreak5 Dec85 noao.imred.vtel
+.ih
+NAME
+destreak5 -- First pass of 10830 processing
+.ih
+USAGE
+destreak5 input_root output_root
+.ih
+PARAMETERS
+.ls input_root
+Root name for input files.
+.le
+.ls output_root
+Root name of output files.
+.le
+.ih
+DESCRIPTION
+Destreak5 takes as input the 5 files from a vacuum telescope 10830
+tape and produces 5 nearly identical files but with the streaks
+removed from the solar images and with the best fit ellipse parameters
+added to the image header.  The input files are expected to be in the
+directory 'imdir' and to have the extensions '001' thru '005'.  These
+input files are expected to be mag tape images produced by T2D.  The output
+files are stored in the current directory with the same extensions.
+Destreak5 calls 'readvt','quickfit', 'destreak', and various other utilities
+and is a cl script file.
+If an input image is not found, the processing for that image is skipped and
+a message is printed telling about the missing image.
+The next step in the 10830 reduction process is 'makehelium' which produces
+the projected daily grams.
+.ih
+EXAMPLES
+1. To destreak five files with root name m1585 and store the resulting images
+with root name M1585 the command would be:
+
+.nf
+	vt> destreak5 m1585 M1585
+.fi
+
+.ih
+SEE ALSO
+readvt, destreak, quickfit
+.endhelp
diff --git a/noao/imred/vtel/doc/dicoplot.hlp b/noao/imred/vtel/doc/dicoplot.hlp
new file mode 100644
index 00000000..5bb9f071
--- /dev/null
+++ b/noao/imred/vtel/doc/dicoplot.hlp
@@ -0,0 +1,36 @@
+.help dicoplot Dec84 noao.imred.vtel
+.ih
+NAME
+dicoplot -- Make plots of Carrington maps on the Dicomed
+.ih
+USAGE
+dicoplot input_image1 input_image2 rot_number
+.ih
+PARAMETERS
+.ls input_image1
+First image to plot on the output.
+.le
+.ls input_image2
+Second image to plot on the output.
+.le
+.ls rot_number
+Carrington rotation number.
+.le
+.ih
+DESCRIPTION
+Dicoplot produces plots on the Dicomed.
+.ih
+EXAMPLES
+1. To make a plot containing a 10830 gram and the associated weight gram where
+the carrington rotation number is 1841, the 10830 gram is "temp1",
+and the weight gram is "carweight" type:
+
+.nf
+	vt> dicoplot temp1 carweight 1841
+.fi
+
+The program gets information about the dates and longitudes from the image
+headers.
+.ih
+SEE ALSO
+.endhelp
diff --git a/noao/imred/vtel/doc/fitslogr.hlp b/noao/imred/vtel/doc/fitslogr.hlp
new file mode 100644
index 00000000..4a195e45
--- /dev/null
+++ b/noao/imred/vtel/doc/fitslogr.hlp
@@ -0,0 +1,58 @@
+.help fitslogr Dec85 noao.imred.vtel
+.ih
+NAME
+fitslogr -- Make a log of header information from a fits tape
+.ih
+USAGE
+fitslogr input_dev out_file startfnum endfnum
+.ih
+PARAMETERS
+.ls input_dev
+Tape drive, e.g. "mta1600" or just "mta"
+.le
+.ls out_file
+Name of output file to store information. Information is appended to this
+file to allow one to update a previously created file.
+.le
+.ls startfnum
+Tape file to start logging.
+.le
+.ls endfnum
+Tape file to stop logging.
+.le
+.ih
+DESCRIPTION
+Fitslogr reads FITS headers from successive tape files and compiles
+certain information into a single line of output for each file.
+Currently, the information output for each file includes:
+
+        Tape file number, IRAF image name, date, time, and the
+	Carrington longitude for each image.
+
+If all of these header parameters are not present, only the ones found
+will be printed out and garbage will come out for the empty parameters.
+The date is stored in a header parameter called OBS_DATE, the time is
+stored as 'seconds since midnight' in OBS_TIME and the Carrington
+longitude is stored in L_ZERO.
+To use this script, both the DATAIO package and the VTEL package must
+be loaded.
+.ih
+EXAMPLES
+1. To log all of the FITS images on a tape mounted on 'mta' and store the
+information in a file called 'CX052' the command would be:
+
+.nf
+	vt> fitslogr mta CX052 1 999
+.fi
+
+2. To log just the 40th through 60th files on mtb and see the output on
+your terminal, the command would be:
+
+.nf
+	vt> fitslogr mtb STDOUT 40 60
+.fi
+
+.ih
+SEE ALSO
+rfits
+.endhelp
diff --git a/noao/imred/vtel/doc/getsqib.hlp b/noao/imred/vtel/doc/getsqib.hlp
new file mode 100644
index 00000000..1bf24fb0
--- /dev/null
+++ b/noao/imred/vtel/doc/getsqib.hlp
@@ -0,0 +1,33 @@
+.help getsqib Jan85 noao.imred.vtel
+.ih
+NAME
+getsqib -- Extract a full disk squibby brightness image from a full disk image
+.ih
+USAGE
+getsqib inputimage outputimage
+.ih
+PARAMETERS
+.ls inputimage
+Name of image to get squibby brightness from.
+.le
+.ls outputimage
+Name of new output squibby brightness image.
+.le
+.ih
+DESCRIPTION
+Getsqib takes as input any full disk image and extracts the lower four bits
+from each pixel and stores this information in a new output image the same
+size as the input image.
+.ih
+EXAMPLES
+1. To extract the squibby brightness image from the image "test1" and store
+it in an image called "test1.sqib" the command would be:
+
+.nf
+	vt> getsqib test1 test1.sqib
+.fi
+
+.ih
+SEE ALSO
+putsqib
+.endhelp
diff --git a/noao/imred/vtel/doc/makehelium.hlp b/noao/imred/vtel/doc/makehelium.hlp
new file mode 100644
index 00000000..df27430c
--- /dev/null
+++ b/noao/imred/vtel/doc/makehelium.hlp
@@ -0,0 +1,38 @@
+.help makehelium Jan86 noao.imred.vtel
+.ih
+NAME
+makehelium -- Second pass of 10830 processing
+.ih
+USAGE
+makehelium input_root output_root
+.ih
+PARAMETERS
+.ls input_root
+Root name for input files.
+.le
+.ls output_root
+Root name of output files.
+.le
+.ih
+DESCRIPTION
+Makehelium takes the files output by 'destreak5' and projects them the
+small [180x180] maps.  The input files are expected to be in the current
+directory and have the extensions '1' thru '5'.  The output files are
+stored in the current directory with the extensions 'a1', 'a2', 'a3', 'b1', etc.
+This coding scheme is the same as that used in makeimages.  Note that the
+absolute value images for 10830 grams should be thrown out since they are
+garbage.
+Makehelium calls 'rmap' and 'imdelete' and is a cl script file.
+.ih
+EXAMPLES
+1. To run makehelium on five files with root name m1585 and store the resulting
+images with root name M1585 the command would be:
+
+.nf
+	vt> makehelium m1585 M1585
+.fi
+
+.ih
+SEE ALSO
+rmap
+.endhelp
diff --git a/noao/imred/vtel/doc/makeimages.hlp b/noao/imred/vtel/doc/makeimages.hlp
new file mode 100644
index 00000000..d5f5fe31
--- /dev/null
+++ b/noao/imred/vtel/doc/makeimages.hlp
@@ -0,0 +1,64 @@
+.help makeimages Jan86 noao.imred.vtel
+.ih
+NAME
+makeimages -- Magnetogram batch processing script
+.ih
+USAGE
+makeimages input_root output_root
+.ih
+PARAMETERS
+.ls input_root
+Root name for input files.
+.le
+.ls output_root
+Root name of output files.
+.le
+.ih
+DESCRIPTION
+Makeimages processes 5 magnetograms from raw data tape images into projected
+small [180x180] maps.  The input images are expected be output from T2D,
+be in the current imdir, and have the extensions '001' through '005'.
+The output files are stored in the current directory with the extensions
+'a1', 'a2', 'a3', 'b1', etc.  The output image coding scheme is the following:
+
+.nf
+	On the filename extensions the first character is a letter
+	corresponding to the tape file position.
+		a = first file on tape
+		b = second
+		    .
+		    .
+		e = fifth
+
+	The second character specifies which type of image this is.
+		1 = data
+		2 = absolute value
+		3 = weights
+.fi
+
+Note: A logical directory called "scratch" must be set up before this
+program is run.  This logical directory must point to the directory
+containing the input images.  This can be set up as in the following
+example:
+
+vt> set scratch = "scr1:[recely]"
+
+where this particular directory is a VAX/VMS type name.  If the image
+files are in the user's home directory then "scratch" can be set to
+"home".
+
+Makeimages calls 'readvt', 'quickfit', 'rmap',
+'delete', and 'imdelete' and is a cl script.
+.ih
+EXAMPLES
+1. To process five magnetograms with root name m1585 and produce output images
+with the root name M1585, the command would be.
+
+.nf
+	vt> makeimages m1585 M1585
+.fi
+
+.ih
+SEE ALSO
+readvt, quickfit, rmap, delete, imdelete
+.endhelp
diff --git a/noao/imred/vtel/doc/merge.hlp b/noao/imred/vtel/doc/merge.hlp
new file mode 100644
index 00000000..24dbb778
--- /dev/null
+++ b/noao/imred/vtel/doc/merge.hlp
@@ -0,0 +1,90 @@
+.help merge Dec84 noao.imred.vtel
+.ih
+NAME
+merge -- Merge together daily synoptic grams into a complete Carrington map
+.ih
+USAGE
+merge outimage outweight outabs outratio month day year
+.ih
+PARAMETERS
+.ls outimage
+Name of output image.
+.le
+.ls outweight
+Output image containing weights, number of pixels per pixel.
+.le
+.ls outabs
+Output image containing the sums of the absolute values of the flux.
+Not used when merging 10830 maps.
+.le
+.ls outratio
+Output image containing the ratio of outimage/outabs.
+Not used when merging 10830 maps.
+.le
+.ls month, day, year
+Date of the center of this Carrington rotation.
+.le
+.ls longout = 180
+Longitude of the center of this Carrington rotation.
+.le
+.ls mergelist = "mergelist"
+File containing list of files to be merged.
+.le
+.ih
+DESCRIPTION
+Merge adds up daily synoptic grams to produce a Carrington rotation map.
+the input images are 180x180 and the output images are 360x180.  The input
+images are read from the file mergelist.  Merge then weights the input
+image as cos**4 in x where the center of the image corresponds to zero angle
+and the left and right edges of the image correspond to -90 and +90 degrees
+respectively. The input image consists of an unweighted "data" image,
+a weight image, and an absolute value image.  The summing is done on the
+"data" image, on the weight image, and on the absolute value image
+separately to produce three output images.  Finally the "data" image is
+divided by the absolute value image to produce a 4th output image.
+If 10830 data is being merged there are only two(2) images per day, the
+"data" image and the "weight" image.  Also there are only two(2) output images,
+the "data" merged image and the "weights" merged image.
+A note about the mergelist file, the three grams for each day must be stored
+in the following sequence (data, absolute value, weight) for magnetograms
+and the two grams for each day must be stored as (data, weight) for 10830.
+The filenames must be one file name per line in the mergelist and files
+for different days must be grouped together, for example mergelist might look
+like:
+
+.nf
+	MAG01                                  MAG01
+	MAG01a                                 MAG01w
+	MAG01w     for magnetograms or         MAG02      for 10830 grams
+	MAG02                                  MAG02w
+	MAG02a
+	MAG02w
+.fi
+
+for merging only two days of data where the first day is MAG01 and the second
+is MAG02. The 'a' extension stands for absolute value and the 'w' for weights.
+.ih
+EXAMPLES
+1. To merge a number of images on disk into output images called "im",
+"imweight", "imabs", and "imratio", where the date corresponding to the
+center of the Carrington map is 3/20/84 the command would be (magnetograms):
+
+.nf
+	vt> merge im imweight imabs imratio 3 20 84
+.fi
+
+The same command used for 10830 grams would be:
+
+.nf
+	vt> merge im imweight 3 20 84
+.fi
+
+2. If you have the list of files to be merged listed in a file called "mlist"
+instead of "mergelist" the command would be modified to read:
+
+.nf
+	vt> merge im imweight 3 20 84 mergelist="mlist"
+.fi
+.ih
+SEE ALSO
+.endhelp
diff --git a/noao/imred/vtel/doc/mrotlogr.hlp b/noao/imred/vtel/doc/mrotlogr.hlp
new file mode 100644
index 00000000..f86dbc0e
--- /dev/null
+++ b/noao/imred/vtel/doc/mrotlogr.hlp
@@ -0,0 +1,63 @@
+.help mrotlogr Jul86 "noao.imred.vtel"
+.ih
+NAME
+mrotlogr -- Make a log of header information from a fits tape (Carrington maps).
+.ih
+USAGE
+mrotlogr input_dev out_file startfnum endfnum append
+.ih
+PARAMETERS
+.ls input_dev
+Tape drive, e.g. "mta1600" or just "mta"
+.le
+.ls out_file
+Name of output file to store information. Information is appended to this
+file to allow one to update a previously created file.
+.le
+.ls startfnum
+Tape file to start logging.
+.le
+.ls endfnum
+Tape file to stop logging.
+.le
+.ls append
+Flag to signal that we are appending to an existing file.
+.le
+.ih
+DESCRIPTION
+Mrotlogr reads FITS headers from successive tape files and compiles
+certain information into a single line of output for each file.
+Currently, the information output for each file includes:
+
+.nf
+        Tape file number, IRAF image name, date, time, and the
+	Carrington longitude for each image.
+.fi
+
+If all of these header parameters are not present, only the ones found
+will be printed out and garbage will come out for the empty parameters.
+The date is stored in a header parameter called OBS_DATE, the time is
+stored as 'seconds since midnight' in OBS_TIME and the Carrington
+longitude is stored in L_ZERO.
+To use this script, both the DATAIO package and the VTEL package must
+be loaded.
+.ih
+EXAMPLES
+1. To log all of the FITS images on a tape mounted on 'mta' and store the
+information in a file called 'CX052' the command would be:
+
+.nf
+	vt> mrotlogr mta CX052 1 999 no
+.fi
+
+2. To log just the 40th through 60th files on mtb and see the output on
+your terminal, the command would be:
+
+.nf
+	vt> mrotlogr mtb STDOUT 40 60 no
+.fi
+
+.ih
+SEE ALSO
+rfits
+.endhelp
diff --git a/noao/imred/vtel/doc/mscan.hlp b/noao/imred/vtel/doc/mscan.hlp
new file mode 100644
index 00000000..d6b7f46b
--- /dev/null
+++ b/noao/imred/vtel/doc/mscan.hlp
@@ -0,0 +1,86 @@
+.help mscan May88 noao.imred.vtel
+.ih
+NAME
+mscan -- Read sector scans from tape into IRAF images
+.ih
+USAGE
+mscan input
+.ih
+PARAMETERS
+.ls input
+File template or device, e.g. "junk" or "s*" or "mta1600[1]" or "mtb800"
+.le
+.ls files
+List of tape file numbers or ranges delimited by commas, e.g. "1-3,5-8".
+`Files' is requested only if no file number is given in `input' and the
+input is tape.
+Files will be read in ascending order, regardless of the order of the list.
+Reading will terminate if EOT is reached, thus a list such as "1-999"
+may be used to read all the files on the tape.
+.le
+.ls verbose = yes
+Flag to signal program that it should produce verbose output.  This means
+header information.
+.le
+.ls makeimage = yes
+Flag to signal the program that it should make images.  If this parameter
+is set to no, the header will be read and decoded but no data will be read
+and no image will be produced on disk.
+.le
+.ls brief = yes
+Flag to make mscan produce brief filenames for the output images.  These
+filenames have the form [svb]nnn e.g. s034 or b122.  The b is for a brightness
+image, the v is for a velocity image, and the s is for a select image.  The
+'nnn' is the tape sequence number or the filenumber in a template expansion.
+If this flag is set to false the long filenames described below in the 
+"Description" section will be produced.
+.le
+.ls select = yes
+Flag to tell the program to make a select image.
+.le
+.ls bright = yes
+Flag to tell the program to make a brightness image.
+.le
+.ls velocity = yes
+Flag to tell the program to make a velocity image.
+.le
+.ih
+DESCRIPTION
+Mscan reads all or selected area scans from a vacuum telescope tape
+and formats the data into multiple IRAF images.  Type 1, 2, and 3 area
+scans can produce 3 output images and type 4 produces one output image.
+The long image names are assembled in the following way:
+.nf
+
+     The first letter is one of [bsv] for brightness, select, or velocity.
+     The next two digits are the day of the month.
+     Underbar.
+     The next 4 digits are the hour and minute.
+     Underbar.
+     Finally there is a three digit tape sequence number.
+     ie.
+
+		 b13_1709_002
+.fi
+
+.ih
+EXAMPLES
+1. To read files 5-7 from mta at 1600 bpi, the command would be:
+
+.nf
+	vt> mscan mta1600 5-7
+.fi
+
+2. To see the header information only for file 6, one could use the command:
+
+.nf
+	vt> mscan mta1600[6] make-
+.fi
+
+3. To read file 4 from mta and only produce a velocity image:
+
+.nf
+	vt> mscan mta[4] bri- sel-
+.fi
+
+.endhelp
diff --git a/noao/imred/vtel/doc/pimtext.hlp b/noao/imred/vtel/doc/pimtext.hlp
new file mode 100644
index 00000000..e78fdc8d
--- /dev/null
+++ b/noao/imred/vtel/doc/pimtext.hlp
@@ -0,0 +1,110 @@
+.help pimtext May86 noao.imred.vtel
+.ih
+NAME
+pimtext -- Put image text. Use pixel font to write text into image.
+.ih
+USAGE
+pimtext iraf_files
+.ih
+PARAMETERS
+.ls iraf_files
+Image or images to be written into.  This entry may contain wild cards and
+will be expanded into however many files match the wild card.
+.le
+.ls refim
+Reference image to pull date and time parameters from in the event the "ref"
+flag is set.
+.le
+.ls ref
+Reference flag.  When set, causes the program to take information (date/time)
+from the reference image and write it into the image or images expanded from
+the template "iraf_images".
+.le
+.ls x = 10
+X position (column) in image to write text.
+.le
+.ls y = 10
+Y position (line) in image to write text.
+.le
+.ls xmag = 2
+Factor by which to magnify the text in the x direction.  This must be an
+integer.  The pixelfont is expanded by pixel replication.  The font width
+at xmag=1 is 6.
+.le
+.ls ymag = 2
+Factor by which to magnify the text in the y direction.  This must be an
+integer.  The pixelfont is expanded by pixel replication.  The font width
+at ymag=1 is 7.
+.le
+.ls val = -10000
+Value to put in text pixels.
+.le
+.ls setbgnd = yes
+Boolean parameter to signal the program to fill in the area behind the
+characters with pixels set to bgndval.
+.le
+.ls bgndval = 10000
+Pixel value to use to fill in background in text block.
+.le
+.ls date = yes
+Flag that instructs the program to look for the date in the 
+image header and write it into the image.  If the date and time
+flags are both set, both will be written into the image as a single
+string.
+.le
+.ls time = yes
+Flag that instructs the program to look for the time in the 
+image header and write it into the image.
+.le
+.ls text
+Text string to write into image.
+.le
+.ih
+DESCRIPTION
+Pimtext writes either the date and/or time or the indicated text string into
+the image or images specified.
+Pimtext, by default, writes the date and/or time into the image in the lower
+left corner.  If it cannot find the date or time pimtext will give a warning
+and read a text string from the users terminal.  If the date and time flags are
+set to 'no', pimtext will take the text string to be written from the user.
+The position of the text may be adjusted by setting
+the parameters 'x' and 'y' which set the lower left pixel of
+the text block.  The pixels in the text block behind the characters may
+be set to a particular value when the 'setbgnd' flag is set.  The pixel
+values used to write the text and the background can be set by adjusting
+the parameters 'val' and 'bgndval'.  If the text overlaps the image
+edge in the X direction it will be truncated.  If it overlaps in Y it will
+not be written.
+The user may magnify the text by adjusting the "xmag" and "ymag" parameters.
+The default (2,2) is a nice size for display in a 512 by 512 image.  Bigger
+images may need bigger text, smaller images may need smaller text.
+The "ref" flag is used to write information from one image into another
+image.
+
+.ih
+EXAMPLES
+1. To write the date and time into the three images s13_1709_001, v13_1709_001,
+and b13_1709_001 (assuming the directory contains only these three images)
+the command would be:
+
+.nf
+	vt> pimtext ?13*
+.fi
+
+2. To write the text string "hello world" into the image 'testim' the command
+would be
+
+.nf
+	vt> pimtext testim 'hello world' date=no time=no
+.fi
+
+3. To write the date and time into the images s1, s2, s3, s4 and position
+the text at pixel 30,30, and turn off the text background fill, the command
+would be:
+
+.nf
+	vt> pimtext s* x=30 y=30 setbgnd=no
+.fi
+.ih
+SEE ALSO
+.endhelp
diff --git a/noao/imred/vtel/doc/putsqib.hlp b/noao/imred/vtel/doc/putsqib.hlp
new file mode 100644
index 00000000..f6400cfe
--- /dev/null
+++ b/noao/imred/vtel/doc/putsqib.hlp
@@ -0,0 +1,38 @@
+.help putsqib Jan85 noao.imred.vtel
+.ih
+NAME
+putsqib -- Merge a full disk image with a squibby brightness image
+.ih
+USAGE
+putsqib inputimage sqibimage outputimage
+.ih
+PARAMETERS
+.ls inputimage
+Name of data image to merge with squibby brightness image.
+.le
+.ls sqibimage
+Name of squibby brightness image to merge with data image.
+.le
+.ls outputimage
+Name of new, merged, output image.
+.le
+.ih
+DESCRIPTION
+Putsqib accepts as input a data image and a squibby brightness image.  It
+multiplies each pixel in the input data image by 16 and adds the associated
+pixel from the squibby brightness input image.  The pixel is then written
+to the new, output image.
+.ih
+EXAMPLES
+1. To merge a data image called 'data' and a squibby brightness image called
+'sqib' and store the result in an image called 'complete', the command
+would be:
+
+.nf
+	vt> putsqib data sqib complete
+.fi
+
+.ih
+SEE ALSO
+getsqib
+.endhelp
diff --git a/noao/imred/vtel/doc/quickfit.hlp b/noao/imred/vtel/doc/quickfit.hlp
new file mode 100644
index 00000000..41621b6d
--- /dev/null
+++ b/noao/imred/vtel/doc/quickfit.hlp
@@ -0,0 +1,59 @@
+.help quickfit Dec84 noao.imred.vtel
+.ih
+NAME
+quickfit -- Fit an ellipse to the limb for a full disk scan
+.ih
+USAGE
+quickfit image
+.ih
+PARAMETERS
+.ls image
+Name of image to be fit.
+.le
+.ls threshold = 4
+Squibby brightness threshold to use in determining limb points.
+.le
+.ls xguess = 1024
+X coordinate of center of first guess circle.
+.le
+.ls yguess = 1024
+Y coordinate of center of first guess circle.
+.le
+.ls halfwidth = 50
+Halfwidth of window centered on previous limb point to search through
+for a limb point on the current line.
+.le
+.ls rowspace = 20
+Number of rows to skip between limbpoints near center in y.
+.le
+.ls rejectcoeff = .02
+Least squares rejection coefficient.  If radius of a limbpoint is more than
+this far from the limb, where limbradius = 1.0, it is not used in the fit.
+.le
+.ih
+DESCRIPTION
+Quickfit finds the least squares best fit ellipse to the limb in a full
+disk scan.  Quickfit returns the ellipse parameters (x,y coordinates of
+the ellipse center and the x and y semidiameters), the number of limbpoints
+found, the number of limbpoints rejected, and the fraction of limb
+points rejected by the least squares routine.  This 'fraction rejected'
+allows the user to determine to some extent the goodness of the data and
+allows him or her to rerun Quickfit with different parameters to take
+this goodness into account.  Quickfit also returns the sub-earth latitude
+and longitude when in verbose mode.  The ellipse and ephemeris parameters
+are stored in the image header for future reference.
+.ih
+EXAMPLES
+1. To find the best fit ellipse for the limb in an image called "image1" and to
+see verbose output, one would use the following command:
+
+.nf
+	vt> quickfit image1 v+
+.fi
+
+This will also use the default values of rowspace, halfwidth,
+and rejectcoeff.
+
+.ih
+SEE ALSO
+.endhelp
diff --git a/noao/imred/vtel/doc/readvt.hlp b/noao/imred/vtel/doc/readvt.hlp
new file mode 100644
index 00000000..b9d6abe7
--- /dev/null
+++ b/noao/imred/vtel/doc/readvt.hlp
@@ -0,0 +1,86 @@
+.help readvt May87 noao.imred.vtel
+.ih
+NAME
+readvt -- Read vacuum telescope full disk grams
+.ih
+USAGE
+readvt input_fd files output_image
+.ih
+PARAMETERS
+.ls input_fd
+File or device template, e.g. "mta1600[1]" or "mtb800" or "junk" or "s*"
+.le
+.ls files
+List of tape file numbers or ranges delimited by commas, e.g. "1-3,5-8".
+`Files' is requested only if no file number is given in `input'.
+Files will be read in ascending order, regardless of the order of the list.
+Reading will terminate if EOT is reached, thus a list such as "1-999"
+may be used to read all the files on the tape.
+.le
+.ls output_image template
+Name to give output image.  If the input file template is not a magtape
+specification then this can be an IRAF filename template to be
+expanded into a list of files.  If the number of files in the input
+template and in the output template do not match and if the output
+template expands to one filename then that filename is used as a
+root name to which filenumbers are appended for each input file.
+i.e. "junk" becomes "junk001", "junk002", etc.  If the input template
+is a magtape without a filenumber attached, i.e. "mta", the
+output name is used as a root name and the file number is appended
+for each file read.
+.le
+.ls verbose = no
+Flag to signal program that it should produce verbose output.  This includes
+header information and progress reports.
+.le
+.ls headeronly = no
+Flag to signal the program that it should only print out header information
+and quit without reading the data.  The 'verbose' flag must be set to yes
+to use this flag since otherwise the header information will not be printed.
+This flag is used to look at headers on the tape to check dates, times
+and observation types.
+.le
+.ls robust = no
+Flag to signal program that it should ignore a wrong observation type in the
+image header.
+.le
+.ih
+DESCRIPTION
+Readvt reads any one of the grams on a vacuum telescope tape and puts the
+data into an IRAF image.  The IRAF image is 2048x2048 short integers.
+.ih
+EXAMPLES
+1. To read the second image from mta at 1600 bpi, store the image into "image1"
+and see verbose output the command would be:
+
+.nf
+	vt> readvt mta1600[2] image1 v+
+.fi
+
+2. To look at the header information of the 4th file on a tape which is on
+mtb and which was written at 1600 bpi, the command would be:
+
+.nf
+	vt> readvt mtb1600[4] v+ h+
+.fi
+
+3. To read the disk files "s001", "s002", "s003", "s004" and put the output
+images into the files "s001i", "s002i", "s003i", "s004i" without
+verbose output (assuming no other file in the directory starts with "s")
+the command would be:
+
+.nf
+	vt> readvt s* s*//i
+.fi
+
+4. To read the first five files on mta and put the output images into files
+images with root name HHH the command would be:
+
+.nf
+	vt> readvt mta 1-5 HHH
+.fi
+
+.ih
+SEE ALSO
+writevt
+.endhelp
diff --git a/noao/imred/vtel/doc/rmap.hlp b/noao/imred/vtel/doc/rmap.hlp
new file mode 100644
index 00000000..e4b4a645
--- /dev/null
+++ b/noao/imred/vtel/doc/rmap.hlp
@@ -0,0 +1,47 @@
+.help rmap Dec84 noao.imred.vtel
+.ih
+NAME
+rmap -- Project a full disk gram into a 180x180 flat image
+.ih
+USAGE
+rmap inputimage outputimage outweight outabs
+.ih
+PARAMETERS
+.ls inputimage
+Name of image to be projected.
+.le
+.ls outputimage
+Name to give output data image.
+.le
+.ls outweight
+Name to give output weight image.
+.le
+.ls outabs
+Name to give output absolute value image.
+.le
+.ih
+DESCRIPTION
+Rmap accepts as input a full disk carrington gram in a 2048x2048 IRAF image
+and projects it into a 180x180 IRAF image such that the lines of longitude
+and latitude are straight lines.  The output is the data image, the weight
+image (which is the count of the number of pixels of the input image which
+were summed to produce the single output pixel), and the absolute value image
+which is the same as the data image except that the absolute value of each
+input pixel is taken before being summed into the output pixel.
+Rmap calculates the mean field, the mean of the absolute value of the field,
+and the number of pixels in the original gram used to make the projection.
+These three parameters are stored in the output "data" image header as
+MEAN_FLD, MEANAFLD, and NUMPIX respectively.
+.ih
+EXAMPLES
+1. To project an image called "im10830" and produce output images "im10830.d",
+"im10830.w", and "im10830.a", one would use the following command:
+
+.nf
+	vt> rmap im10830 im10830.d im10830.w im10830.a
+.fi
+
+.ih
+SEE ALSO
+readvt, quickfit, and merge.
+.endhelp
diff --git a/noao/imred/vtel/doc/syndico.hlp b/noao/imred/vtel/doc/syndico.hlp
new file mode 100644
index 00000000..25b4b0ee
--- /dev/null
+++ b/noao/imred/vtel/doc/syndico.hlp
@@ -0,0 +1,77 @@
+.help syndico May89 noao.imred.vtel
+.ih
+NAME
+syndico -- Make dicomed plots of full disk images (18 centimeters in diameter)
+.ih
+USAGE
+syndico image
+.ih
+PARAMETERS
+.ls image
+Image to plot on the dicomed.
+.le
+.ls logofile = iraf$noao/imred/vtel/nsolcrypt.dat
+File containing the text encoded NSO logo image.
+.le
+.ls device = dicomed
+Device on which to plot the image.
+.le
+.ls sbthresh = 2
+Squibby brightness threshold used to determine the limb for trimming.
+.le
+.ls plotlogo = yes
+Flag indicating whether or not to plot the logo.
+.le
+.ls verbose = yes
+Flag indicating to the program that it should give progress reports.
+.le
+.ls forcetype = no
+Flag to override the wavelength designation from the image header.
+.le
+.ls magnetic = yes
+If 'forcetype' = 'yes' then this flag designates that we should force
+to magnetic (8688).  If set to 'no' the type is forced to 10830.
+The effect of forcing the type is to choose which lookup table to
+use when scaling the image.
+.le
+.ls month
+Month the observation was taken (January = 1,,,December = 12).
+.le
+.ls day
+Day of the month the observation was taken.
+.le
+.ls year
+Year the observation was taken (two digits only, ie. 89 for 1989).
+.le
+.ls hour
+Hour of the day the observation was taken (universal time, 1-24).
+.le
+.ls minute
+Minute the observation was taken (0-59).
+.le
+.ls second
+Second the observation was taken (0-59).
+.le
+.ih
+DESCRIPTION
+Syndico produces full disk plots on the Dicomed.  The ephemeris data
+is used to estimate the radius of the image and the center of the
+disk is gotten from the image header.  Using this data, an image is
+made that is as close to 18 centimeters in diameter as possible.
+There are two greyscale lookup tables corresponding to the two types
+of image normally used, the magnetogram and the spectroheliogram.
+If the wavelength is something other than 8688 or 10830, a linear
+greyscale is used.
+
+The National Solar Observatory (tentative) logo is read from an encoded
+text file and put on the plot if requested (default).
+.ih
+EXAMPLES
+
+.nf
+	vt> syndico image1
+.fi
+
+.ih
+SEE ALSO
+.endhelp
diff --git a/noao/imred/vtel/doc/tcopy.hlp b/noao/imred/vtel/doc/tcopy.hlp
new file mode 100644
index 00000000..57a523cb
--- /dev/null
+++ b/noao/imred/vtel/doc/tcopy.hlp
@@ -0,0 +1,56 @@
+.help tcopy Oct85 noao.imred.vtel
+.ih
+NAME
+tcopy -- Tape to tape copy
+.ih
+USAGE
+tcopy input_fd output_fd
+.ih
+PARAMETERS
+.ls input_fd
+Tape file or device name for input, e.g. "mta1600[1]" or "mtb800"
+.le
+.ls files
+List of tape file numbers or ranges delimited by commas, e.g. "1-3,5-8".
+`Files' is requested only if no file number is given in `input_fd'.
+Files will be read in ascending order, reguardless of the order of the list.
+Reading will terminate if EOT is reached, thus a list such as "1-999"
+may be used to read all the files on the tape.
+.le
+.ls output_fd
+File or device name, e.g. "mta1600[1]" or "mtb800"  If a file number is not
+given the user will be asked whether or not this is a new tape.  If it is
+a new tape the file number "1" will be used.  If it is not a new tape, i.e. 
+it already has data on it, then file number "EOT" will be used.
+.le
+.ls new_tape = no
+New tape flag.  Usage is described above.
+.le
+.ls verbose = no
+Flag to signal program that it should print information about progress while
+running.
+.le
+.ih
+DESCRIPTION
+Tcopy copies files from one tape to another reporting read errors on the
+input tape as it goes.  Tcopy, when it encounters a read error, does its
+best to get as much data as possible by validating the input buffer after
+the error, guessing its length, and writing it out to the output tape.
+.ih
+EXAMPLES
+1. To copy all the files on mta to a new tape on mtb:
+
+.nf
+	vt> tcopy mta 1-999 mtb yes
+.fi
+
+2. To copy file 5 from mta and append it to the tape on mtb:
+
+.nf
+	vt> tcopy mta1600[5] mtb no
+.fi
+
+.ih
+SEE ALSO
+t2d
+.endhelp
diff --git a/noao/imred/vtel/doc/trim.hlp b/noao/imred/vtel/doc/trim.hlp
new file mode 100644
index 00000000..9962db80
--- /dev/null
+++ b/noao/imred/vtel/doc/trim.hlp
@@ -0,0 +1,33 @@
+.help trim Jan85 noao.imred.vtel
+.ih
+NAME
+trim -- Trim the limb. Zero all pixels off the limb in a full disk image
+.ih
+USAGE
+trim inputimage threshold
+.ih
+PARAMETERS
+.ls inputimage
+Name of data image to trim.
+.le
+.ls threshold
+Squibby brightness value to use as a threshold in determining the limb.
+.le
+.ih
+DESCRIPTION
+Trim scans all the pixels in an image and sets those pixels to zero that
+contain a squibby brightness smaller than the threshold value.  This is
+done in place, that is, the input image gets modified.
+.ih
+EXAMPLES
+1. To trim a data image called 'data' with a squibby brightness threshold
+of 4 (the standard value) the command would be:
+
+.nf
+	vt> trim data 4
+.fi
+
+.ih
+SEE ALSO
+getsqib, putsqib
+.endhelp
diff --git a/noao/imred/vtel/doc/unwrap.hlp b/noao/imred/vtel/doc/unwrap.hlp
new file mode 100644
index 00000000..67fad069
--- /dev/null
+++ b/noao/imred/vtel/doc/unwrap.hlp
@@ -0,0 +1,95 @@
+.help unwrap May87 noao.imred.vtel
+.ih
+NAME
+unwrap -- Filter an IRAF image; remove binary wrap-around.
+.ih
+USAGE
+unwrap listin listout
+.ih
+PARAMETERS
+.ls listin
+List of images to unwrap, this is an IRAF template.
+.le
+.ls listout
+List of output images, this is an IRAF template.  If the output list
+is the same as the input list, the unwrapping is done in-place.
+.le
+.ls threshold1 = 128
+Data jump threshold for first unwrap pass.
+.le
+.ls wrapval1 = 256
+Factor to multiply wrap value by for first unwrap pass.
+.le
+.ls threshold2 = 128
+Data jump threshold for second unwrap pass.
+.le
+.ls wrapval2 = 256
+Factor to multiply wrap value by for second unwrap pass.
+.le
+.ls cstart = 2
+Column of image to start unwrapping.  Columns are numbered from left to right.
+.le
+.ls step = 5
+Number of steps (1-5) to perform on image (unwrap1, difference, unwrap2,
+reconstruct, fixlines).
+.le
+.ls verbose = yes
+If set, program produces progress reports, etc.
+.le
+.ih
+DESCRIPTION
+Unwrap checks for binary wraparound in IRAF images.
+The algorithm consists of reading the image line by line, unwrapping
+each line, and writing the line out to another image.  The procedure
+for unwraping is a five step process.
+.ls Step one: unwrap1
+Unwrapping is accomplished by scanning the data line and looking for
+large jumps in the data values.  Large negative jumps are interpreted
+as data wrapping and large positive jumps are interpreted as data unwrapping.
+The program keeps track of the number of wraps, each data element in the
+array has wrapval1 * wrapnumber added.  This effectively unwraps an image
+in which the point to point variation in the data values is small compared
+to the variation caused by a binary wrap.
+.le
+.ls Step two: difference
+A difference image is produced from the above step one image by calculating
+the pixel to pixel difference between all of the pixels in the line.  The
+first column of the image is generally left intact so that the image can
+be reconstructed in a later step.  Step one often produces streaks in the
+image due to data variation large enough to mimic wrapping.  This step
+two difference image eliminates most of these streaks except for their
+point of origin, where the confusion occured.
+.le
+.ls Step three: unwrap2
+This is the second unwrapping step.  The image is unwrapped as in step
+one using the second set of unwrap values (threshold2, wrapval2).
+.le
+.ls Step four: reconstruct
+The original image is reconstructed from the step three image by
+adding pixel values successively to line pixels.
+.le
+.ls Step five: fixlines
+If bad lines (streaks) still can be found in the image, they are
+eliminated by replacing the line by the average of the lines above
+and below bad line.
+.le
+.ih
+EXAMPLES
+1. To unwrap an image called "continuum" and store the resulting image in
+"unwrapped", and use the default parameters, the command might be:
+
+.nf
+	vt> unwrap continuum unwrapped
+.fi
+
+2. To unwrap all the images in the directory starting with s1492 and store
+the unwrapped images in s1492*u, to start in column 31, to do four steps,
+and to see verbose output, the command might be:
+
+.nf
+	vt> unwrap s1494* s1492*//u cstart=31 step=4 v+
+.fi
+
+.ih
+SEE ALSO
+.endhelp
diff --git a/noao/imred/vtel/doc/vtblink.hlp b/noao/imred/vtel/doc/vtblink.hlp
new file mode 100644
index 00000000..0bb26779
--- /dev/null
+++ b/noao/imred/vtel/doc/vtblink.hlp
@@ -0,0 +1,53 @@
+.help vtblink Dec84 noao.imred.vtel
+.ih
+NAME
+vtblink -- Blink daily grams to check registration
+.ih
+USAGE
+vtblink 
+.ih
+PARAMETERS
+.ls imname1
+First image to be mapped.
+.le
+.ls imname2
+Subsequent images to be mapped
+.le
+.ls z1 = -3000.0
+Minimum grayscale intensity to be mapped during 'display'.
+.le
+.ls z2 = 3000.0
+Maximum grayscale intensity to be mapped during 'display'.
+.le
+.ih
+DESCRIPTION
+Vtblink allows the user to blink successive frames of data on the IIS.  The
+program calculates the offset between grams based on the
+longitudes for each image.  Vtblink will ask for each successive image 
+and will display it on the next (mod 4) IIS frame.
+After each image is displayed the user is put back out in the cl so that he/she
+can use any of the images$tv tasks to analyze the data.  The user returns to
+the blink program by typing 'bye' to the cl prompt.  To exit the program the
+user enters the "end" for the filename.  Images are displayed with the grayscale
+limits set by default to -3000.0 and 3000.0.  These values correspond to the
+parameters z1 and z2 which may be given on the command line.  If the user
+forgets which IIS frame contains which image, he/she can enter "stat" to the
+"next image" prompt and will get a list of which images are in which frames.
+.ih
+EXAMPLES
+1. To run vtblink with the default gray scale parameters just type:
+
+.nf
+	vt> vtblink
+.fi
+
+2. To run vtblink with gray scale parameters z1=-4000.0, z2=4000.0, the
+command would be:
+
+.nf
+	vt> vtblink z1=-4000.0 z2=4000.0
+.fi
+.ih
+SEE ALSO
+display, blink, lumatch
+.endhelp
diff --git a/noao/imred/vtel/doc/vtexamine.hlp b/noao/imred/vtel/doc/vtexamine.hlp
new file mode 100644
index 00000000..20bf13eb
--- /dev/null
+++ b/noao/imred/vtel/doc/vtexamine.hlp
@@ -0,0 +1,50 @@
+.help vtexamine Jan86 noao.imred.vtel
+.ih
+NAME
+vtexamine -- examine the headers and record structure of vacuum telescope files
+.ih
+USAGE
+mtexamine tape_file
+.ih
+PARAMETERS
+.ls tape_file
+Tape file, e.g. "mta1600[2]" or "mta1600".
+.le
+.ls files
+List of tape file numbers or
+ranges delimited by commas, e.g. "1-3,5-8".
+File_list is requested only if no file number is given in tape_file.
+Files will be read in ascending order, regardless of the order of the list.
+Reading
+will terminate if EOT is reached, thus a list such as "1-999"
+may be used to read all the files on the tape.
+.le
+.ls headers=yes
+Decode and print header information from each file examined.
+.le
+.ih
+DESCRIPTION
+By default, vtexamine decodes and prints header and record
+structure information for each file examined.  The header
+information can be turned off by setting headers=no.
+.ih
+EXAMPLES
+1. To see the header information and determine the record structure of all the
+files on a vacuum telescope tape and send the result to the file vtdump:
+
+.nf
+	vt> vtexamine mtb1600 1-999 > vtdump
+.fi
+
+2. To just get the record structure for the third file on a vacuum telescope
+tape the command would be:
+
+.nf
+	vt> vtexamine mtb1600[3] headers=no
+.fi
+.ih
+BUGS
+The IRAF magtape i/o routines do not permit data beyond a double EOF
+to be accessed. Therefore vtexamine cannot be used to examine tapes with
+embedded double EOFs.
+.endhelp
diff --git a/noao/imred/vtel/doc/writetape.hlp b/noao/imred/vtel/doc/writetape.hlp
new file mode 100644
index 00000000..6159c016
--- /dev/null
+++ b/noao/imred/vtel/doc/writetape.hlp
@@ -0,0 +1,35 @@
+.help writetape Jan86 noao.imred.vtel
+.ih
+NAME
+writetape -- Write 5 grams to tape in full disk format. (Used as
+intermediate step in 10830 processing.
+.ih
+USAGE
+writetape input_root tape_name
+.ih
+PARAMETERS
+.ls getname
+Root name for input files.
+.le
+.ls getmtape
+Tape file descriptor.
+.le
+.ih
+DESCRIPTION
+Writetape takes as input five(5) full disk grams in IRAF image format
+and writes them to tape in a format identical to the original full disk
+grams produced on the vacuum telescope.  The input image names are expected
+to be the "input_root" name concatenated with the numbers "1", "2", ... "5".
+Writetape calls 'writevt' and is a cl script file.
+.ih
+EXAMPLES
+1. To write five files with root name m1585 to tape mta, the command would be:
+
+.nf
+	vt> writetape m1585 mta
+.fi
+
+.ih
+SEE ALSO
+readvt, writevt
+.endhelp
diff --git a/noao/imred/vtel/doc/writevt.hlp b/noao/imred/vtel/doc/writevt.hlp
new file mode 100644
index 00000000..3475a5c4
--- /dev/null
+++ b/noao/imred/vtel/doc/writevt.hlp
@@ -0,0 +1,43 @@
+.help writevt Dec84 noao.imred.vtel
+.ih
+NAME
+writevt -- Write vacuum telescope full disk grams to tape
+.ih
+USAGE
+writevt input_image output_fd
+.ih
+PARAMETERS
+.ls input_image
+Name of input image.
+.le
+.ls output_fd
+File or device name, e.g. "mta1600[1]" or "mtb800"  If a file number is not
+given the user will be asked whether or not this is a new tape.  If it is
+a new tape the file number "1" will be used.  If it is not a new tape, i.e. 
+it already has data on it, then file number "EOT" will be used.
+.le
+.ls verbose = no
+Flag to signal program that it should produce verbose output.  This includes
+header information and progress reports.
+.le
+.ls new_tape = no
+New tape flag.  Usage is described above.
+.le
+.ih
+DESCRIPTION
+Writevt writes a full disk vacuum telescope gram in IRAF image format to tape.
+The IRAF image is 2048x2048 short integers.  The tape format is the same as
+that used to write original data tapes on the mountain.
+.ih
+EXAMPLES
+1. To write the image "image1" to mta at 1600 bpi at file number 3 and
+see verbose output the command would be:
+
+.nf
+	vt> writevt image1 mta1600[3] v+
+.fi
+
+.ih
+SEE ALSO
+readvt
+.endhelp
diff --git a/noao/imred/vtel/fitslogr.cl b/noao/imred/vtel/fitslogr.cl
new file mode 100644
index 00000000..42681118
--- /dev/null
+++ b/noao/imred/vtel/fitslogr.cl
@@ -0,0 +1,104 @@
+#{ FITSLOGR -- Read all the headers on a FITS tape and print out some
+# of the header information for each file.
+
+{
+    struct header, headline, tfile, irafname
+    struct obsdate, lzero, keyword
+    struct tape, outfile, zcm, meanafld, numpix, meanfld
+    struct *fp
+    int	sfnum, efnum, filenum, ssm
+    int	hours, minutes, seconds
+    bool append, mag
+
+    if (!deftask ("rfits")) {
+	print ("Task rfits not loaded. Load dataio and then try again.")
+	bye
+    }
+
+    # Get the tape name and the output file name.
+    tape = gettape
+    outfile = getout
+
+    # Get the starting and ending file numbers for the log.
+    sfnum = getsfnum
+    efnum = getefnum
+
+    # Get the append flag.
+    append = getapp
+
+    # Get the mag flag.
+    mag = getmag
+
+    if (!append) {
+	if (mag) {
+            print ("File      fname     date    time     L-zero   zcm      meanafld   numpix", >> outfile)
+	} else {
+            print ("File      fname     date    time     L-zero   meanfld  numpix", >> outfile)
+	}
+    }
+
+    filenum = sfnum
+    while (YES) {
+	
+	# Read the next fits header from the tape.
+        header = mktemp("temp")
+	fp = header
+	rfits (tape, filenum, make_image=no, long_header=yes, > header)
+
+	# Initialize the output variables.
+	tfile = "        "
+	irafname = "       "
+	obsdate = "        "
+	lzero = "            "
+	zcm = "     "
+	meanafld = "     "
+	numpix = "       "
+	hours = 0
+	minutes = 0
+	seconds = 0
+
+	# Now match keywords against this header to obtain needed output.
+tfile = filenum
+	while (fscan (fp, headline) != EOF) {
+	    keyword = substr(headline, 1, 8)
+	    if (keyword == "File: mt")
+		tfile = substr(headline, 7, 15)
+	    else if (keyword == "IRAFNAME")
+		irafname = substr(headline, 12, 18)
+	    else if (keyword == "OBS_DATE")
+		obsdate = substr(headline, 23, 30)
+	    else if (keyword == "OBS_TIME") {
+		ssm = int(substr(headline, 23, 30)) # Seconds Since Midnight.
+		hours = ssm/3600
+		minutes = (ssm - (hours*3600))/60
+		seconds = ssm - hours*3600 - minutes*60
+	    }
+	    else if (keyword == "L_ZERO  ")
+		lzero = substr(headline, 19, 26)
+	    else if (keyword == "ZCM     ")
+		zcm = substr(headline, 18, 26)
+	    else if (keyword == "MEANAFLD")
+		meanafld = substr(headline, 18, 26)
+	    else if (keyword == "MEAN_FLD")
+		meanfld = substr(headline, 18, 26)
+	    else if (keyword == "NUMPIX  ")
+		numpix = substr(headline, 19, 30)
+	    else if (keyword == "End of d") {
+		print (headline, >> outfile)
+		delete (header, verify-)
+		bye
+	    }
+	}
+	if (mag) {
+	    print (tfile, irafname, obsdate, "  ", hours, minutes, seconds,
+	        lzero, zcm, meanafld, numpix, >> outfile)
+	} else {
+	    print (tfile, irafname, obsdate, "  ", hours, minutes, seconds,
+	        lzero, meanfld, numpix, >> outfile)
+	}
+	filenum = filenum + 1
+        delete (header, verify-)
+	if (filenum > efnum)
+	    bye
+    }
+}
diff --git a/noao/imred/vtel/fitslogr.par b/noao/imred/vtel/fitslogr.par
new file mode 100644
index 00000000..f6d8c141
--- /dev/null
+++ b/noao/imred/vtel/fitslogr.par
@@ -0,0 +1,6 @@
+gettape,s,a,,,,Tape to read fits headers from (i.e. "mta")
+getout,s,a,,,,File to put output information in
+getsfnum,i,a,,,,File number on tape from which to start logging 
+getefnum,i,a,,,,File number on tape at which logging is to end
+getapp,b,a,,,,Append to existing file?
+getmag,b,a,,,,Is this data magnetic field? (yes = 8688  no = 10830)
diff --git a/noao/imred/vtel/gauss.x b/noao/imred/vtel/gauss.x
new file mode 100644
index 00000000..fc5f9211
--- /dev/null
+++ b/noao/imred/vtel/gauss.x
@@ -0,0 +1,16 @@
+procedure gauss (x, a, ymod, dyda, ma)
+
+real	x, a[ma], ymod, dyda[ma]
+int	ma
+
+real	arg, ex, fac
+
+begin
+	arg = (x - a(2))/a(3)
+	ex = exp(-arg**2)
+	fac = a(1)*ex*2.0*arg
+	ymod = a(1)*ex
+	dyda(1) = ex
+	dyda(2) = fac/a(3)
+	dyda(3) = fac*arg/a(3)
+end
diff --git a/noao/imred/vtel/getsqib.par b/noao/imred/vtel/getsqib.par
new file mode 100644
index 00000000..a148cafb
--- /dev/null
+++ b/noao/imred/vtel/getsqib.par
@@ -0,0 +1,2 @@
+image,s,q,,,,Image to get sqibimage from
+sqibimage,s,q,,,,New image to contain squibby brightness image
diff --git a/noao/imred/vtel/getsqib.x b/noao/imred/vtel/getsqib.x
new file mode 100644
index 00000000..76e7e44d
--- /dev/null
+++ b/noao/imred/vtel/getsqib.x
@@ -0,0 +1,55 @@
+include <mach.h>
+include <imhdr.h>
+include "vt.h"
+
+# GETSQIB -- Make a new image from a solar synoptic image containing just
+# the squibby brightness.
+
+procedure t_getsqib()
+
+char	image[SZ_FNAME]		# input image
+char	sqibimage[SZ_FNAME]	# output squibby brightness image
+
+int	i, numpix
+pointer	im, lgp, lpp, sqibim
+
+pointer	immap(), imgl2s(), impl2s()
+errchk	immap, imgl2s, impl2s
+
+begin
+	# Get parameters from the CL.
+	call clgstr ("image", image, SZ_FNAME)
+	call clgstr ("sqibimage", sqibimage, SZ_FNAME)
+
+	# Open image.
+	im = immap (image, READ_ONLY, 0)
+	sqibim = immap (sqibimage, NEW_COPY, im)
+
+	numpix = IM_LEN(im,1)
+	do i = 1, IM_LEN(im,2) {
+	    lgp = imgl2s (im, i)
+	    lpp = impl2s (sqibim, i)
+	    call sqibline (Mems[lgp], Mems[lpp], numpix)
+	}
+
+	# Unmap images.
+	call imunmap (im)
+	call imunmap (sqibim)
+end
+
+
+# SQIBLINE -- Unpack squibby brightness from line1 and put it into line2.
+
+procedure sqibline (line1, line2, numpix)
+
+short	line1[numpix]	# input image line
+short	line2[numpix]	# output image line
+int	numpix		# number of pixels in line
+
+int	i
+int	and()
+
+begin
+	do i = 1, numpix
+	    line2[i] = and(int(line1[i]),17B)
+end
diff --git a/noao/imred/vtel/gryscl.inc b/noao/imred/vtel/gryscl.inc
new file mode 100644
index 00000000..7198557a
--- /dev/null
+++ b/noao/imred/vtel/gryscl.inc
@@ -0,0 +1,52 @@
+data	(ztbl[i], i=1,10)  / 003, 003, 003, 003, 003, 003, 003, 003, 004, 005 /
+data	(ztbl[i], i=11,20) / 005, 005, 005, 005, 005, 005, 005, 005, 006, 006 /
+data	(ztbl[i], i=21,30) / 006, 006, 006, 006, 006, 006, 006, 006, 006, 007 /
+data	(ztbl[i], i=31,40) / 007, 007, 007, 007, 007, 007, 007, 007, 007, 008 /
+data	(ztbl[i], i=41,50) / 008, 008, 008, 008, 008, 008, 008, 008, 008, 009 /
+data	(ztbl[i], i=51,60) / 009, 009, 009, 009, 009, 009, 009, 009, 009, 010 /
+data	(ztbl[i], i=61,70) / 010, 010, 010, 010, 010, 010, 010, 010, 010, 010 /
+data	(ztbl[i], i=71,80) / 010, 011, 011, 011, 011, 011, 011, 011, 011, 012 /
+data	(ztbl[i], i=81,90) / 012, 012, 012, 012, 012, 012, 012, 013, 013, 013 /
+data	(ztbl[i], i=91,100) / 013, 013, 013, 014, 014, 014, 014, 014, 014, 015/
+data	(ztbl[i], i=101,110) /015, 015, 015, 015, 015, 015, 016, 016, 016, 016/
+data	(ztbl[i], i=111,120) /016, 016, 017, 017, 017, 017, 017, 017, 017, 018/
+data	(ztbl[i], i=121,130) /018, 018, 018, 018, 018, 018, 019, 019, 019, 019/
+data	(ztbl[i], i=131,140) /019, 019, 020, 020, 020, 020, 020, 020, 021, 021/
+data	(ztbl[i], i=141,150) /021, 021, 021, 021, 021, 022, 022, 022, 022, 022/
+data	(ztbl[i], i=151,160) /022, 022, 023, 023, 023, 023, 023, 023, 024, 024/
+data	(ztbl[i], i=161,170) /024, 024, 024, 024, 025, 025, 025, 025, 025, 026/
+data	(ztbl[i], i=171,180) /026, 026, 026, 026, 026, 027, 027, 027, 027, 027/
+data	(ztbl[i], i=181,190) /027, 028, 028, 028, 028, 028, 028, 029, 029, 029/
+data	(ztbl[i], i=191,200) /029, 029, 029, 029, 029, 030, 030, 030, 030, 030/
+data	(ztbl[i], i=201,210) /030, 030, 031, 031, 031, 031, 031, 031, 031, 031/
+data	(ztbl[i], i=211,220) /032, 032, 032, 032, 032, 032, 032, 033, 033, 033/
+data	(ztbl[i], i=221,230) /033, 033, 033, 034, 034, 034, 034, 034, 034, 035/
+data	(ztbl[i], i=231,240) /035, 035, 035, 035, 035, 036, 036, 036, 036, 036/
+data	(ztbl[i], i=241,250) /036, 037, 037, 037, 037, 037, 037, 038, 038, 038/
+data	(ztbl[i], i=251,260) /038, 038, 038, 039, 039, 039, 039, 039, 039, 040/
+data	(ztbl[i], i=261,270) /040, 040, 040, 040, 040, 041, 041, 041, 041, 041/
+data	(ztbl[i], i=271,280) /041, 042, 042, 042, 042, 042, 042, 042, 042, 043/
+data	(ztbl[i], i=281,290) /043, 043, 043, 044, 044, 044, 044, 045, 045, 045/
+data	(ztbl[i], i=291,300) /045, 046, 046, 047, 047, 048, 048, 049, 049, 050/
+data	(ztbl[i], i=301,310) /050, 051, 051, 052, 053, 054, 054, 055, 056, 057/
+data	(ztbl[i], i=311,320) /057, 057, 057, 058, 058, 059, 059, 060, 060, 060/
+data	(ztbl[i], i=321,330) /060, 061, 061, 063, 064, 065, 066, 067, 067, 068/
+data	(ztbl[i], i=331,340) /068, 069, 069, 070, 071, 072, 072, 073, 074, 075/
+data	(ztbl[i], i=341,350) /075, 076, 077, 078, 080, 082, 083, 084, 085, 086/
+data	(ztbl[i], i=351,360) /086, 086, 087, 087, 088, 089, 089, 090, 091, 093/
+data	(ztbl[i], i=361,370) /094, 095, 097, 099, 101, 102, 103, 105, 106, 108/
+data	(ztbl[i], i=371,380) /109, 111, 113, 114, 115, 118, 121, 125, 128, 130/
+data	(ztbl[i], i=381,390) /132, 135, 137, 140, 144, 148, 151, 154, 157, 162/
+data	(ztbl[i], i=391,400) /166, 172, 177, 180, 184, 192, 200, 207, 213, 219/
+data	(ztbl[i], i=401,410) /225, 231, 237, 240, 244, 246, 248, 250, 251, 252/
+data	(ztbl[i], i=411,420) /253, 253, 254, 254, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=421,430) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=431,440) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=441,450) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=451,460) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=461,470) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=471,480) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=481,490) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=491,500) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=501,510) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/
+data	(ztbl[i], i=511,512) /255, 255 /
diff --git a/noao/imred/vtel/imfglexr.x b/noao/imred/vtel/imfglexr.x
new file mode 100644
index 00000000..3c6d4649
--- /dev/null
+++ b/noao/imred/vtel/imfglexr.x
@@ -0,0 +1,76 @@
+include <mach.h>
+include <imhdr.h>
+include "vt.h"
+
+# IMFGLEXR -- IMFilt Get Line with EXtension Real.  Get a line from a
+# full disk solar image and extend the boundary appropriately for use
+# with acnvr.  All pixels outside the limb are set equal to the value
+# of the last pixel inside the limb.  The line is extended in size by
+# an amount given by 'extension' beyond the solar disk width.
+
+pointer procedure imfglexr (imptr, linenumber, el, extension)
+
+int	linenumber			# Line of input image to get
+int	extension			# Amount of boundary extension needed
+real	el[LEN_ELSTRUCT]		# limb ellipse structure
+pointer	imptr	   	 		# Input image pointer
+
+pointer	rlptr, sp, tmpptr
+real	p, n
+int	lpix1, lpix2
+int	linelength
+int	lexb, rexb, i
+short	k
+
+pointer	imgl2r()
+short	shifts()
+errchk	imgl2r
+
+begin
+	k = -4
+
+	# Calculate the left and right bounds of the extended data.
+	lexb = E_XCENTER[el] - E_XSEMIDIAMETER[el] - extension
+	rexb = E_XCENTER[el] + E_XSEMIDIAMETER[el] + extension
+
+	# Extend 10 extra pixels beyond the minimum.
+	lexb = lexb - 10
+	rexb = rexb + 10
+	linelength = IM_LEN(imptr,1)
+
+	# Make a temporary short buffer for stripping.
+	call smark (sp)
+	call salloc (tmpptr, linelength, TY_SHORT)
+
+	# Get a line in the normal way. Point the real pointer to it.
+	rlptr = imgl2r (imptr, linenumber)
+
+	# Copy the line into the short array for stripping.
+	do i = 1, linelength
+	    Mems[tmpptr+i-1] = short(Memr[rlptr+i-1])
+
+	# Strip off the squibby brightness. Put back into real array.
+	do i = 1, linelength
+	    Memr[rlptr+i-1] = real(shifts(Mems[tmpptr+i-1], k))
+
+	# If the whole line is off the limb, return NULL.
+	if (abs(linenumber - E_YCENTER[el]) >= E_YSEMIDIAMETER[el])
+	    return(NULL)
+
+	# Use ellipse parameters to determine where the limb intersections are.
+	p = (real(linenumber) - E_YCENTER[el])**2/E_YSEMIDIAMETER[el]**2
+	n = (1.0 - p) * E_XSEMIDIAMETER[el]**2
+
+	# The two limb points are:
+	lpix1 = int(-sqrt(abs(n)) + .5) + E_XCENTER[el]
+	lpix2 = int(sqrt(abs(n)) + .5) + E_XCENTER[el]
+
+	# Extend the boundary of the data  beyond the limb
+	# by duplicating the last inside_the_limb pixel.  This extension
+	# is done out to lexb on the left and rexb on the right.
+
+	call amovkr (Memr[rlptr+lpix1+1], Memr[rlptr+lexb], lpix1-1-lexb)
+	call amovkr (Memr[rlptr+lpix2-1], Memr[rlptr+lpix2+1], rexb-1-lpix2)
+	call sfree (sp)
+	return (rlptr)
+end
diff --git a/noao/imred/vtel/imfilt.x b/noao/imred/vtel/imfilt.x
new file mode 100644
index 00000000..1f25efcf
--- /dev/null
+++ b/noao/imred/vtel/imfilt.x
@@ -0,0 +1,170 @@
+include <mach.h>
+include <imhdr.h>
+include <imset.h>
+include "vt.h"
+
+# IMFILT -- Apply a spatial averageing filter to an image by convolving the
+# image with a filter kernel.  Return the resulting image in a separate
+# image file.
+
+procedure imfilt (inim, outim, kernel, kxdim, kydim, el)
+
+pointer	inim, outim		        # input and output images
+int	kxdim, kydim		        # dimensions of convolution kernel
+real	kernel[kxdim, kydim]	        # convolution kernel
+real	el[LEN_ELSTRUCT]		# limb ellipse structure
+
+int	nlines, linelength, startline
+int	linebuf, outline, i
+int	k, offset, x2semi
+int	extension, startpix, lastline
+real	p, n, lpix1, lpix2
+pointer	lines, tmpptr, outptr, inptr, sp
+
+pointer	impl2r(), imgl2r(), imfglexr()
+errchk	impl2r, imfglexr, imgl2r
+
+begin
+	# Set up the pointer array on the stack.
+	call smark (sp)
+	call salloc (lines, kydim, TY_POINTER)
+
+	# Calculate the extension.
+	extension = kxdim / 2
+	offset = E_XCENTER[el] - E_XSEMIDIAMETER[el]
+	x2semi = 2 * E_XSEMIDIAMETER[el]
+
+	# Startpix is the x-coordinate of the beginning of the 1-D array
+	# we pass to the convolution vector routine.  If wrong, return.
+
+	startpix = offset - extension
+	if (startpix <= 0) {
+	    call printf ("convolution kernel too wide for this image\n")
+	    return
+	}
+
+	# Get the dimensions of the image.
+	linelength = IM_LEN(inim, 1)
+	nlines = IM_LEN(inim, 2)
+
+	# Pointers to the input and the output images are passed to this
+	# subroutine by the user.
+	
+	# Use imseti to set up the appropriate number of input buffers.
+	call imseti (inim, IM_NBUFS, kydim+1)
+
+	# Read in the necessary number of input image lines to initially
+	# fill all but one of the input line buffers.
+	# First, skip over all lines that are off the limb.
+	# The size of the output image is defined prior to the call
+	# to this subroutine, the output image is the same size as the
+	# input image.
+
+	startline = 0
+	Memi[lines] = NULL
+
+	# Skip over empty lines.
+	while (Memi[lines] == NULL) {
+	    startline = startline + 1
+	    Memi[lines] = imfglexr (inim, startline, el, extension)
+	}
+
+	# Fill (almost) the line buffer.
+	do linebuf = 1, kydim-2
+	    Memi[lines+linebuf] = imfglexr (inim, linebuf+startline,
+		el, extension)
+
+	# Copy the first startline lines from the input image into the
+	# output image.
+	do outline = 1, startline + (kydim/2) {
+
+	    # Put next line to output image, get the corresponding line from
+	    # the input image.
+	    inptr = imgl2r (inim, outline)
+	    outptr = impl2r (outim, outline)
+
+	    # Copy the input line into the ouput line. Strip sqib.
+	    do i = 1, DIM_VTFD {
+	        Memr[outptr+i-1] = Memr[inptr+i-1]/16.
+	    }
+	}
+
+	# Do the convolution, output line by output line.
+	do outline = (kydim/2) + startline, nlines {
+
+	    # Use ellipse parameters to determine where the limb
+	    # intersections are.
+	    p = (real(outline) - E_YCENTER[el])**2/E_YSEMIDIAMETER[el]**2
+	    n = (1.0 - p) * E_XSEMIDIAMETER[el]**2
+
+	    # The two limb points are:
+	    lpix1 = int(-sqrt(abs(n)) + .5) + E_XCENTER[el]
+	    lpix2 = int(sqrt(abs(n)) + .5) + E_XCENTER[el]
+
+	    # Keep a copy of this input line around for filling outside
+	    # the limb.
+	    inptr = imgl2r (inim, outline)
+
+	    # Scroll the buffer pointer array.
+	    if (outline > ((kydim/2) + startline))
+	        do i = 0, kydim - 2
+		    Memi[lines+i] = Memi[lines+i+1]
+
+	    # Get next line from input image, if it is off the limb then we
+	    # are done.
+
+	    tmpptr = imfglexr (inim, outline+((kydim/2)+1), el, extension)
+	    if (tmpptr == NULL) {
+		lastline = outline
+		break
+	    }
+	    Memi[lines+kydim-1] = tmpptr
+
+	    # Put next line to output image.
+	    outptr = impl2r (outim, outline)
+
+	    # Zero the output line.
+	    call aclrr (Memr[outptr], DIM_VTFD)
+
+	    # Here is the actual convolution, this is a do loop over the lines
+	    # of the kernel, each call to acnvrs adds the convolution of a
+	    # kernel line with an input line to the output line.
+
+	    do k = 1, kydim
+	        call acnvr (Memr[Memi[lines+k-1]+startpix], Memr[outptr+offset],
+		    x2semi, kernel[1,k], kxdim)
+
+	    # Fill outside the limb with orig data.
+	    do i = 1, lpix1 {
+	        Memr[outptr+i-1] = Memr[inptr+i-1]/16.
+	    }
+	    do i = lpix2, DIM_VTFD {
+	        Memr[outptr+i-1] = Memr[inptr+i-1]/16.
+	    }
+
+	    # Roundoff adjustment.
+	    do i = startpix, startpix+x2semi {
+		if (Memr[outptr+i-1] < 0.0)
+		    Memr[outptr+i-1] = Memr[outptr+i-1] - .5
+		else
+		    Memr[outptr+i-1] = Memr[outptr+i-1] + .5
+	    }
+	            
+	}    # End of do loop on outline.
+
+	# Clear the rest of the image.
+	do outline = lastline, DIM_VTFD {
+
+	    # Put next line to output image, get the corresponding line from
+	    # the input image.
+	    inptr = imgl2r (inim, outline)
+	    outptr = impl2r (outim, outline)
+
+	    # Copy the input line into the ouput line. Strip sqib.
+	    do i = 1, DIM_VTFD {
+	        Memr[outptr+i-1] = Memr[inptr+i-1]/16.
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/imred/vtel/imratio.x b/noao/imred/vtel/imratio.x
new file mode 100644
index 00000000..5586d204
--- /dev/null
+++ b/noao/imred/vtel/imratio.x
@@ -0,0 +1,29 @@
+# IMRATIO -- Divide two images and return the result in a third image.
+
+procedure imratio (numerator, denominator, ratio, xdim, ydim)
+
+real	numerator[xdim, ydim]		# input numerator
+real	denominator[xdim, ydim]		# input denominator
+real	ratio[xdim, ydim]		# output ratio image
+int	xdim, ydim			# dimensions of the image
+
+int	i
+real	ezero()
+extern	ezero()
+
+begin
+	do i = 1, ydim {
+	    call arltr (denominator[1,i], xdim, 1E-10, 0.0)
+	    call advzr (numerator[1,i], denominator[1,i], ratio[1,i], xdim,
+		ezero)
+	}
+end
+
+
+real procedure ezero (input)
+
+real	input
+
+begin
+	return (0.0)
+end
diff --git a/noao/imred/vtel/lstsq.x b/noao/imred/vtel/lstsq.x
new file mode 100644
index 00000000..9091fb48
--- /dev/null
+++ b/noao/imred/vtel/lstsq.x
@@ -0,0 +1,85 @@
+include	<mach.h>
+
+# LSTSQ -- Do a least squares fit to the data contained in the zz array.
+# Algorithm is from Jack Harvey. (Yes, it's a black box...)
+
+procedure lstsq (zz, mz, fno)
+
+real	zz[mz, mz]
+int	mz
+real	fno
+
+int	n, m, m1, i, j, k, l, l1
+real	fn, pp
+
+begin
+	n = mz - 2
+	m = n + 1
+	m1 = m + 1
+	fn = n
+
+	do i = 1, m {
+	    l = i + 1
+	    do k = 1, i-1 {
+		zz[i,l] = zz[i,l] - zz[k,l]**2
+	    }
+
+	    if (i == m)
+		break
+	    if (zz[i,l] >= 0.0)
+	        zz[i,l] = zz[i,l]**.5
+	    else {
+		call eprintf ("square root of negitive number in lstsq\n")
+	        zz[i,l] = 0.0
+	    }
+	    l1 = l + 1
+
+	    do j = l1, m1 {
+		do k = 1, i-1 {
+		    zz[i,j] = zz[i,j] - zz[k,l] * zz[k,j]
+		}
+		if (zz[i,l] >= EPSILONR)
+		    zz[i,j] = zz[i,j] / zz[i,l]
+		else
+		    call eprintf ("divide by zero in lstsq\n")
+	    }
+
+	    if (zz[i,l] >= EPSILONR)
+	        zz[i,i] = 1. / zz[i,l]
+	    else
+		call eprintf ("divide by zero in lstsq\n")
+	    do j = 1, i-1 {
+		pp = 0.
+		l1 = i - 1
+		do k = j, l1 {
+		    pp = pp + zz[k,l] * zz[k,j]
+		}
+	        zz[i,j] = -zz[i,i] * pp
+	    }
+	}
+
+	if ((fno - fn) >= EPSILONR)
+	    if ((zz[m,m1] / (fno - fn)) >= 0.0)
+	        zz[m1,m1] = .6745 * (zz[m,m1] / (fno - fn))**.5
+	    else {
+		call eprintf ("square root of negitive number in lstsq\n")
+	        zz[m1,m1] = 0.0
+	    }
+	else
+	    call eprintf ("divide by zero in lstsq\n")
+
+	do i = 1, n {
+	    zz[m,i] = 0.
+	    pp = 0.
+	    do j = i, n {
+		zz[m,i] = zz[m,i] + zz[j,i] * zz[j,m1]
+		pp = pp + zz[j,i] * zz[j,i]
+	    }
+	    if (pp >= 0.0)
+	        zz[m1,i] = zz[m1,m1] * pp**.5
+	    else {
+		call eprintf ("square root of negitive number in lstsq\n")
+	        zz[m1,i] = 0.0
+	    }
+	}
+end
diff --git a/noao/imred/vtel/makehelium.cl b/noao/imred/vtel/makehelium.cl
new file mode 100644
index 00000000..5cab8696
--- /dev/null
+++ b/noao/imred/vtel/makehelium.cl
@@ -0,0 +1,51 @@
+#{ MAKEHELIUM --
+
+# getinroot,s,a,,,,Input root file name
+# getoutroot,s,a,,,,Root filename for output images
+# inroot,s,h
+# outroot,s,h
+
+{
+	inroot = getinroot
+	outroot = getoutroot
+
+	if (access(inroot//"1.imh")) {
+	    rmap (inroot//"1", outroot//"a1", outroot//"a3", outroot//"a2",
+		"H"//outroot//"a")
+	    imdelete (inroot//"1")
+	} else {
+	    print (inroot//"1 not accessable")
+	}
+
+	if (access(inroot//"2.imh")) {
+	    rmap (inroot//"2", outroot//"b1", outroot//"b3", outroot//"b2",
+		"H"//outroot//"b")
+	    imdelete (inroot//"2")
+	} else {
+	    print (inroot//"2 not accessable")
+	}
+
+	if (access(inroot//"3.imh")) {
+	    rmap (inroot//"3", outroot//"c1", outroot//"c3", outroot//"c2",
+		"H"//outroot//"c")
+	    imdelete (inroot//"3")
+	} else {
+	    print (inroot//"3 not accessable")
+	}
+
+	if (access(inroot//"4.imh")) {
+	    rmap (inroot//"4", outroot//"d1", outroot//"d3", outroot//"d2",
+		"H"//outroot//"d")
+	    imdelete (inroot//"4")
+	} else {
+	    print (inroot//"4 not accessable")
+	}
+
+	if (access(inroot//"5.imh")) {
+	    rmap (inroot//"5", outroot//"e1", outroot//"e3", outroot//"e2",
+		"H"//outroot//"e")
+	    imdelete (inroot//"5")
+	} else {
+	    print (inroot//"5 not accessable")
+	}
+}
diff --git a/noao/imred/vtel/makehelium.par b/noao/imred/vtel/makehelium.par
new file mode 100644
index 00000000..426eda03
--- /dev/null
+++ b/noao/imred/vtel/makehelium.par
@@ -0,0 +1,4 @@
+getinroot,s,a,,,,Input root file name
+getoutroot,s,a,,,,Root filename for output images
+inroot,s,h
+outroot,s,h
diff --git a/noao/imred/vtel/makeimages.cl b/noao/imred/vtel/makeimages.cl
new file mode 100644
index 00000000..1da6b832
--- /dev/null
+++ b/noao/imred/vtel/makeimages.cl
@@ -0,0 +1,66 @@
+#{ MAKEIMAGES --
+
+# getinroot,s,a,,,,Input root file name
+# getoutroot,s,a,,,,Root filename for output images
+# inroot,s,h
+# outroot,s,h
+
+{
+	inroot = getinroot
+	outroot = getoutroot
+
+	if (access("scratch$"//inroot//"001")) {
+	    readvt ("scratch$"//inroot//"001", inroot//"tmp1")
+	    quickfit (inroot//"tmp1001",verbose=yes)
+	    rmap (inroot//"tmp1001",outroot//"a1",outroot//"a3",
+		outroot//"a2","H"//outroot//"a")
+	    delete ("scratch$"//inroot//"001")
+	    imdelete (inroot//"tmp1001")
+	} else {
+	    print ("scratch$"//inroot//"001 not accessable")
+	}
+
+	if (access("scratch$"//inroot//"002")) {
+	    readvt ("scratch$"//inroot//"002", inroot//"tmp2")
+	    quickfit (inroot//"tmp2001",verbose=yes)
+	    rmap (inroot//"tmp2001",outroot//"b1",outroot//"b3",
+		outroot//"b2","H"//outroot//"b")
+	    delete ("scratch$"//inroot//"002")
+	    imdelete (inroot//"tmp2001")
+	} else {
+	    print ("scratch$"//inroot//"002 not accessable")
+	}
+
+	if (access("scratch$"//inroot//"003")) {
+	    readvt ("scratch$"//inroot//"003", inroot//"tmp3")
+	    quickfit (inroot//"tmp3001",verbose=yes)
+	    rmap (inroot//"tmp3001",outroot//"c1",outroot//"c3",
+		outroot//"c2","H"//outroot//"c")
+	    delete ("scratch$"//inroot//"003")
+	    imdelete (inroot//"tmp3001")
+	} else {
+	    print ("scratch$"//inroot//"003 not accessable")
+	}
+
+	if (access("scratch$"//inroot//"004")) {
+	    readvt ("scratch$"//inroot//"004", inroot//"tmp4")
+	    quickfit (inroot//"tmp4001",verbose=yes)
+	    rmap (inroot//"tmp4001",outroot//"d1",outroot//"d3",
+		outroot//"d2","H"//outroot//"d")
+	    delete ("scratch$"//inroot//"004")
+	    imdelete (inroot//"tmp4001")
+	} else {
+	    print ("scratch$"//inroot//"004 not accessable")
+	}
+
+	if (access("scratch$"//inroot//"005")) {
+	    readvt ("scratch$"//inroot//"005", inroot//"tmp5")
+	    quickfit (inroot//"tmp5001",verbose=yes)
+	    rmap (inroot//"tmp5001",outroot//"e1",outroot//"e3",
+		outroot//"e2","H"//outroot//"e")
+	    delete ("scratch$"//inroot//"005")
+	    imdelete (inroot//"tmp5001")
+	} else {
+	    print ("scratch$"//inroot//"005 not accessable")
+	}
+}
diff --git a/noao/imred/vtel/makeimages.par b/noao/imred/vtel/makeimages.par
new file mode 100644
index 00000000..426eda03
--- /dev/null
+++ b/noao/imred/vtel/makeimages.par
@@ -0,0 +1,4 @@
+getinroot,s,a,,,,Input root file name
+getoutroot,s,a,,,,Root filename for output images
+inroot,s,h
+outroot,s,h
diff --git a/noao/imred/vtel/merge.par b/noao/imred/vtel/merge.par
new file mode 100644
index 00000000..3a0b0768
--- /dev/null
+++ b/noao/imred/vtel/merge.par
@@ -0,0 +1,9 @@
+mergelist,s,h,"mergelist",,,List of files to merge
+outputimage,s,q,"carmap",,,Outputimage
+outweight,s,q,"carweight",,,Output image weights
+outabs,s,q,"carabs",,,Absolute value image
+outratio,s,q,"carratio",,,Ratio: outputimage over absolute value image
+longout,r,h,180.0,1.,360.,Longitude of center of this carrington rotation
+mapmonth,i,q,,1,12,Month of center of this carrington rotation
+mapday,i,q,,1,31,Day of center of this carrington rotation
+mapyear,i,q,,1,99,Year of center of this carrington rotation
diff --git a/noao/imred/vtel/merge.x b/noao/imred/vtel/merge.x
new file mode 100644
index 00000000..79aa23eb
--- /dev/null
+++ b/noao/imred/vtel/merge.x
@@ -0,0 +1,762 @@
+include <mach.h>
+include	<imhdr.h>
+include	"vt.h"
+
+# MERGE -- Put together all appropriate daily grams to produce a full
+# carrington rotation map.  This is done both for the average input images
+# and for the absolute value input images.  The output of the program is
+# 4 images, average image, absolute value image, weight image, ratio of
+# first image to second image.
+
+procedure t_merge()
+
+char	mergelist[SZ_FNAME]		# list of images to be merged
+
+int	wavelength, listfd
+char	inputimage[SZ_FNAME]
+pointer	inputim
+
+pointer	immap()
+int	imgeti(), open(), fscan()
+errchk	immap, open
+
+begin
+	# Get the image name file from the cl and open it.
+	call clgstr ("mergelist", mergelist, SZ_FNAME)
+	listfd = open (mergelist, READ_ONLY, TEXT_FILE)
+
+	# Get the wavelength from the first image in the mergelist.
+	if (fscan (listfd) != EOF) {
+	    call gargwrd (inputimage, SZ_FNAME)
+	    inputim = immap (inputimage, READ_ONLY, 0)
+	    wavelength = imgeti (inputim, "WV_LNGTH")
+	    call close (listfd)
+	} else {
+	    call error (0, "No images in 'mergelist'")
+	    call close (listfd)
+	    return
+	}
+
+	if (wavelength == 8688)
+	    call mergem (mergelist, wavelength)
+	else
+	    call mergeh (mergelist, wavelength)
+end
+
+
+# MERGEM -- MERGE Magnetograms.
+
+procedure mergem (mergelist, wavelength)
+
+char	mergelist[SZ_FNAME]		# list of images to be merged
+int	wavelength			# wavelength of images
+
+pointer	outputim, outw, outa, outr
+pointer outptr, outwptr, outaptr, outrptr
+char	outputimage[SZ_FNAME], outweight[SZ_FNAME]
+char	outabs[SZ_FNAME], outratio[SZ_FNAME]
+real	longout, weight_tbl[SZ_WTBL], bzeroave
+int	i, mapmonth, mapday, mapyear
+
+real	clgetr()
+int	clgeti()
+pointer	immap(), imps2r()
+errchk	immap, imps2r
+
+begin
+	# Get parameters from the cl.
+
+	# Output images.
+	call clgstr ("outputimage", outputimage, SZ_FNAME)
+	call clgstr ("outweight", outweight, SZ_FNAME)
+	call clgstr ("outabs", outabs, SZ_FNAME)
+	call clgstr ("outratio", outratio, SZ_FNAME)
+
+	# Longitude of center of output Carrington rotation map.
+	longout = clgetr ("longout")
+
+	# Month, day, and year of the center of the output map.
+	mapmonth = clgeti ("mapmonth")
+	mapday = clgeti ("mapday")
+	mapyear = clgeti ("mapyear")
+
+	# Open output image.
+	outputim = immap (outputimage, NEW_IMAGE, 0)
+
+	# Define some parameters for the output images.
+	IM_NDIM(outputim) = 2
+	IM_LEN(outputim, 1) = DIM_XCARMAP
+	IM_LEN(outputim, 2) = DIM_SQUAREIM
+	IM_PIXTYPE(outputim) = TY_REAL
+
+	# Open the rest of the output images.
+	outw = immap (outweight, NEW_COPY, outputim)
+	outa = immap (outabs, NEW_COPY, outputim)
+	outr = immap (outratio, NEW_COPY, outputim)
+
+	# Map the outputimages into memory.
+	outptr = imps2r (outputim, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+	outwptr = imps2r (outw, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+	outaptr = imps2r (outa, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+	outrptr = imps2r (outr, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+
+	# Create weight table.
+	do i = 1,SZ_WTBL
+	    weight_tbl[i] = (cos((real(i-91)+.5)*3.1415926/180.))**4
+
+	call mmall (mergelist, Memr[outptr], Memr[outwptr], Memr[outaptr],
+	    outputim, outw, outa, outr, wavelength, weight_tbl, longout,
+	    mapmonth, mapday, mapyear, bzeroave)
+
+	# Fill the ratio image.
+	call imratio (Memr[outptr],Memr[outaptr],Memr[outrptr],DIM_XCARMAP,
+	    DIM_SQUAREIM)
+
+	# Write some information out to the image headers.
+	call imaddr (outputim, "AV_BZERO", bzeroave)
+	call imaddi (outputim, "WV_LNGTH", wavelength)
+	call imaddr (outw, "AV_BZERO", bzeroave)
+	call imaddr (outw, "WV_LNGTH", wavelength)
+	call imaddb (outw, "WEIGHTS", TRUE)
+	call imaddr (outa, "AV_BZERO", bzeroave)
+	call imaddr (outr, "AV_BZERO", bzeroave)
+	call imaddr (outa, "WV_LNGTH", wavelength)
+	call imaddr (outr, "WV_LNGTH", wavelength)
+	call imaddb (outa, "ABS_VALU", TRUE)
+	call imaddb (outr, "POLARITY", TRUE)
+	
+	# Weight the data image and the abs image.
+	call imratio (Memr[outptr],Memr[outwptr],Memr[outptr],DIM_XCARMAP,
+	    DIM_SQUAREIM)
+	call imratio (Memr[outaptr],Memr[outwptr],Memr[outaptr],DIM_XCARMAP,
+	    DIM_SQUAREIM)
+
+	# Close images
+	call imunmap (outputim)
+	call imunmap (outw)
+	call imunmap (outa)
+	call imunmap (outr)
+end
+
+
+# MERGEH -- MERGE Helium 10830 grams.
+
+procedure mergeh (mergelist, wavelength)
+
+char	mergelist[SZ_FNAME]		# list of images to merge
+int	wavelength			# wavelength of observation
+
+pointer	outputim, outw
+pointer outptr, outwptr
+char	outputimage[SZ_FNAME], outweight[SZ_FNAME]
+real	longout, weight_tbl[SZ_WTBL], bzeroave
+int	i, mapmonth, mapday, mapyear
+
+real	clgetr()
+int	clgeti()
+pointer	immap(), imps2r()
+errchk	immap, imps2r
+
+begin
+	# Get parameters from the cl.
+
+	# Output images.
+	call clgstr ("outputimage", outputimage, SZ_FNAME)
+	call clgstr ("outweight", outweight, SZ_FNAME)
+
+	# Longitude of center of output Carrington rotation map.
+	longout = clgetr ("longout")
+
+	# Month, day, and year of the center of the output map.
+	mapmonth = clgeti ("mapmonth")
+	mapday = clgeti ("mapday")
+	mapyear = clgeti ("mapyear")
+
+	# Open output image.
+	outputim = immap (outputimage, NEW_IMAGE, 0)
+
+	# Define some parameters for the output images.
+	IM_NDIM(outputim) = 2
+	IM_LEN(outputim, 1) = DIM_XCARMAP
+	IM_LEN(outputim, 2) = DIM_SQUAREIM
+	IM_PIXTYPE(outputim) = TY_REAL
+
+	# Open the other output image.
+	outw = immap (outweight, NEW_COPY, outputim)
+
+	# Map the outputimages into memory.
+	outptr = imps2r (outputim, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+	outwptr = imps2r (outw, 1, DIM_XCARMAP, 1, DIM_SQUAREIM)
+
+	# Create weight table.
+	do i = 1,SZ_WTBL
+	    weight_tbl[i] = (cos((real(i-91)+.5)*3.1415926/180.))**4
+
+	call mhall (mergelist, Memr[outptr], Memr[outwptr], outputim,
+	    outw, wavelength, weight_tbl, longout, mapmonth,
+	    mapday, mapyear, bzeroave)
+
+	# Write some information out to the image headers.
+	call imaddr (outputim, "AV_BZERO", bzeroave)
+	call imaddi (outputim, "WV_LNGTH", wavelength)
+	call imaddr (outw, "AV_BZERO", bzeroave)
+	call imaddr (outw, "WV_LNGTH", wavelength)
+	call imaddb (outw, "WEIGHTS", TRUE)
+	
+	# Weight the data image.
+	call imratio (Memr[outptr],Memr[outwptr],Memr[outptr],DIM_XCARMAP,
+	    DIM_SQUAREIM)
+
+	# Close images.
+	call imunmap (outputim)
+	call imunmap (outw)
+end
+
+
+# MMALL -- Merge Magnetograms ALL.
+# Map in each input image, weight it, figure out where it goes
+# and add it to the output image.
+
+procedure mmall (mergelist, outarray, outarrayw, outarraya, outputim,
+	outw, outa, outr, wavelength, weight_tbl, longout, mapmonth, mapday,
+	mapyear, bzeroave)
+
+char	mergelist[SZ_FNAME]			# list of images to be merged
+int	wavelength				# wavelength of observations
+real	outarray[DIM_XCARMAP, DIM_SQUAREIM]	# output data array
+real	outarrayw[DIM_XCARMAP, DIM_SQUAREIM]	# output weights array
+real	outarraya[DIM_XCARMAP, DIM_SQUAREIM]	# output absolute value array
+pointer	inputim					# pointer to input image
+pointer	outputim				# pointer to output image
+pointer	outw					# pointer to weight image
+pointer	outa					# pointer to abs value image
+pointer	outr					# pointer to ratio image
+int	mapmonth, mapday, mapyear		# date of output map
+real	weight_tbl[SZ_WTBL]			# weight table
+real	longout					# longitude of map center
+real	bzeroave				# average b-zero for map
+
+char	inputimage[SZ_FNAME], inweight[SZ_FNAME], inabs[SZ_FNAME]
+pointer	inw, ina, inptr, inwptr, inaptr
+int	listfd, month, day, year, count
+real	longin, bzero, bzerosum
+int	obsdate, temp, i, j
+char	ltext[SZ_LINE]
+
+int	open(), fscan(), imgeti()
+real	imgetr()
+pointer	immap(), imgs2i(), imgs2s()
+errchk	open, immap, imgs2i, imgs2s
+
+begin
+	count = 0
+	bzerosum = 0.0
+	listfd = open (mergelist, READ_ONLY, TEXT_FILE)
+
+	# Zero the output images.
+	do i = 1, DIM_XCARMAP {
+	    do j = 1, DIM_SQUAREIM {
+		outarray[i,j] = 0.0
+		outarrayw[i,j] = 0.0
+		outarraya[i,j] = 0.0
+	    }
+	}
+
+	# Get inputimages from the mergelist until they are all used up.
+	while (fscan (listfd) != EOF) {
+	    call gargwrd (inputimage, SZ_FNAME)
+
+	    # Get absolute value image.
+	    if(fscan (listfd) != EOF)
+	        call gargwrd (inabs, SZ_FNAME)
+	    else
+	        call error (0, "wrong number of file names in mergelist")
+
+	    # Get weight image.
+	    if(fscan (listfd) != EOF)
+	        call gargwrd (inweight, SZ_FNAME)
+	    else
+	        call error (0, "wrong number of file names in mergelist")
+
+	    # Open input image, its corresponding weight map, and its
+	    # corresponding absolute value map.
+
+	    inputim = immap (inputimage, READ_ONLY, 0)
+	    inw = immap (inweight, READ_ONLY, 0)
+	    ina = immap (inabs, READ_ONLY, 0)
+
+	    bzero = imgetr (inputim, "B_ZERO")
+	    bzerosum = bzerosum + bzero
+	    longin = imgetr (inputim, "L_ZERO")
+	    obsdate = imgeti (inputim, "OBS_DATE")
+
+	    # Check to see that the date is same on the three input images.
+	    temp = imgeti (inw, "OBS_DATE")
+ 	    if (temp != obsdate) {
+		call eprintf ("ERROR: date on weight image differs from that ")
+		call eprintf ("on data image!\n")
+		break
+	    }
+
+	    temp = imgeti (ina, "OBS_DATE")
+	    if (temp != obsdate) {
+		call eprintf ("ERROR: date on abs image differs from that ")
+	        call eprintf ("on data image!\n")
+	        break
+	    }
+
+	    # Decode month, day, year.
+	    month = obsdate/10000
+	    day = obsdate/100 - 100 * (obsdate/10000)
+	    year = obsdate - 100 * (obsdate/100)
+
+	    # Pack a name for this date and longitude and then put them out
+	    # into the outputimages' headers.
+
+	    count = count + 1
+	    call sprintf (ltext, SZ_LINE, "DATE%04d")
+		call pargi (count)
+	    call imaddi (outputim, ltext, obsdate)
+	    call imaddi (outw, ltext, obsdate)
+	    call imaddi (outa, ltext, obsdate)
+	    call imaddi (outr, ltext, obsdate)
+
+	    call sprintf (ltext, SZ_LINE, "LONG%04d")
+		call pargi (count)
+	    call imaddr (outputim, ltext, longin)
+	    call imaddr (outw, ltext, longin)
+	    call imaddr (outa, ltext, longin)
+	    call imaddr (outr, ltext, longin)
+	    
+	    # Map the inputimage, the weight map, and abs_image into memory.
+	    inptr = imgs2i (inputim, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+	    inwptr = imgs2s (inw, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+	    inaptr = imgs2i (ina, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+
+	    # Weight this image and add it to the output image.
+	    call addmweight (Memi[inptr],Mems[inwptr],Memi[inaptr],outarray,
+	        outarrayw, outarraya, weight_tbl, longin, longout,
+		month, day, year, mapmonth, mapday, mapyear)
+
+	    # Close this input image.
+	    call imunmap (inputim)
+	    call imunmap (inw)
+	    call imunmap (ina)
+
+	} # end of do loop on input images
+
+	bzeroave = bzerosum/real(count)
+	call close (listfd)
+end
+
+
+# MHALL -- Merge Heliumgrams ALL.
+# Map in each input image, weight it, figure out where it goes
+# and add it to the output image.
+
+procedure mhall (mergelist, outarray, outarrayw, outputim,
+	outw, wavelength, weight_tbl, longout, mapmonth, mapday,
+	mapyear, bzeroave)
+
+char	mergelist[SZ_FNAME]			# list of images to be merged
+int	wavelength				# wavelength of observations
+real	outarray[DIM_XCARMAP, DIM_SQUAREIM]	# output data array
+real	outarrayw[DIM_XCARMAP, DIM_SQUAREIM]	# output weights array
+pointer	inputim					# pointer to input image
+pointer	outputim				# pointer to output image
+pointer	outw					# pointer to weight image
+int	mapmonth, mapday, mapyear		# date of output map
+real	weight_tbl[SZ_WTBL]			# weight table
+real	longout					# longitude of map center
+real	bzeroave				# average b-zero for map
+
+char	inputimage[SZ_FNAME], inweight[SZ_FNAME]
+pointer	inw, inptr, inwptr
+int	listfd, month, day, year, count
+real	longin, bzero, bzerosum
+int	obsdate, temp, i, j
+char	ltext[SZ_LINE]
+
+real	imgetr()
+int	open(), fscan(), imgeti()
+pointer	immap(), imgs2i(), imgs2s()
+errchk	open, immap, imgs2i, imgs2s
+
+begin
+	count = 0
+	bzerosum = 0.0
+	listfd = open (mergelist, READ_ONLY, TEXT_FILE)
+
+	# Zero the output images.
+	do i = 1, DIM_XCARMAP {
+	    do j = 1, DIM_SQUAREIM {
+		outarray[i,j] = 0.0
+		outarrayw[i,j] = 0.0
+	    }
+	}
+
+	# Get inputimages from the mergelist until they are all used up.
+	while (fscan (listfd) != EOF) {
+	    call gargwrd (inputimage, SZ_FNAME)
+
+	    # Get weight image.
+	    if (fscan (listfd) != EOF)
+	        call gargwrd (inweight, SZ_FNAME)
+	    else
+	        call error (0, "wrong number of file names in mergelist")
+
+	    # Open input image, its corresponding weight map, and its
+	    # corresponding absolute value map.
+
+	    inputim = immap (inputimage, READ_ONLY, 0)
+	    inw = immap (inweight, READ_ONLY, 0)
+
+	    bzero = imgetr (inputim, "B_ZERO")
+	    bzerosum = bzerosum + bzero
+	    longin = imgetr (inputim, "L_ZERO")
+	    obsdate = imgeti (inputim, "OBS_DATE")
+
+	    # Check to see that the date is same on the three input images.
+	    temp = imgeti (inw, "OBS_DATE")
+ 	    if (temp != obsdate) {
+		call eprintf ("ERROR: date on weight image differs from that ")
+		call eprintf ("on data image!\n")
+		break
+	    }
+
+	    # Decode month, day, year.
+	    month = obsdate/10000
+	    day = obsdate/100 - 100 * (obsdate/10000)
+	    year = obsdate - 100 * (obsdate/100)
+
+	    # Pack a name for this date and longitude and then put them out
+	    # into the outputimages' headers.
+
+	    count = count + 1
+	    call sprintf (ltext, SZ_LINE, "DATE%04d")
+		call pargi (count)
+	    call imaddi (outputim, ltext, obsdate)
+	    call imaddi (outw, ltext, obsdate)
+
+	    call sprintf (ltext, SZ_LINE, "LONG%04d")
+		call pargi (count)
+	    call imaddr (outputim, ltext, longin)
+	    call imaddr (outw, ltext, longin)
+	    
+	    # Map the inputimage, the weight map, and abs_image into memory.
+	    inptr = imgs2i (inputim, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+	    inwptr = imgs2s (inw, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+
+	    # Weight this image and add it to the output image.
+	    call addhweight (Memi[inptr], Mems[inwptr], outarray, outarrayw,
+		weight_tbl, longin, longout, month, day, year, mapmonth,
+		mapday, mapyear)
+
+	    # Close this input image.
+	    call imunmap (inputim)
+	    call imunmap (inw)
+
+	} # end of do loop on input images
+
+	bzeroave = bzerosum/real(count)
+	call close (listfd)
+end
+
+
+# ADDMWEIGHT -- Weight input image by cos(longitude - (L-L0))**4, and add
+# it to the output image in the proper place.
+
+procedure addmweight (inim, inwim, inaim, outim, outwim, outaim,
+	weight_tbl, longin, longout, month, day, year, mapmonth, mapday,
+	mapyear)
+
+int	inim[DIM_SQUAREIM, DIM_SQUAREIM]	# input image
+short	inwim[DIM_SQUAREIM, DIM_SQUAREIM]	# input image weights
+int	inaim[DIM_SQUAREIM, DIM_SQUAREIM]	# input absolute image
+real	outim[DIM_XCARMAP, DIM_SQUAREIM]	# outputimage
+real	outwim[DIM_XCARMAP, DIM_SQUAREIM]	# output image weights
+real	outaim[DIM_XCARMAP, DIM_SQUAREIM]	# output absolute image
+int	month, day, year			# date of input image
+int	mapmonth, mapday, mapyear		# date of output image
+real	weight_tbl[DIM_SQUAREIM]		# weight table
+real	longin, longout				# longitudes of images
+
+int	p1offset, p2offset, firstpix, lastpix, column, row
+int	offset, datein, dateout, temp, temp2
+int	d1900()
+
+begin
+	# Translate the two dates into julian day numbers to make comparisons
+	# simpler.
+
+	datein = d1900 (month, day, year)
+	dateout = d1900 (mapmonth, mapday, mapyear)
+
+	# Figure out the pixel offset between the first pixel of the input
+	# image and the first pixel of ther output image.
+	# Actually, there may be two pixel offsets for a particular image
+	# corresponding to the correct position of the image and the 360
+	# degree offset position.
+
+	p1offset = mod(abs(int(longin - longout + .5)), 360)    # This is one.
+	p2offset = 360 - p1offset                         # This is the other.
+
+	# Determine which side of the output image center is each of these
+	# offsets.
+
+	if (datein > dateout) {
+	    if (longout > 180) {
+	        if (((longin >= longout) && (longin <= 360))  || 
+		    (longin <= mod((longout + 180.),360.))) {
+		    if (p1offset < 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    } else {
+	        if ((longin >= longout) && (longin <= (longout + 180))) {
+		    if (p1offset <= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    }
+        } else {
+	    if (longout < 180) {
+	        if (((longin >= (180 + longout)) && (longin <= 360))  || 
+		    (longin <= longout)) {
+		    if (p1offset < 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    } else {
+	        if ((longin < longout) && (longin > (longout - 180))) {
+		    if (p1offset < 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    }
+	}
+
+        # Make sure the sign is right
+        if (datein > dateout)
+	    offset = -offset
+
+        # Check for the case that the two longitudes are equal.
+        if (longin == longout) {
+	    if (abs(datein - dateout) <= 1) {
+	        offset = 0
+	    } else {
+	        call eprintf ("input day too far from center of output map\n")
+	        return
+	    }
+        }
+	    
+        # Check for the case that the two dates are equal.
+        if (datein == dateout)
+	    offset = longin - longout
+
+        # If the offset is too large then do not use this image.
+        if (abs(offset) > 240) {
+	    call eprintf ("input day too far from center of output map\n")
+	    return
+        }
+
+        # Determine what part, if not all, of the input image will lie on the
+        # output image.
+
+        firstpix = 1
+        if (offset < -90)
+	    firstpix = abs(offset+90)
+        lastpix = DIM_SQUAREIM
+        if (offset > 90) 
+	    lastpix = 180 - (offset - 90)
+
+
+        # Do all 180 columns in the image.
+	if (offset <= 0)
+	    temp = 91
+	else
+	    temp = 90
+
+	do column = firstpix,lastpix {
+	    do row = 1, DIM_SQUAREIM {
+	        temp2 = column + temp + offset
+	        outim[temp2,row] = outim[temp2, row] +
+		    inim[column, row] * weight_tbl[column]
+	        outwim[temp2,row] = outwim[temp2, row] +
+		    inwim[column, row] * weight_tbl[column]
+	        outaim[temp2,row] = outaim[temp2, row] +
+		    inaim[column, row] * weight_tbl[column]
+	    }
+	}
+end
+
+
+# ADDHWEIGHT -- Weight input image by cos(longitude - (L-L0))**4, and add
+# it to the output image in the proper place. (For 10830 grams)
+
+procedure addhweight (inim, inwim, outim, outwim, weight_tbl, longin, longout,
+	month, day, year, mapmonth, mapday, mapyear)
+
+int	inim[DIM_SQUAREIM, DIM_SQUAREIM]	# input image
+short	inwim[DIM_SQUAREIM, DIM_SQUAREIM]	# input image weights
+real	outim[DIM_XCARMAP, DIM_SQUAREIM]	# outputimage
+real	outwim[DIM_XCARMAP, DIM_SQUAREIM]	# output image weights
+int	month, day, year			# date of input image
+int	mapmonth, mapday, mapyear		# date of output image
+real	weight_tbl[DIM_SQUAREIM]		# weight table
+real	longin, longout				# longitudes of images
+
+int	p1offset, p2offset, firstpix, lastpix, column, row
+int	offset, datein, dateout, temp, temp2
+int	d1900()
+
+begin
+	# Translate the two dates into julian day numbers to make comparisons
+	# simpler.
+
+	datein = d1900 (month, day, year)
+	dateout = d1900 (mapmonth, mapday, mapyear)
+
+	# Figure out the pixel offset between the first pixel of the input
+	# image and the first pixel of ther output image.
+	# Actually, there may be two pixel offsets for a particular image
+	# corresponding to the correct position of the image and the 360
+	# degree offset position.
+
+	p1offset = mod(abs(int(longin - longout + .5)), 360)    # this is one.
+	p2offset = 360 - p1offset                         # this is the other.
+
+	# Determine which side of the output image center is each of these
+	# offsets.
+
+	if (datein > dateout) {
+	    if (longout > 180) {
+	        if (((longin >= longout) && (longin <= 360))  || 
+		    (longin <= mod((longout + 180.),360.))) {
+		    if (p1offset < 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    } else {
+	        if ((longin >= longout) && (longin <= (longout + 180))) {
+		    if (p1offset <= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    }
+        } else {
+	    if (longout < 180) {
+	        if (((longin >= (180 + longout)) && (longin <= 360))  || 
+		    (longin <= longout)) {
+		    if (p1offset < 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    } else {
+	        if ((longin < longout) && (longin > (longout - 180))) {
+		    if (p1offset < 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+	        } else {
+		    if (p1offset >= 180)
+		        offset = p2offset
+		    else
+		        offset = p1offset
+		}
+	    }
+	}
+
+        # Make sure the sign is right.
+        if (datein > dateout)
+	    offset = -offset
+
+        # Check for the case that the two longitudes are equal.
+        if (longin == longout) {
+	    if (abs(datein - dateout) <= 1) {
+	        offset = 0
+	    } else {
+	        call eprintf ("Input day too far from center of output map.\n")
+	        return
+	    }
+        }
+	    
+        # Check for the case that the two dates are equal.
+        if (datein == dateout)
+	    offset = longin - longout
+
+        # If the offset is too large then do not use this image.
+        if (abs(offset) > 240) {
+	    call eprintf ("input day too far from center of output map\n")
+	    return
+        }
+
+        # Determine what part, if not all, of the input image will lie on the
+        # output image.
+
+        firstpix = 1
+        if (offset < -90)
+	    firstpix = abs(offset+90)
+        lastpix = DIM_SQUAREIM
+        if (offset > 90) 
+	    lastpix = 180 - (offset - 90)
+
+
+        # Do all 180 columns in the image.
+	if (offset <= 0)
+	    temp = 91
+	else
+	    temp = 90
+
+	do column = firstpix, lastpix {
+	    do row = 1, DIM_SQUAREIM {
+	        temp2 = column + temp + offset
+	        outim[temp2,row] = outim[temp2, row] +
+		    inim[column, row] * weight_tbl[column]
+	        outwim[temp2,row] = outwim[temp2, row] +
+		    inwim[column, row] * weight_tbl[column]
+	    }
+	}
+end
diff --git a/noao/imred/vtel/mkpkg b/noao/imred/vtel/mkpkg
new file mode 100644
index 00000000..3da8ea5a
--- /dev/null
+++ b/noao/imred/vtel/mkpkg
@@ -0,0 +1,59 @@
+# Make the VTEL Package
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$set	LIBS = "-lxtools"
+	$update	libpkg.a
+	$omake	x_vtel.x
+	$link	x_vtel.o libpkg.a $(LIBS)
+	;
+
+install:
+	$move	x_vtel.e noaobin$
+	;
+
+libpkg.a:
+	d1900.x	
+	decodeheader.x	"vt.h" <mach.h>
+	destreak.x	"vt.h" <imhdr.h> <imset.h> <mach.h>
+	dicoplot.x	"gryscl.inc" "dicoplot.h" "vt.h" <gset.h> <imhdr.h>\
+			<imset.h> <mach.h> <math/curfit.h>
+	dephem.x	
+	gauss.x
+	getsqib.x	"vt.h" <imhdr.h> <mach.h>
+	imfglexr.x	"vt.h" <imhdr.h> <mach.h>
+	imfilt.x	"vt.h" <imhdr.h> <imset.h> <mach.h>
+	imratio.x	
+	textim.x	 <imhdr.h> <mach.h>
+	lstsq.x	         <mach.h>
+	merge.x		"vt.h" <imhdr.h> <mach.h>
+	mrqmin.x
+	mscan.x		"vt.h" <error.h> <mach.h>
+	numeric.x	"vt.h" "numeric.h" <mach.h>
+	pimtext.x       "vt.h"
+	pixbit.x	"asciilook.inc" "pixelfont.inc"
+	putsqib.x	"vt.h" <imhdr.h> <mach.h>
+	quickfit.x	"vt.h" <imhdr.h> <mach.h>
+	readheader.x	"vt.h" <mach.h> <fset.h>
+	readss1.x	"vt.h" <imhdr.h> <mach.h> <fset.h>
+	readss2.x	"vt.h" <imhdr.h> <mach.h> <fset.h>
+	readss3.x	"vt.h" <imhdr.h> <mach.h> <fset.h>
+	readss4.x	"vt.h" <imhdr.h> <mach.h> <fset.h>
+	readsubswath.x	"vt.h" <mach.h> <fset.h>
+	readvt.x	"vt.h" <imhdr.h> <mach.h> <fset.h>
+	rmap.x		"vt.h" "numeric.h" <imhdr.h> <mach.h>
+	syndico.x	"vt.h" "trnsfrm.inc" "syndico.h" <mach.h> <imhdr.h>\
+			<imset.h> <gset.h>
+	tcopy.x		"vt.h" <error.h> <fset.h> <mach.h> <printf.h>
+	trim.x		"vt.h" <imhdr.h> <mach.h>
+	unwrap.x	<imhdr.h> <mach.h>
+	vtexamine.x	"vt.h" <error.h> <fset.h> <mach.h> <printf.h>
+	writevt.x	"vt.h" <error.h> <fset.h> <mach.h>
+	;
diff --git a/noao/imred/vtel/mrotlogr.cl b/noao/imred/vtel/mrotlogr.cl
new file mode 100644
index 00000000..1612d030
--- /dev/null
+++ b/noao/imred/vtel/mrotlogr.cl
@@ -0,0 +1,68 @@
+#{ MROTLOGR -- Read all the headers on a FITS tape and print out some
+# of the header information for each file. (for Carrington rotation maps)
+
+{
+    struct header, headline, tfile, irafname
+    struct avbzero, keyword
+    struct tape, outfile
+    struct *fp
+    int	sfnum, efnum, filenum
+    bool append
+
+    if (!deftask ("rfits")) {
+	print ("Task rfits not loaded. Load dataio and then try again.")
+	bye
+    }
+
+    # Get the tape name and the output file name.
+    tape = gettape
+    outfile = getout
+
+    # Get the starting and ending file numbers for the log.
+    sfnum = getsfnum
+    efnum = getefnum
+
+    # Get the append flag.
+    append = getapp
+
+    if (!append) {
+        print ("File      fname    avbzero", >> outfile)
+    }
+
+    filenum = sfnum
+    while (YES) {
+	
+	# Read the next fits header from the tape.
+        header = mktemp("temp")
+	fp = header
+	rfits (tape, filenum, make_image=no, long_header=yes, > header)
+
+	# Initialize the output variables.
+	tfile = "        "
+	irafname = "       "
+	avbzero = "     "
+
+	# Now match keywords against this header to obtain needed output.
+	while (fscan (fp, headline) != EOF) {
+	    keyword = substr(headline, 1, 8)
+	    if (keyword == "File: mt")
+		tfile = substr(headline, 7, 15)
+	    else if (keyword == "IRAFNAME")
+		irafname = substr(headline, 12, 20)
+	    else if (keyword == "AV_BZERO")
+		avbzero = substr(headline, 19, 27)
+	    else if (keyword == "L_ZERO  ")
+		lzero = substr(headline, 19, 26)
+	    else if (keyword == "End of d") {
+		print (headline, >> outfile)
+		delete (header, verify-)
+		bye
+	    }
+	}
+	print (tfile, irafname, avbzero, >> outfile)
+	filenum = filenum + 1
+        delete (header, verify-)
+	if (filenum > efnum)
+	    bye
+    }
+}
diff --git a/noao/imred/vtel/mrotlogr.par b/noao/imred/vtel/mrotlogr.par
new file mode 100644
index 00000000..a18b0f4b
--- /dev/null
+++ b/noao/imred/vtel/mrotlogr.par
@@ -0,0 +1,5 @@
+gettape,s,a,,,,Tape to read fits headers from (i.e. "mta")
+getout,s,a,,,,File to put output information in
+getsfnum,i,a,,,,File number on tape from which to start logging 
+getefnum,i,a,,,,File number on tape at which logging is to end
+getapp,b,a,,,,Append to existing file?
diff --git a/noao/imred/vtel/mrqmin.x b/noao/imred/vtel/mrqmin.x
new file mode 100644
index 00000000..197e7931
--- /dev/null
+++ b/noao/imred/vtel/mrqmin.x
@@ -0,0 +1,348 @@
+# MRQMIN -- Levenberg-Marquard nonlinear chi square minimization.
+# From NUMERICAL RECIPES by Press, Flannery, Teukolsky, and Vetterling, p526.
+#
+# Levenberg-Marquardt method, attempting to reduce the value of chi
+# square of a fit between a set of NDATA points X,Y with individual
+# standard deviations SIG, and a nonlinear function dependent on MA
+# coefficients A.  The array LISTA numbers the parameters A such that the
+# first MFIT elements correspond to values actually being adjusted; the
+# remaining MA-MFIT parameters are held fixed at their input value.  The
+# program returns the current best-fit values for the MA fit parameters
+# A, and chi square, CHISQ.  The arrays COVAR and ALPHA with physical
+# dimension NCA (>= MFIT) are used as working space during most
+# iterations.  Supply a subroutine FUNCS(X,A,YFIT,DYDA,MA) that evaluates
+# the fitting function YFIT, and its derivatives DYDA with respect to the
+# fitting parameters A at X.  On the first call provide an initial guess
+# for the parameters A, and set ALAMDA<0 for initialization (which then
+# sets ALAMDA=0.001).  If a step succeeds  CHISQ becomes smaller and
+# ALAMDA decreases by a factor of 10.  If a step fails ALAMDA grows by a
+# factor of 10.  You must call this routine repeatedly until convergence
+# is achieved.  Then make one final call with ALAMDA = 0, so that COVAR
+# returns the covariance matrix, and ALPHA the curvature matrix.
+#
+# This routine is cast in the IRAF SPP language but the variable names have
+# been maintained for reference to the original source.  Also the working
+# arrays ATRY, BETA, and DA are allocated dynamically to eliminate
+# limitations on the number of parameters fit.
+
+procedure mrqmin (x, y, sig, ndata, a, ma, lista, mfit, covar, alpha, nca,
+	chisq, funcs, alamda)
+
+real	x[ndata]		# X data array
+real	y[ndata]		# Y data array
+real	sig[ndata]		# Sigma array
+int	ndata			# Number of data points
+real	a[ma]			# Parameter array
+int	ma			# Number of parameters
+int	lista[ma]		# List array indexing parameters to fit
+int	mfit			# Number of parameters to fit
+real	covar[nca,nca]		# Covariance matrix
+real	alpha[nca,nca]		# Curvature matrix
+int	nca			# Matrix dimension (>= mfit)
+real	chisq			# Chi square of fit
+extern	funcs			# Function to compute derivatives
+real	alamda			# Initialization and convergence parameter
+
+int	j, k, kk, ihit
+real	ochisq
+pointer	atry, beta, da
+
+errchk	gaussj
+
+begin
+	# Initialize and check that LISTA contains a proper permutation.
+	if (alamda < 0.) {
+	    call mfree (atry, TY_REAL)
+	    call mfree (beta, TY_REAL)
+	    call mfree (da, TY_REAL)
+	    call malloc (atry, ma, TY_REAL)
+	    call malloc (beta, mfit, TY_REAL)
+	    call malloc (da, mfit, TY_REAL)
+
+	    kk = mfit + 1
+	    do j = 1, ma {
+		ihit = 0
+		do k = 1, mfit
+		    if (lista(k) == j)
+			ihit = ihit + 1
+		if (ihit == 0) {
+		    lista (kk) = j
+		    kk = kk + 1
+		} else if (ihit > 1)
+		    call error (0, "Improper permutation in LISTA")
+	    }
+	    if (kk != (ma + 1))
+		call error (0, "Improper permutation in LISTA")
+	    alamda = 0.001
+	    call mrqcof (x, y, sig, ndata, a, ma, lista, mfit, alpha,
+		Memr[beta], nca, chisq, funcs)
+	    ochisq = chisq
+	    do j = 1, ma
+		Memr[atry+j-1] = a[j]
+	}
+
+	# Alter linearized fitting matrix by augmenting diagonal elements.
+	do j = 1, mfit {
+	    do k = 1, mfit
+		covar[j,k] = alpha[j,k]
+	    covar[j,j] = alpha[j,j] * (1. + alamda)
+	    Memr[da+j-1] = Memr[beta+j-1]
+	}
+
+	# Matrix solution.
+	call gaussj (covar, mfit, nca, Memr[da], 1, 1)
+
+	# Once converged evaluate covariance matrix with ALAMDA = 0.
+	if (alamda == 0.) {
+	    call covsrt (covar, nca, ma, lista, mfit)
+	    call mfree (atry, TY_REAL)
+	    call mfree (beta, TY_REAL)
+	    call mfree (da, TY_REAL)
+	    return
+	}
+
+	# Did the trial succeed?
+	do j = 1, mfit
+	    Memr[atry+lista[j]-1] = a[lista[j]] + Memr[da+j-1]
+	call mrqcof (x, y, sig, ndata, Memr[atry], ma, lista, mfit, covar,
+	    Memr[da], nca, chisq, funcs)
+
+	# Success - accept the new solution, Failure - increase ALAMDA
+	if (chisq < ochisq) {
+	    alamda = 0.1 * alamda
+	    ochisq = chisq
+	    do j = 1, mfit {
+		do k = 1, mfit
+		    alpha[j,k] = covar[j,k]
+		Memr[beta+j-1] = Memr[da+j-1]
+		a[lista[j]] = Memr[atry+lista[j]-1]
+	    }
+	} else {
+	    alamda = 10. * alamda
+	    chisq = ochisq
+	}
+end
+
+
+# MRQCOF -- Evaluate linearized matrix coefficients.
+# From NUMERICAL RECIPES by Press, Flannery, Teukolsky, and Vetterling, p527.
+#
+# Used by MRQMIN to evaluate the linearized fitting matrix ALPHA and vector
+# BETA.
+#
+# This procedure has been recast in the IRAF/SPP language but the variable
+# names have been maintained.  Dynamic memory is used.
+
+procedure mrqcof (x, y, sig, ndata, a, ma, lista, mfit, alpha, beta, nalp,
+    chisq, funcs)
+
+real	x[ndata]		# X data array
+real	y[ndata]		# Y data array
+real	sig[ndata]		# Sigma array
+int	ndata			# Number of data points
+real	a[ma]			# Parameter array
+int	ma			# Number of parameters
+int	lista[ma]		# List array indexing parameters to fit
+int	mfit			# Number of parameters to fit
+real	alpha[nalp,nalp]	# Work matrix
+real	beta[ma]		# Work array
+int	nalp			# Matrix dimension (>= mfit)
+real	chisq			# Chi square of fit
+extern	funcs			# Function to compute derivatives
+
+int	i, j, k
+real	sig2i, ymod, dy, wt
+pointer	sp, dyda
+
+begin
+	call smark (sp)
+	call salloc (dyda, ma, TY_REAL)
+
+	do j = 1, mfit {
+	   do k = 1, j
+	       alpha[j,k] = 0.
+	    beta[j] = 0.
+	}
+
+	chisq = 0.
+	do i = 1, ndata {
+	    call funcs (x[i], a, ymod, Memr[dyda], ma)
+	    sig2i = 1. / (sig[i] * sig[i])
+	    dy = y[i] - ymod
+	    do j = 1, mfit {
+		wt = Memr[dyda+lista[j]-1] * sig2i
+		do k = 1, j
+		    alpha[j,k] = alpha[j,k] + wt * Memr[dyda+lista[k]-1]
+		beta[j] = beta[j] + dy * wt
+	    }
+	    chisq = chisq + dy * dy * sig2i
+	}
+
+	do j = 2, mfit
+	    do k = 1, j-1
+		alpha[k,j] = alpha[j,k]
+
+	call sfree (sp)
+end
+	    
+
+# GAUSSJ -- Linear equation solution by Gauss-Jordan elimination.
+# From NUMERICAL RECIPES by Press, Flannery, Teukolsky, and Vetterling, p28.
+#
+# Linear equation solution by Gauss-Jordan elimination.  A is an input matrix
+# of N by N elements, stored in an array of physical dimensions NP by
+# NP.  B is an input matrix of N by M containing the M right-hand side
+# vectors, stored in an array of physical dimensions NP by MP.  On
+# output, A is replaced by its matrix inverse, and B is replaced by the
+# corresponding set of solutionn vectors.
+#
+# This procedure has been recast in the IRAF/SPP language using dynamic
+# memory allocation and error return.  The variable names have been maintained.
+
+procedure gaussj (a, n, np, b, m, mp)
+
+real	a[np,np]		# Input matrix and returned inverse
+int	n			# Dimension of input matrix
+int	np			# Storage dimension of input matrix
+real	b[np,mp]		# Input RHS matrix and returned solution
+int	m			# Dimension of input matrix
+int	mp			# Storage dimension of input matrix
+
+int	i, j, k, l, ll, irow, icol, indxrl, indxcl
+real	big, pivinv, dum
+pointer	sp, ipiv, indxr, indxc
+
+begin
+	call smark (sp)
+	call salloc (ipiv,  n, TY_INT)
+	call salloc (indxr, n, TY_INT)
+	call salloc (indxc, n, TY_INT)
+
+	do j = 1, n
+	    Memi[ipiv+j-1] = 0
+
+	do i = 1, n {
+	    big = 0.
+	    do j = 1, n {
+		if (Memi[ipiv+j-1] != 1) {
+		    do k = 1, n {
+			if (Memi[ipiv+k-1] == 0) {
+			    if (abs (a[j,k]) >= big) {
+				big = abs (a[j,k])
+				irow = j
+				icol = k
+			    }
+			} else if (Memi[ipiv+k-1] > 1) {
+			    call sfree (sp)
+			    call error (0, "Singular matrix")
+			}
+		    }
+		}
+	    }
+
+	    Memi[ipiv+icol-1] = Memi[ipiv+icol-1] + 1
+
+	    if (irow != icol) {
+		do l = 1, n {
+		    dum = a[irow,l]
+		    a[irow,l] = a[icol,l]
+		    a[icol,l] = dum
+		}
+		do l = 1, m {
+		    dum = b[irow,l]
+		    b[irow,l] = b[icol,l]
+		    b[icol,l] = dum
+		}
+	    }
+	    Memi[indxr+i-1] = irow
+	    Memi[indxc+i-1] = icol
+	    if (a[icol,icol] == 0.) {
+		call sfree (sp)
+		call error (0, "Singular matrix")
+	    }
+	    pivinv = 1. / a[icol,icol]
+	    a[icol,icol] = 1
+	    do l = 1, n
+		a[icol,l] = a[icol,l] * pivinv
+	    do l = 1, m
+		b[icol,l] = b[icol,l] * pivinv
+	    do ll = 1, n {
+		if (ll != icol) {
+		    dum = a[ll,icol]
+		    do l = 1, n
+			a[ll,l] = a[ll,l] - a[icol,l] * dum
+		    do l = 1, m
+			b[ll,l] = b[ll,l] - b[icol,l] * dum
+		}
+	    }
+	}
+
+	do l = n, 1, -1 {
+	    indxrl = Memi[indxr+l-1]
+	    indxcl = Memi[indxr+l-1]
+	    if (indxrl != indxcl) {
+		do k = 1, n {
+		    dum = a[k,indxrl]
+		    a[k,indxrl] = a[k,indxcl]
+		    a[k,indxcl] = dum
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# COVSRT -- Sort covariance matrix.
+# From NUMERICAL RECIPES by Press, Flannery, Teukolsky, and Vetterling, p515.
+#
+# Given the covariance matrix COVAR of a fit for MFIT of MA total parameters,
+# and their ordering LISTA, repack the covariance matrix to the true order of
+# the parameters.  Elements associated with fixed parameters will be zero.
+# NCVM is the physical dimension of COVAR.
+#
+# This procedure has been recast into the IRAF/SPP language but the
+# original variable names are used.
+
+procedure covsrt (covar, ncvm, ma, lista, mfit)
+
+real	covar[ncvm,ncvm]	# Input and output array
+int	ncvm			# Physical dimension of array
+int	ma			# Number of parameters
+int	lista[mfit]		# Index of fitted parameters
+int	mfit			# Number of fitted parameters
+
+int	i, j
+real	swap
+
+begin
+	# Zero all elements below diagonal.
+	do j = 1, ma-1
+	    do i = j+1, ma
+		covar[i,j] = 0.
+
+	# Repack off-diag elements of fit into correct locations below diag.
+	do i = 1, mfit-1
+	    do j = i+1, mfit
+		if (lista[j] > lista[i])
+		    covar [lista[j],lista[i]] = covar[i,j]
+		else
+		    covar [lista[i],lista[j]] = covar[i,j]
+
+	# Temporarily store original diag elements in top row and zero diag.
+	swap = covar[1,1]
+	do j = 1, ma {
+	    covar[1,j] = covar[j,j]
+	    covar[j,j] = 0.
+	}
+	covar[lista[1],lista[1]] = swap
+
+	# Now sort elements into proper order on diagonal.
+	do j = 2, mfit
+	    covar[lista[j],lista[j]] = covar[1,j]
+
+	# Finally, fill in above diagonal by symmetry.
+	do j = 2, ma
+	    do i = 1, j-1
+		covar[i,j] = covar[j,i]
+end
diff --git a/noao/imred/vtel/mscan.par b/noao/imred/vtel/mscan.par
new file mode 100644
index 00000000..8c903220
--- /dev/null
+++ b/noao/imred/vtel/mscan.par
@@ -0,0 +1,8 @@
+input,s,a,,,,Input file descriptor
+verbose,b,h,yes,,,Print out header data 
+files,s,a,,,,List of files to be examined
+makeimage,b,h,yes,,,Make images?
+brief,b,h,y,,,short output image names
+select,b,h,y,,,make select image
+bright,b,h,y,,,make brightness image
+velocity,b,h,y,,,make velocity image
diff --git a/noao/imred/vtel/mscan.x b/noao/imred/vtel/mscan.x
new file mode 100644
index 00000000..9044b943
--- /dev/null
+++ b/noao/imred/vtel/mscan.x
@@ -0,0 +1,188 @@
+include <error.h>
+include <mach.h>
+include "vt.h"
+
+define	MAX_RANGES	100
+
+# MSCAN -- Read vacuum telescope area scans.
+
+procedure t_mscan()
+
+char	input[SZ_FNAME]		# input file template
+char	files[SZ_LINE]		# file list to process
+bool	verbose			# verbose flag
+bool	makeimage		# flag to make an image
+bool	bright			# flag to make a brightness image
+bool	velocity		# flag to make a velocity image
+bool	select			# flag to make a select image
+bool	brief			# flag to make brief file names
+
+char	tapename[SZ_FNAME]
+char	diskfile[SZ_LINE]
+int	filerange[2 * MAX_RANGES + 1]
+int	nfiles, filenumber, recsize, listin
+
+bool	clgetb()
+int	decode_ranges(), get_next_number(), mscan()
+int	fntopnb(), clgfil(), mtneedfileno()
+int	mtfile()
+errchk	mscan
+
+begin
+	# CLIO for parameters.
+	verbose = clgetb ("verbose")
+	makeimage = clgetb ("makeimage")
+	bright = clgetb ("bright")
+	velocity = clgetb ("velocity")
+	select = clgetb ("select")
+	brief = clgetb ("brief")
+
+	# If the user hasn't asked for ANY of the images, just return.
+	if (!bright && !velocity && !select)
+	    return
+
+        # Get input file(s).
+        call clgstr ("input", input, SZ_FNAME)
+        if (mtfile (input) == NO) {
+
+	    # This is not a tape file, expand as a list template.
+	    listin = fntopnb (input, 0)
+	    filenumber = 1
+
+	    while (clgfil (listin, diskfile, SZ_FNAME) != EOF) {
+		iferr (recsize =  mscan (diskfile, filenumber, brief,
+		    verbose, makeimage, select, bright, velocity)) {
+		    call eprintf ("Error reading file %s\n")
+		    	call pargstr (diskfile)
+	    	}
+	        if (recsize == EOF) {
+		    call printf ("Tape at EOT\n")
+		    break
+	        }
+		filenumber = filenumber + 1
+	    }
+	    call clpcls (listin)
+
+	} else if (mtneedfileno(input) == NO) {
+	    
+	    # This is a tape file and the user specified which file.
+	    iferr (recsize = mscan (input, 0, brief, verbose,
+	    	    makeimage, select, bright, velocity)) {
+		call eprintf ("Error reading file %s\n")
+		    call pargstr (input)
+	    }
+        } else {
+
+	    # This is a tape file or files and the user did not specify
+	    # which file.
+	    call clgstr ("files", files, SZ_LINE)
+
+            if (decode_ranges (files, filerange, MAX_RANGES, nfiles) == ERR)
+	        call error (0, "Illegal file number list.")
+
+	    if (verbose)
+	        call printf ("\n")
+
+            # Loop over files.
+	    filenumber = 0
+            while (get_next_number (filerange, filenumber) != EOF) {
+
+	        # Assemble the appropriate tape file name.
+		call mtfname (input, filenumber, tapename, SZ_FNAME)
+
+	        # Read this file.
+	        iferr {
+	            recsize = mscan (tapename, filenumber, brief,
+			verbose, makeimage, select, bright, velocity)
+	        } then {
+		    call eprintf ("Error reading file: %s\n")
+		        call pargstr (tapename)
+		    call erract (EA_WARN)
+		    next
+	        }
+	        if (recsize == EOF) {
+		    call printf ("Tape at EOT\n")
+		    break
+	        }
+
+            }  # End while.
+	}
+end
+
+
+# MSCAN -- Read in the next sector scan file from tape.  First read the file
+# header to determine what type scan it is and then call the appropriate
+# subroutime for that type of scan.
+
+int procedure mscan (input, filenumber, brief, verbose, makeimage, select, 
+		    bright, velocity)
+
+char	input[SZ_FNAME]		# input file name
+int	filenumber		# file number
+bool	brief			# brief disk file names?
+bool	verbose			# print header info?
+bool	makeimage		# make images?
+bool	select			# make select image?
+bool	bright			# make bright image?
+bool	velocity		# make velocity image?
+
+int	in
+int	lastrecsize
+int	recsize
+bool	selfbuf
+pointer	sp, hbuf, hs
+
+int	mtopen()
+int	readheader()
+define	nexit_ 10
+errchk	mtopen, close, readheader
+
+begin
+	call smark (sp)
+	call salloc (hbuf, SZ_VTHDR, TY_SHORT)
+	call salloc (hs, VT_LENHSTRUCT, TY_STRUCT)
+
+	in = mtopen (input, READ_ONLY, 0)
+
+	call printf ("File %s:  ")
+	    call pargstr (input)
+
+	lastrecsize = 0
+
+	# First, read the header file
+	selfbuf = FALSE
+	recsize = readheader (in, hbuf, selfbuf)
+	if (recsize == EOF)
+	    return (recsize)
+
+	# Decode the header and jump if '!makeimage'.
+	lastrecsize = recsize
+	call decodeheader (hbuf, hs, verbose)
+	if (verbose) {
+	    call printf ("\n")
+	    call flush (STDOUT)
+	}
+	if (!makeimage)
+	    goto nexit_
+
+	# Call the appropriate area scan reader.
+	switch (VT_HOBSTYPE(hs)) {
+	case 1:
+	    call readss1 (in, filenumber, brief, select, bright, velocity, hs)
+	case 2:
+	    call readss2 (in, filenumber, brief, select, bright, velocity, hs)
+	case 3:
+	    call readss3 (in, filenumber, brief, select, bright, velocity, hs)
+	case 4:
+	    call readss4 (in, filenumber, brief, select, bright, velocity, hs)
+	case 0:
+	    call printf ("Observation type zero encountered, image skipped.\n")
+	default:
+	    call error (0, "unknown observation type, image skipped")
+	} # End of switch case.
+
+nexit_
+	call sfree (sp)
+	call close (in)
+	return (recsize)
+end
diff --git a/noao/imred/vtel/nsolcrypt.dat b/noao/imred/vtel/nsolcrypt.dat
new file mode 100644
index 00000000..65c3b067
--- /dev/null
+++ b/noao/imred/vtel/nsolcrypt.dat
@@ -0,0 +1,555 @@
+                                                                               
+                                                                               
+    '                      
+                                                                               
+                #                                                              
+                     #     
+'                                                                              
+                                                           #                   
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+   6L      X}r   '[T     E_:                                                   
+                           
+                                                                             ' 
+  +}}#     y}}A  #v}:    v}2   TA                                              
+                           
+                                                                            P}E
+   y}=    :}}}k   T}kEEEX}r   +}y                                              
+                           
+                                                                      +EXv+ I}_
+   _}T    [}[y}6  .}}}}}}}P   6}k                                              
+                           
+                                                                   #Lr}}}k. .}v
+   T}T    y}2T}g   g}_2I}}'   E}[     #EckcI#                                  
+                           
+                                                                   A}}_E+    v}
+EE_}}.   =}r .}}.  A}n L}_    X}L    +n}}}}}r2                                 
+                           
+                                                             #2.   '}}#      _}
+}}}}}v6  _}P  [}[  #y}2r}A    g}E#  #n}r= '[}v'                                
+                           
+                                                           6c}}}n+  k}=  26  E}
+yL.#[}c #y}.  2}y'  T}n}v     v}2   A}y.    _}P                                
+                           
+                                                          E}}r[v}n  P}kXv}y  '}
+}   I}n :}r    k}T  .}}}T    +}}    _}T     :}r   L['                          
+                           
+                                                         'y}I  +}}2 .}}}v_=   r
+}=6Ly}[ _}P    :}v   g}}+ 'IAI}k    n}A     2}}  'y}.                          
+                           
+                                                         :}n   :}}2  r}P      T
+}}}}}c+ =E'          .XI  :}}}}y[A' k}A     :}v  P}g   .:                      
+                           
+                                                   Ak}k6 2}X #T}}g   [}X  :PE 6
+}v_E+                      6IXgy}}A X}[     c}_ #v}A   n}[                     
+                           
+            #                                   #In}}}}y+ + 6r}}c'.' =}v[v}}c  
+                                +:# .y}E   X}}6 E}}#  :}}.                     
+                           
+                                               =v}y[2.v}E  2y}vA T}T #y}}nL2   
+                                     E}}k[r}}T  n}}vL.k}_                      
+                           
+                                        '      A}}2   [}A  L}v+  [}P  =I2      
+                                      2g}}}n:  6}y_}}}}y.     +=               
+                           
+                                                v}I  :yr#  I}n# Ey}2           
+                                        #2'    c}T '_}c+      k}=              
+                           
+                                         +AE6   I}r:g}}}n+ +y}yv}}E            
+                                              +}}:  .}v      E}v#              
+                           
+                                 #     2k}}}}n2 #y}}}gEr}[  6c}rX2             
+                                              2y}yT6X}r     +v}I               
+                           
+     #                                +y}cEEn}y. P}}:  E}n                     
+                                               'Pv}}}}P   #Ly}v#               
+                           
+                                      g}X   #g}k +}}6 .r}_    #         '      
+                                                 #AckL   =r}}}y                
+                           
+                                     .}v#    +y}6 [}k[}}k+                     
+                                                       .c}}n6}v                
+                           
+                                     E}k      c}E .}}}nA                       
+                                                      'y}yL  }}                
+                           
+                                     E}n      c}P  [g6                         
+                                                       +L+   }}                
+                           
+                                     2}}.     v}A                              
+                                                             }}                
+                           
+                                      g}g#   I}v#                              
+                                                             }}                
+                           
+        #                             2y}k=6X}}A                               
+                                                             Ac                
+                           
+                                       6n}}}}r:                                
+                                                                               
+                           
+                                         :II6                              #   
+            :2 ''                                                              
+                           
+                                                                               
+            }k kc                                                              
+                           
+                                                                               
+            }k rk                                                              
+                           
+                                                                               
+            }n nk                                                              
+                           
+                                                                  'c2          
+            rr ky                                                              
+                           
+                                                                .A.}g          
+            }} k}                                                              
+                           
+                                                                T}6k}'         
+            }} k}                                                              
+                           
+                                                                :}_E}T         
+            y} g}                         2T#                                  
+                           
+                                                                 r}+vv#        
+            n} [}                        +vy'                                  
+                           
+                                                                 I}IT}E        
+            k} X}                        g}TE}A                                
+                           
+                                                                 'vr.}c        
+            k} X}#                      P}r6y}:                                
+                           
+      #                                                           X}:c}.       
+            ky X}+                     2}}2n}[                                 
+                           
+                                                                  2}[=}[       
+           '}} X}=                     k}PP}r#                                 
+                           
+                                                                   c}.rv#      
+   _}I    Ey}_ A}}E                   L}k2}}=                                  
+                           
+                                                                   A}LE}I      
+  +}}}X +g}yE   Ly}X#   +__+         2}}:g}X                                   
+                           
+                                                                   '}v'}v      
+  L}gy}n}}c+     .k}r2 'g}}g        #n}PL}k#                                   
+                           
+                                                                    _}=_}_EEXEE
+ELv}'6v}vE         P}}[r}cv}:      '_}n:}y2                                    
+                           
+                                                                    E}X6y}}}}}}
+}}}_  +E'           6v}}X#:}v#.:Tcv}}}6r}P                                     
+                           
+                                                                    [}L +222226
+:A=#                 +[T#  g}}}}}}}rkA_}k#                                     
+                           
+                                           #                       +yv+        
+     :ELXgkkkknkkgXLE2     '[kXXI='   }y2                                      
+                           
+                                                                   X}L         
+ +I_v}}}}}}}}}}}}}}}}}kX='            vy+                                      
+                           
+                                                                  '}v#       'E
+g}}}}}kXLA2222226AT[ky}}}y[A          P}T                                      
+                           
+                                                                  T}I      .[y}
+}}kP:#               ':Tk}}}vL'       +yy.                                     
+                           
+                                                                 :}v#    2c}}}k
+I'                       2Tv}}yP#      X}c                                     
+                           
+                                                            'cv}}}}I   'X}}}_6 
+                           #An}}vA     '}}.                                    
+                           
+                                                            A}}}}}_   =r}}[+   
+                              =r}}k.    [}X                                    
+                           
+                                           EkE              2}c'    #_}}k2     
+                               #Ey}}I   'y}PEE#                                
+                           
+                                           A}}k.            2}[    2r}yL       
+                                 +c}}_#  I}}}}[                                
+                           
+                                          =:2k}}T#         #X}g   =v}n2        
+                                   L}}g'  =EP}_                +               
+                           
+                                   #     #y}c'Iy}vE       Av}v:  E}}g#         
+             6+                     :y}r.   .}X              Iry               
+                           
+                                          :r}yI'[}}k2   6n}yT'  E}}X#          
+            P}y.                     +k}v2  E}g#           Ar}yL               
+                           
+                                           #Ly}r:6n}}T=c}}['   E}}T            
+           +y}}c                      #k}y2 +y}v=        An}vI.Pg.             
+                           
+                                             +[}}[+Ly}}}g2    6}}P             
+          #k}}}}A                      #k}r+ 6k}}['    An}vI#Iy}y.             
+                           
+                                               =v}yI.PX=     +v}X              
+          T}}}}}v'                      'r}n#  Ev}yL#Ir}yT'Pv}yT'              
+                           
+                                                #P}}r.      #k}c# .2+   #==+   
+         =}}}}}}}X           cnkA  :n}r  +r}_   'T}}}}}T'Iv}yT+                
+                           
+                                                  +g}c      P}r+ A}}}:  T}}y   
+        'y}}}}}}}}A          }}}k  T}}}   6y}E    6gyX'=n}yT'                  
+                           
+                                                    nn     :}}6  I}}}E  X}}}   
+        _}}}}}}}}}v'         }}}k  X}}}    E}y+      6k}}X'                    
+                           
+                                ##                  [}    #r}P   E}}}E  X}}}   
+       A}}}}}}}}}}}[         }}}k  X}}}+    c}k      y}[.                      
+                           
+                                                    X}.   P}k#   E}}}E  X}}y   
+      +y}}}}}}}}}}}}:        }}}k  X}}}     'y}E     }n                        
+                           
+                                                    E}2  'y}.    E}}}E  X}}v   
+      c}}}}}}}}}}}}}v#       }}}k  X}}}      L}v#   #}[                        
+                           
+                                                    E}A  [}[     E}}}E  [}}r   
+     .}}}}}}}}}}}}}}}2       r}}k  X}}}       n}L   +}X                        
+                           
+                                                    :}I 'yy.     E}}}E  X}}y   
+      _kggkgccXg_ckc[#       }}}k  X}}}       :}v'  2}T                        
+                           
+                                                    :}X T}X      E}}}E  [}}k   
+                             }}}k  X}}}        k}I  2}P                        
+                           
+                                                   :r}E#y}.      E}}}A  X}}k   
+                             y}}k  X}}y        A}v  :}E                        
+                           
+                                                 #X}yE A}_       E}}}E  [}}k   
+                             y}}_  X}}}        #v}: E}E                        
+                         ' 
+                                                 n}n.  c}A       E}}}E  c}}k   
+                             y}}[  X}}}         X}c E}X                        
+                           
+                                                 y}.  +}y#       E}}}E  k}}k   
+                             }}}X  X}}}         .}y'6}}g=                      
+                           
+                                                 I}[  =}_        =}}}=  [}}P   
+                             r}}X  T}}}          k}= =n}y#                     
+                           
+                                                  k}6 _}A         AEA    2.    
+                             2EE'  #EA2          P}[  +}y                      
+                           
+                                                  T}= v}+                      
+                                                 2}v  _}A                      
+                           
+                                                 +yv#.}y                       
+                      .#                         #}}.=}n                       
+                           
+                                                 X}E A}c                   '2:E
+IXXP'                _}}ykXXLE:2.                 r}EA}n                       
+                           
+                                                :}k  P}X          +2AEIX[ky}}}}
+}}}}X                k}}}}}}}}}}}}nkkXXTEEE22+    [}X _}E                      
+                           
+                                               #ny+  X}T   :X_kk}}}}}}}}}}}}}}}
+}}}}[                _}}}}}}}}}}}}}}}}}}}}}}}}A   I}[ .yv#                     
+                           
+                                               L}L   k}A   g}}}}}}}}}}}}}}}}}}}
+}}}}c                X}}}}}}}}}}}}}}}}}}}}}}}}X   =}k  T}I                     
+                           
+                                   :E:22::=:AEP}n#   k}6   n}}}}}}}}}}}}}}}}}}}
+}}}}k                [}}}}}}}}}}}}}}}}}}}}}}}}X   2}k  #yv+                    
+                           
+                                  .}}}}}}}}}}}}}6    k}2   }}}}}}}}}}}}}}}}}}}}
+}}}}g                g}}}}}}}}}}}}}}}}}}}}}}}}X   2}}   I}nXXXXXXXXTXXP#       
+                           
+                                  #PPITXXIILPIT6     }}#   [}}}}}}}}}}}}}}}}}}}
+}}}}k                k}}}}}}}}}}}}}}}}}}}}}}}}E    }n   #n}}}}}}}}}}}}}2       
+                           
+                                  +XXXc__ccgkkkc#    [T     .266AEIXTXXXgkkrv}}
+}}}}X                P}}rkkc[XXXIEEA:=22222''      =2      #+ 222222:E6        
+                           
+                                  A}}}}}}}}}}}}}A                             #
++22=+                                                    'kkkknkrrkk}kX        
+                           
+                                    .22+#.    'vr                              
+                                                         X}}}}y}}ny}}}g        
+                           
+                                               T}E                             
+                                                        .}g#                   
+                           
+                                               .}n    +2222222222222222.2222222
+222222222222222222:6:EEEEEEEEEEEEEEEEEEEEEEEELLLTXX2    n}6                    
+                           
+                                                [}6   y}}}}}}}}}}}}}}}}}}}}}}}}
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}r   I}_                     
+                           
+                                                .}c  A}}}}}}}}}}}}}}}}}}}}}}}}}
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}' +yr+                     
+                           
+                                                 rv  E}}}}}}}}}}}}}}}}}}}}}}}}}
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}2 _}I                      
+                           
+                                                +}r  6}}}}}}}}}}}}}}}}}}}}}}}}}
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}y 6}k                       
+                           
+                          #                     P}I   v}}}}}}}}}}}}}}}}}}}}}}}}
+}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}I T}A                       
+                           
+                                                v}+   +2222222222222222+22222..
+222.'.++2A}}}}}}r+'+'##.2+'#. 2'.'+#''' ++'2222222'  A}r#                      
+                           
+                                               .}}P2                           
+          }}}}}}k                                     _}T                      
+                           
+                                               #g}}}:                          
+          }}}}}}k                                    +g}g                      
+                           
+                                                 'T}T                          
+#         }}}}}}k      .22222222222222222222226AA+ #Py}r2                      
+                           
+                                                  2}E   6nnv}yr}nn}v}}}}}}}}}}}
+}}}k      }}}}}}k     6}}}}}}}}}}}}}}}}}}}}}}}}}}y+P}yP#                       
+                           
+                                                  6}E   k}}}}}}}}}}}}}}}}}}}}}}
+}}}}'    #}}}}}}k     E}}}}}}}}}}}}}}}}}}}}}}}}}}y#T}I                         
+                           
+                                                  E}E   L}}}}}}}}}}}}}}}}}}}}}}
+}}}}.    '}}}}}}k     P}}}}}}}}}}}}}}}}}}}}}}}}}}I E}A                         
+                           
+                                #                 E}E   #v}}}}}}}}}}}}}}}}}}}}}
+}}}}2     }}}}}}k     E}}}}}}}}}}}}}}}}}}}}}}}}}v# E}A                         
+                           
+                                                  E}6    I}}}}}}}}}}}}}}}}}}}}}
+}}}}.     }}}}}}g     E}}}}}}}}}}}}}}}}}}}}}}}}}L  =}E                         
+                           
+                                                  T}6    #n}}}}}}}}}}}}}}}}}}}}
+}}}}2    .}}}}}}g     E}}}}}}}}}}}}}}}}}}}}}}}}v#  2}L                         
+                           
+                                                 2r}2     A}}}}}}}}}}}}}}}}}}}}
+}}}}2    .}}}}}}g     E}}}}}}}}}}}}}}}}}}}}}}}}=   2}X                         
+                           
+                                               =g}}n#      g}}}}}}}}}}}}}}}}}}}
+}}}}2    '}}}}}}c     E}}}}}}}}}}}}}}}}}}}}}}}g    #}[                         
+         '                 
+                                            #In}}gA#.      +y}}}}}}}}}}}}}}}}}}
+}}}}'    #}}}}}}X     E}}}}}}}}}}}}}}}}}}}}}}y+     }y=                        
+                           
+                                          'Pv}}_:.X}}c2     A}}}}}}}}}}}}}}}}}}
+}}}}+    #}}}}}}X     E}}}}}}}}}}}}}}}}}}}}}}I      P}}_.                      
+                           
+                                        2[}}yX.=g}}}}}}X+    [}}}}}}}}}}}}}}}}}
+}}}}+    '}}}}}}X     L}}}}}}}}}}}}}}}}}}}}}g    +Tc62g}yT#                    
+                           
+                                       P}}vI+Lr}}vP''T}}yT+  #n}}}}}}}}}}}}}}}}
+}}}}.    2}}}}}}g     I}}}}}}}}}}}}}}}}}}}}n#   Ev}}}c'6v}vP                   
+                           
+                              #        =kL6Xy}}c=#    'Pv}yL  #r}}}}}}}}}}}}}}}
+}}}}.    .}}}}}}X     E}}}}}}}}}}}}}}}}}}}r+  +_}}XPy}yE'[}}g2                 
+                           
+                                        +g}}vT'         #Tyy#  +r}}}}}}}}}}}}}}
+}}}}2    .}}}}}}[     E}}}}}}}}}}}}}}}}}}y2  Ey}k.# +c}}nI2k}yX#               
+                           
+                                        T}rI#             _}2   .r}}}}}}}}}}}}}
+}}}}+    2}}}}}}X     E}}}}}}}}}}}}}}}}}v.  _}yL      :k}}_#Ay}n               
+                           
+                                        #2                X}2    .r}}}}}}}}}}}}
+}}}}'    2}}}}}}X     E}}}}}}}}}}}}}}}}r.  .}r+         Ly}vE'PT               
+                           
+                                                          X}IAA#  'g}}}}}}}}}}}
+}}}}     2}}}}}}X     E}}}}}}}}}}}}}}}g+   2}X           '_}}k'                
+                           
+                                                          X}}}}g#   T}}}}}}}}}}
+}}}}     2}}}}}}X     E}}}}}}}}}}}}}}X     +}X             2g}2                
+                           
+                                                          E}kLn}[    :v}}}}}}}}
+}}}}     2}}}}}}X     E}}}}}}}}}}}}yI  +_kkk}c               .                 
+                           
+                                                              #n}=    'X}}}}}}}
+}}}}     2}}}}}}X     L}}}}}}}}}}}c.  #v}}}}}X                                 
+                           
+                                                               2yy'     2g}}}}}
+}}}}#    2}}}}}}X     X}}}}}}}}}n= #  P}P  #                                   
+                           
+                                                                I}_       6g}}}
+}}}}     2}}}}}}X     X}}}}}}}rA     'yr#                                      
+                           
+                                                                 g}E        6_y
+}}}}     2}}}}}}X     X}}}}}nI       [}:                                       
+                           
+                                                                 .}y.         '
+Pr}k     2}}}}}}T     E}}y_=        6}k                                        
+                           
+                                                                  X}E          
+  .'     .v}}}}g+      A:#          n}6                                        
+                           
+       #                                           #             #k}:2EEEEEEPXI
+#          =EA.         =cXXXXXLXT+=}g                                         
+                           
+                                        #                        [}[2}}}}}}}}}}
+[  EXI                 .}}}}}}}}}}[6}n                                         
+                           
+                                                                A}r'k}kEEEEA=Av
+}+X}}}rI          2gvc.g}I222222=}y'v}:                                        
+                           
+                                                               +yy.X}r'       I
+}}}n:Ty}k.      ._}}v}}}k        c}IP}X                                        
+                           
+                                                              #n}I=}}:        #
+y}g#  .[}}c'  #Py}v= I}}A        =}g2}v#                                       
+                           
+                             IT                               T}_+v}I          
+.A#     +g}_ :v}}X'   :T#         r}+k}:                                       
+                           
+                           #X}}6                             E}r#g}_           
+         +}k k}v=                 P}PA}_                                       
+                           
+                          #g}}E    '                        .y}2P}r'           
+      #   }k k}6                  .}n'}y'                                      
+                           
+                         +r}y:                              n}P:}}6            
+         .}k k}2                   k}6g}E                                      
+                           
+                        6y}r.                               y_#r}P             
+         +}k g}2                   E}X=}c                           #_#        
+                           
+                       Ey}n+ +226EE#                          X}c              
+          }k k}.                   '}y#r}.                          _}X        
+                           
+                      A}}}}}}}}}}}}[                          vy.              
+          }k c}+                    _}AP}P                          A}}P       
+                           
+                      .y}}}ykkk[y}}P                          +'               
+          }k _}+                    A}g+}k                           L}}+      
+                           
+                       +2'    #g}yE E+                                         
+          }k k}             #       #v} IE                      6T    c}6#     
+                           
+                             +n}y6 'yr                     #                   
+          }n c}.                     6:                         v}X  .y}}}L    
+                           
+                            6r}n+  =}n                                         
+          }y c}#                                                :}}T6y}gc}}6   
+                           
+                           Ey}g#   [}T            #                            
+          }} k}2                                             :=  E}}}}T  r}E   
+                           
+                           g}X#   #y}v6                                        
+          }} c}.                                            6}c   E}}_  +v}:   
+                           
+                           +=     =}yyyA .P+                                   
+          ng 6T                                             '}v    L}}E+r}c    
+                           
+  '+                              [}P6r}g}}n                                   
+                                                             }}.    X}}y}X#    
+                           
+                                  y}.#_}}}[.                                   
+                                                       +#  +k}}E     X}}X      
+                           
+                                 =}vIv}}c.    :L                               
+                                                      Ayn:Py}n}X      TL       
+                           
+                                 [}}}}g6     .y}=                              
+                                                      6r}}}r:2}n               
+                           
+                                 k}}n=      #r}g                               
+                                                   .T# #X}}r2 }}'              
+                           
+                                 2gA        _}r'                               
+                                                 '[}}=   =r}}Ig}6              
+                           
+                                           L}y2    .kA                  #      
+                                               'Ty}nA     '_}}}}L              
+                           
+                                      #P' 6}}E     g}n                         
+                                              +y}vA         =v}}X              
+                           
+                                      E}r=y}_     A}}6                         
+                                               n}T           '[n2              
+                           
+                                       T}}}k#    #r}[                          
+                                        2A6'   6}y'                            
+                           
+                                        Ay}_#    P}y'   Ig}}gI                 
+                                      =r}}}yP#  k}T                            
+                           
+                                        #6y}c#  #y}T   _}}}}}}c                
+                                     A}}kEk}}_  :}}+                           
+                           
+                                          #_y+  T}n#  P}yE  .k}T   +.          
+                                    .}}6   =}}E  g}[                           
+    #                      
+                                           +2# .v}E  'v}L#   6}v#  [k.         
+                            :PXT6   L}c     X}n  2}y.                          
+                           
+                                               [}_   =}y#     k}: #}}'   6vk+  
+                          6n}}}}}I  k}E     2}}'  [}_                          
+                           
+                                               =X'   E}k      k}E 6}n   6y}}26X
+A     .2  =PXPEPP        #v}k=2L}y' k}L      }}2  'yy#                         
+                           
+                                                     E}k     #v}= I}[  :}}}y A}
+r    #y}. }}}}}}}        :}y#   y}6 T}k     2}y#   :'                          
+                           
+                                                     +}}.    L}y# X}L E}}g}k  v
+}A2' T}g  }}A222.        A}X  '[}}2 6}}I    _}c                                
+                           
+                                                      X}n.  I}}P  k}:L}}EL}T  T
+}}}}}}}6  }}+               .[}}}T   _}}T26_}y.                                
+                           
+                                                      #g}}nv}}c#  }}g}}E X}=  :
+}}TXr}n   }}.              E}}}n= '  #_}}}}}r6                                 
+                           
+                                                        Agy}kI   2}}}y=  n}.   
+v}2 n}A   }}'             'y}c2 .yy    6TXX=                                   
+                           
+                                                                 A}}y6   }}    
+X}P6}v    k}'             2}}#  A}n                                            
+                           
+                                  #                              E}y6   2}g    
+:}rg}I    r}2             'y}TAPy}I                                            
+                           
+                                                                  #'    E}X    
+ v}}y'    n}.              A}}}}}P                                             
+                           
+                        '                                               'A.  # 
+ P}}T     k}.               .LTE+                                              
+                           
+                        '                                                      
+ .kr'     [k#                                                                  
+                           
+                                                                               
+                #                                                              
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+                                                                              #
+                           
+                                                                               
+                                                                              #
+                    #      
+                                                         #                     
+                                                                               
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+                                                                               
+                           
+                                                                               
+                                           $                                   
+                           
diff --git a/noao/imred/vtel/numeric.h b/noao/imred/vtel/numeric.h
new file mode 100644
index 00000000..765fac03
--- /dev/null
+++ b/noao/imred/vtel/numeric.h
@@ -0,0 +1,12 @@
+# Structure for argument list to subroutine 'numeric'.
+
+define	VT_LENNUMSTRUCT	8		# Length of VT num structure
+
+define	VT_DLODX	Memr[P2R($1)]	# deriv longitude wrt x
+define	VT_DLATDY	Memr[P2R($1+1)]	# deriv latitude wrt y
+define	VT_LATTOP	Memr[P2R($1+2)]	# latitude of top of output pixel
+define	VT_LATBOT	Memr[P2R($1+3)]	# latitude of bottom of output pixel
+define	VT_LOLEFT	Memr[P2R($1+4)]	# longitude of left side of out pixel
+define	VT_LORITE	Memr[P2R($1+5)]	# longitude of right side of out pixel
+define	VT_LATMID	Memr[P2R($1+6)]	# latitude of middle of output pixel
+define	VT_LOMID	Memr[P2R($1+7)]	# longitude of middle of output pixel
diff --git a/noao/imred/vtel/numeric.x b/noao/imred/vtel/numeric.x
new file mode 100644
index 00000000..640778c8
--- /dev/null
+++ b/noao/imred/vtel/numeric.x
@@ -0,0 +1,177 @@
+include <mach.h>
+include "vt.h"
+include "numeric.h"
+
+# NUMERIC -- calculate some of the necessary information, including
+# the partial derivitives of latitude and longitude with respect
+# to x and y, that we need to do the projection.
+
+procedure numeric (bzero, el, outputrow, pixel, xpixcenter, ypixcenter, num)
+
+real	bzero				# latitude of subearth point
+real	el[LEN_ELSTRUCT]		# ellipse parameters data structure
+int	outputrow			# which output row are we working on
+int	pixel				# which pixel in that output row
+real	xpixcenter, ypixcenter		# coordinates of center of pixel
+pointer	num				# numeric structure pointer
+
+real	dlatdy, dlongdx			# partial derivitives
+real	lat_top, lat_bot		# latitude of top and bottom of pix
+real	long_left, long_rite		# longitude of left and right of pix
+real	lat_mid, long_mid		# latitude and longitude of middle
+real	lat1, long1, lat3, long3, lat4, long4, lat5, long5
+real	x1, y1, x3, y3, x4, y4, x5, y5
+bool	skip
+
+begin
+	skip = false
+
+	# First calculate lats, longs for this pixel.
+	lat_top   = 180./3.1415926*asin(real(outputrow - 90)/90.)
+	lat_bot   = 180./3.1415926*asin(real(outputrow - 91)/90.)
+	long_left = real(pixel - 1) - 90.
+	long_rite = real(pixel) - 90.
+	lat_mid   = .5 * (lat_top + lat_bot)
+	long_mid  = .5 * (long_left + long_rite)
+
+	# Check the proximity of this pixel to the image boundary, if its
+	# too close, set that output pixel to zero.
+
+	if (abs(abs(lat_mid) - 90.0) < abs(bzero)) {
+	    if (abs(abs(lat_top) - 90.0) >= abs(bzero)) {
+		lat_bot = -90.0 + bzero
+		lat_mid = .5 * (lat_top + lat_bot)
+	    } else {
+		if (abs(abs(lat_bot) - 90.0) >= abs(bzero)) {
+		    lat_top = 90.0 + bzero
+		    lat_mid = .5 * (lat_top + lat_bot)
+		} else {
+	    	    # Nothing to map!
+		    # Flag to pixelmap marking zero pixel.
+		    VT_LATTOP(num) = 10000.
+	    	    return
+		}
+	    }
+	} else {
+	    if (abs(abs(lat_top) - 90.0) < abs(bzero))
+		lat_top = 90.0 + bzero
+	    else
+		if (abs(abs(lat_bot) - 90.0) < abs(bzero))
+		    lat_bot = -90.0 + bzero
+	}
+
+	# Now that we have the pixel we want defined, calculate the partial
+	# derivitives we need numerically.  First calculate the latitude and
+	# longitude of the centers of the 4 adjacent pixels.
+
+	lat1 = lat_mid
+	if (pixel == 1)
+	    long1 = long_mid
+	else
+	    long1 = long_mid - 1.0
+
+	lat3 = lat_mid
+	if (pixel == 180)
+	    long3 = long_mid
+	else
+	    long3 = long_mid + 1.0
+
+	long5 = long_mid
+	if (outputrow == 1)
+	    lat5 = lat_mid
+	else
+	    lat5 = 180./3.1415926*((asin(real(outputrow - 92)/90.) +
+		    asin(real(outputrow - 91)/90.))/2.)
+
+	long4 = long_mid
+	if (outputrow == 180)
+	    lat4 = lat_mid
+	else
+	    lat4 = 180./3.1415926*((asin(real(outputrow - 89)/90.) +
+	            asin(real(outputrow - 90)/90.))/2.)
+
+	# Given these latitudes and longitudes, find out where in xy coords
+	# they are. Get xpixcenter and ypixcenter then the x#s and y#s.
+
+	call getxy (lat_mid, long_mid, bzero, el, xpixcenter, ypixcenter, skip)
+	if (skip) {
+
+	    # Off the limb or behind the sun.
+	    # Flag to pixelmap marking zero pixel.
+	    VT_LATTOP(num) = 10000.
+	    return
+	}
+
+	call getxy (lat1, long1, bzero, el, x1, y1, skip)
+	call getxy (lat3, long3, bzero, el, x3, y3, skip)
+	call getxy (lat4, long4, bzero, el, x4, y4, skip)
+	call getxy (lat5, long5, bzero, el, x5, y5, skip)
+
+	# Calculate the partials.
+	if (x3 == x1)
+	    dlongdx = 9999.
+	else
+	    dlongdx = (long3 - long1) / (x3 - x1)
+
+	if (y4 == y5)
+	    dlatdy = 9999.
+	else
+	    dlatdy = (lat4 - lat5) / (y4 - y5)
+
+	VT_DLODX(num) = dlongdx 
+	VT_DLATDY(num) = dlatdy 
+	VT_LATTOP(num) = lat_top 
+	VT_LATBOT(num) = lat_bot 
+	VT_LOLEFT(num) = long_left 
+	VT_LORITE(num) = long_rite 
+	VT_LATMID(num) = lat_mid 
+	VT_LOMID(num) = long_mid 
+end
+
+
+# GETXY -- Given the latitude and longitude of a point and the image
+# parameters, return the x and y position of that point.
+
+procedure getxy (lat, lml0, b0, el, x, y, skip)
+
+real	lat			# latitude of point on image
+real	lml0			# distance in longitude from disk center
+real	b0			# latitude of sub earth point
+real	el[LEN_ELSTRUCT]	# ellipse parameters data structure
+real	x, y			# returned position
+bool	skip			# skip flag
+
+real	sinlat, coslat, sinbzero, cosbzero, sinlminusl0, coslminusl0
+real	cosrho, sinrho, sinpminustheta, cospminustheta 
+real	latitude, lminusl0, bzero
+
+begin
+	skip = false
+	lminusl0 = lml0*3.1415926/180.
+	bzero = b0*3.1415926/180.
+	latitude = lat*3.1415926/180.
+	sinlat = sin(latitude)
+	coslat = cos(latitude)
+	sinbzero = sin(bzero)
+	cosbzero = cos(bzero)
+	sinlminusl0 = sin(lminusl0)
+	coslminusl0 = cos(lminusl0)
+	cosrho = sinbzero * sinlat + cosbzero * coslat * coslminusl0
+
+	# If we are behind limb return skip = true.
+	if (cosrho <= 0.00) skip = true
+	sinrho = (1. - cosrho**2)**.5
+	if (sinrho >= EPSILONR) {
+	    sinpminustheta = (coslat/sinrho) * sinlminusl0
+	    cospminustheta = (coslat/sinrho) * (cosbzero * tan(latitude) -
+	        sinbzero * coslminusl0)
+	} else {
+	    sinpminustheta = 0.000001
+	    cospminustheta = 0.000001
+	}
+
+	x = E_XSEMIDIAMETER(el) * sinrho * sinpminustheta
+	y = E_YSEMIDIAMETER(el) * sinrho * cospminustheta
+	x = x + real(E_XCENTER(el))
+	y = y + real(E_YCENTER(el))
+end
diff --git a/noao/imred/vtel/pimtext.par b/noao/imred/vtel/pimtext.par
new file mode 100644
index 00000000..fa0494d9
--- /dev/null
+++ b/noao/imred/vtel/pimtext.par
@@ -0,0 +1,13 @@
+iraf_files,s,q,,,,Images to be written
+refim,s,q,,,,Reference image to get date and time from
+ref,b,h,no,,,Find the date and time in a reference image
+x,i,h,10,,,X position of text in image
+y,i,h,10,,,Y position of text in image
+xmag,i,h,2,,,Text magnification factor in x direction
+ymag,i,h,2,,,Text magnification factor in y direction
+val,i,h,-10000,,,Value to use to write text in images
+setbgnd,b,h,yes,,,Set the pixels in the image behind the text
+bgndval,i,h,10000,,,Value to use in background of text
+date,b,h,yes,,,Write the date into the images
+time,b,h,yes,,,Write the time into the images
+text,s,q,,,,Text string to write into image
diff --git a/noao/imred/vtel/pimtext.x b/noao/imred/vtel/pimtext.x
new file mode 100644
index 00000000..b39c12be
--- /dev/null
+++ b/noao/imred/vtel/pimtext.x
@@ -0,0 +1,131 @@
+include "vt.h"
+
+# PIMTEXT -- Put a text string directly into an image using a pixel font
+# and writing over the image pixels.
+
+procedure t_pimtext()
+
+char	im[SZ_FNAME]			# image to put text in
+char	refim[SZ_FNAME]			# reference image (get date/time)
+int	x, y				# position to put text
+int	xmag, ymag			# text magnification parameters
+int	val				# value to use for text pixels
+int	bgndval				# value to use for background pixels
+bool	setbgnd				# flag, should we set the background?
+bool	ref				# flag, are we using a ref image
+
+int	obstime, obsdate, hour, minute, second
+int	list, nfiles
+int	month, day, year
+char	dt[DTSTRING]
+bool	istime, isdate, date, time
+pointer	imp, rimp
+
+bool	clgetb(), imaccf()
+int	clgeti(), imgeti()
+int	clpopni(), clplen(), clgfil()
+pointer	immap()
+errchk	immap
+
+begin
+	# Get file name template from the CL.
+	list = clpopni ("iraf_files")
+	nfiles = clplen (list)
+
+	# Get some other parameters.
+	ref = clgetb ("ref")
+	if (ref)
+	    call clgstr ("refim", refim, SZ_FNAME)
+	x = clgeti ("x")
+	y = clgeti ("y")
+	xmag = clgeti ("xmag")
+	ymag = clgeti ("ymag")
+	val = clgeti ("val")
+	setbgnd = clgetb ("setbgnd")
+	bgndval = clgeti ("bgndval")
+	date = clgetb ("date")
+	time = clgetb ("time")
+
+	while (clgfil (list, im, SZ_FNAME) != EOF) {
+	    # Open the image(s).
+	    imp = immap (im, READ_WRITE, 0)
+	    if (ref)
+	        rimp = immap (refim, READ_ONLY, 0)
+
+	    if (date || time) {
+	        # Find out if the date and time exist in the image header.
+		if (ref) {
+	            istime = imaccf (rimp, "obs_time")
+	            isdate = imaccf (rimp, "obs_date")
+		} else {
+	            istime = imaccf (imp, "obs_time")
+	            isdate = imaccf (imp, "obs_date")
+		}
+
+		# Get the date and/or time.
+		if (date && isdate && !time) {
+		    if (ref)
+			obsdate = imgeti (rimp, "obs_date")
+		    else
+	                obsdate = imgeti (imp, "obs_date")
+
+	            month = obsdate / 10000
+	            day = obsdate/100 - 100 * (obsdate/10000)
+	            year = obsdate - 100 * (obsdate/100)
+	            call sprintf (dt, DTSTRING, "%02d/%02d/%02d")
+	                call pargi (month)
+	                call pargi (day)
+	                call pargi (year)
+
+		} else if (time && istime && !date) {
+		    if (ref)
+			obstime = imgeti (rimp, "obs_time")
+		    else
+	                obstime = imgeti (imp, "obs_time")
+
+	            hour = int(obstime/3600)
+	            minute = int((obstime - hour * 3600)/60)
+	            second = obstime - hour * 3600 - minute * 60
+	            call sprintf (dt, DTSTRING, "%02d:%02d:%02d")
+	                call pargi (hour)
+	                call pargi (minute)
+	                call pargi (second)
+
+		} else if (istime && isdate && time && date) {
+		    if (ref) {
+	                obstime = imgeti (rimp, "obs_time")
+	                obsdate = imgeti (rimp, "obs_date")
+		    } else {
+	                obstime = imgeti (imp, "obs_time")
+	                obsdate = imgeti (imp, "obs_date")
+		    }
+
+	            month = obsdate/10000
+	            day = obsdate/100 - 100 * (obsdate/10000)
+	            year = obsdate - 100 * (obsdate/100)
+	            hour = int(obstime/3600)
+	            minute = int((obstime - hour * 3600)/60)
+	            second = obstime - hour * 3600 - minute * 60
+	            call sprintf (dt, DTSTRING, "%02d:%02d:%02d %02d/%02d/%02d")
+	                call pargi (hour)
+	                call pargi (minute)
+	                call pargi (second)
+	                call pargi (month)
+	                call pargi (day)
+	                call pargi (year)
+	        } else {
+	            call printf ("Warning: cannot get date and/or time.\n")
+	            call printf ("Getting text string fron the CL.\n")
+	            call clgstr ("text", dt, DTSTRING)
+	        }
+	    } else
+	        call clgstr ("text", dt, DTSTRING)
+
+	    call textim (imp, dt, x, y, xmag, ymag, val, setbgnd, bgndval)
+	    call imunmap (imp)
+	    if (ref)
+		call imunmap (rimp)
+	} # end while
+
+	call clpcls (list)
+end
diff --git a/noao/imred/vtel/pixbit.x b/noao/imred/vtel/pixbit.x
new file mode 100644
index 00000000..a6db321a
--- /dev/null
+++ b/noao/imred/vtel/pixbit.x
@@ -0,0 +1,23 @@
+# PIXBIT -- Look up which bits should be set for this character on this line.
+
+procedure pixbit (code, line, bitarray)
+
+int	code		# character we are writing
+int	line		# line of the character we are writing
+int	bitarray[5]	# bit-array to receive data
+
+int	pix, i
+short	asciilook[128]
+short	font[455]
+int	bitupk()
+include	"pixelfont.inc"
+include	"asciilook.inc"
+
+begin
+	pix = font[asciilook[code+1]+line-1]
+	bitarray[5] = bitupk (pix, 1, 1)
+	bitarray[4] = bitupk (pix, 4, 1)
+	bitarray[3] = bitupk (pix, 7, 1)
+	bitarray[2] = bitupk (pix, 10, 1)
+	bitarray[1] = bitupk (pix, 13, 1)
+end
diff --git a/noao/imred/vtel/pixelfont.inc b/noao/imred/vtel/pixelfont.inc
new file mode 100644
index 00000000..92216e6d
--- /dev/null
+++ b/noao/imred/vtel/pixelfont.inc
@@ -0,0 +1,519 @@
+data	(font[i], i=1,7)      / 00000B,
+				00000B,
+				00000B,
+				00000B,
+				00000B,
+				00000B,
+				00000B /    # (space)
+
+data	(font[i], i=8,14)     / 00100B,
+				00100B,
+				00100B,
+				00100B,
+				00100B,
+				00000B,
+				00100B /    # !
+
+data	(font[i], i=15,21)    / 01010B,
+				01010B,
+				01010B,
+				00000B,
+				00000B,
+				00000B,
+				00000B /    # "
+
+data	(font[i], i=22,28)    / 01010B,
+				01010B,
+				11111B,
+				01010B,
+				11111B,
+				01010B,
+				01010B /    # #
+
+data	(font[i], i=29,35)    / 00100B,
+				01111B,
+				10100B,
+				01110B,
+				00101B,
+				11110B,
+				00100B /    # $
+
+data	(font[i], i=36,42)    / 11000B,
+				11001B,
+				00010B,
+				00100B,
+				01000B,
+				10011B,
+				00011B /    # %
+
+data	(font[i], i=43,49)    / 01000B,
+				10100B,
+				10100B,
+				01000B,
+				10101B,
+				10010B,
+				01101B /    # &
+
+data	(font[i], i=50,56)    / 00100B,
+				00100B,
+				00100B,
+				00000B,
+				00000B,
+				00000B,
+				00000B /    # '
+
+data	(font[i], i=57,63)    / 00100B,
+				01000B,
+				10000B,
+				10000B,
+				10000B,
+				01000B,
+				00100B /    # (
+
+data	(font[i], i=64,70)    / 00100B,
+				00010B,
+				00001B,
+				00001B,
+				00001B,
+				00010B,
+				00100B /    # )
+
+data	(font[i], i=71,77)    / 00100B,
+				10101B,
+				01110B,
+				00100B,
+				01110B,
+				10101B,
+				00100B /    # *
+
+data	(font[i], i=78,84)    / 00000B,
+				00100B,
+				00100B,
+				11111B,
+				00100B,
+				00100B,
+				00000B /    # +
+
+data	(font[i], i=85,91)    / 00000B,
+				00000B,
+				00000B,
+				00000B,
+				00100B,
+				00100B,
+				01000B /    # ,
+
+data	(font[i], i=92,98)    / 00000B,
+				00000B,
+				00000B,
+				11111B,
+				00000B,
+				00000B,
+				00000B /    # -
+
+data	(font[i], i=99,105)   / 00000B,
+				00000B,
+				00000B,
+				00000B,
+				00000B,
+				00000B,
+				00100B /    # .
+
+data	(font[i], i=106,112)  / 00000B,
+				00001B,
+				00010B,
+				00100B,
+				01000B,
+				10000B,
+				00000B /    # /
+
+data	(font[i], i=113,119)  / 01110B,
+				10001B,
+				10011B,
+				10101B,
+				11001B,
+				10001B,
+				01110B /    # 0
+
+data	(font[i], i=120,126)  / 00100B,
+				01100B,
+				00100B,
+				00100B,
+				00100B,
+				00100B,
+				01110B /    # 1
+
+data	(font[i], i=127,133)  / 01110B,
+				10001B,
+				00001B,
+				00110B,
+				01000B,
+				10000B,
+				11111B /    # 2
+
+data	(font[i], i=134,140)  / 11111B,
+				00001B,
+				00010B,
+				00110B,
+				00001B,
+				10001B,
+				11111B /    # 3
+
+data	(font[i], i=141,147)  / 00010B,
+				00110B,
+				01010B,
+				11111B,
+				00010B,
+				00010B,
+				00010B /    # 4
+
+data	(font[i], i=148,154)  / 11111B,
+				10000B,
+				11110B,
+				00001B,
+				00001B,
+				10001B,
+				01110B /    # 5
+
+data	(font[i], i=155,161)  / 00111B,
+				01000B,
+				10000B,
+				11110B,
+				10001B,
+				10001B,
+				01110B /    # 6
+
+data	(font[i], i=162,168)  / 11111B,
+				00001B,
+				00010B,
+				00100B,
+				01000B,
+				01000B,
+				01000B /    # 7
+
+data	(font[i], i=169,175)  / 01110B,
+				10001B,
+				10001B,
+				01110B,
+				10001B,
+				10001B,
+				01110B /    # 8
+
+data	(font[i], i=176,182)  / 01110B,
+				10001B,
+				10001B,
+				01111B,
+				00001B,
+				00010B,
+				11100B /    # 9
+
+data	(font[i], i=183,189)  / 00000B,
+				00000B,
+				00100B,
+				00000B,
+				00100B,
+				00000B,
+				00000B /    # :
+
+data	(font[i], i=190,196)  / 00000B,
+				00000B,
+				00100B,
+				00000B,
+				00100B,
+				00100B,
+				01000B /    # ;
+
+data	(font[i], i=197,203)  / 00010B,
+				00100B,
+				01000B,
+				10000B,
+				01000B,
+				00100B,
+				00010B /    # <
+
+data	(font[i], i=204,210)  / 00000B,
+				00000B,
+				11111B,
+				00000B,
+				11111B,
+				00000B,
+				00000B /    # =
+
+data	(font[i], i=211,217)  / 01000B,
+				00100B,
+				00010B,
+				00001B,
+				00010B,
+				00100B,
+				01000B /    # >
+
+data	(font[i], i=218,224)  / 01110B,
+				10001B,
+				00010B,
+				00100B,
+				00100B,
+				00000B,
+				00100B /    # ?
+
+data	(font[i], i=225,231)  / 01110B,
+				10001B,
+				10101B,
+				10111B,
+				10110B,
+				10000B,
+				01111B /    # @
+
+data	(font[i], i=232,238)  / 00100B,
+				01010B,
+				10001B,
+				10001B,
+				11111B,
+				10001B,
+				10001B /    # A
+
+data	(font[i], i=239,245)  / 11110B,
+				10001B,
+				10001B,
+				11110B,
+				10001B,
+				10001B,
+				11110B /    # B
+
+data	(font[i], i=246,252)  / 01110B,
+				10001B,
+				10000B,
+				10000B,
+				10000B,
+				10001B,
+				01110B /    # C
+
+data	(font[i], i=253,259)  / 11110B,
+				10001B,
+				10001B,
+				10001B,
+				10001B,
+				10001B,
+				11110B /    # D
+
+data	(font[i], i=260,266)  / 11111B,
+				10000B,
+				10000B,
+				11110B,
+				10000B,
+				10000B,
+				11111B /    # E
+
+data	(font[i], i=267,273)  / 11111B,
+				10000B,
+				10000B,
+				11110B,
+				10000B,
+				10000B,
+				10000B /    # F
+
+data	(font[i], i=274,280)  / 01111B,
+				10000B,
+				10000B,
+				10000B,
+				10011B,
+				10001B,
+				01111B /    # G
+
+data	(font[i], i=281,287)  / 10001B,
+				10001B,
+				10001B,
+				11111B,
+				10001B,
+				10001B,
+				10001B /    # H
+
+data	(font[i], i=288,294)  / 01110B,
+				00100B,
+				00100B,
+				00100B,
+				00100B,
+				00100B,
+				01110B /    # I
+
+data	(font[i], i=295,301)  / 00001B,
+				00001B,
+				00001B,
+				00001B,
+				00001B,
+				10001B,
+				01110B /    # J
+
+data	(font[i], i=302,308)  / 10001B,
+				10010B,
+				10100B,
+				11000B,
+				10100B,
+				10010B,
+				10001B /    # K
+
+data	(font[i], i=309,315)  / 10000B,
+				10000B,
+				10000B,
+				10000B,
+				10000B,
+				10000B,
+				11111B /    # L
+
+data	(font[i], i=316,322)  / 10001B,
+				11011B,
+				10101B,
+				10101B,
+				10001B,
+				10001B,
+				10001B /    # M
+
+data	(font[i], i=323,329)  / 10001B,
+				10001B,
+				11001B,
+				10101B,
+				10011B,
+				10001B,
+				10001B /    # N
+
+data	(font[i], i=330,336)  / 01110B,
+				10001B,
+				10001B,
+				10001B,
+				10001B,
+				10001B,
+				01110B /    # O
+
+data	(font[i], i=337,343)  / 11110B,
+				10001B,
+				10001B,
+				11110B,
+				10000B,
+				10000B,
+				10000B /    # P
+
+data	(font[i], i=344,350)  / 01110B,
+				10001B,
+				10001B,
+				10001B,
+				10101B,
+				10010B,
+				01101B /    # Q
+
+data	(font[i], i=351,357)  / 11110B,
+				10001B,
+				10001B,
+				11110B,
+				10100B,
+				10010B,
+				10001B /    # R
+
+data	(font[i], i=358,364)  / 01110B,
+				10001B,
+				10000B,
+				01110B,
+				00001B,
+				10001B,
+				01110B /    # S
+
+data	(font[i], i=365,371)  / 11111B,
+				00100B,
+				00100B,
+				00100B,
+				00100B,
+				00100B,
+				00100B /    # T
+
+data	(font[i], i=372,378)  / 10001B,
+				10001B,
+				10001B,
+				10001B,
+				10001B,
+				10001B,
+				01110B /    # U
+
+data	(font[i], i=379,385)  / 10001B,
+				10001B,
+				10001B,
+				10001B,
+				10001B,
+				01010B,
+				00100B /    # V
+
+data	(font[i], i=386,392)  / 10001B,
+				10001B,
+				10001B,
+				10101B,
+				10101B,
+				11011B,
+				10001B /    # W
+
+data	(font[i], i=393,399)  / 10001B,
+				10001B,
+				01010B,
+				00100B,
+				01010B,
+				10001B,
+				10001B /    # X
+
+data	(font[i], i=400,406)  / 10001B,
+				10001B,
+				01010B,
+				00100B,
+				00100B,
+				00100B,
+				00100B /    # Y
+
+data	(font[i], i=407,413)  / 11111B,
+				00001B,
+				00010B,
+				00100B,
+				01000B,
+				10000B,
+				11111B /    # Z
+
+data	(font[i], i=414,420)  / 11111B,
+				11000B,
+				11000B,
+				11000B,
+				11000B,
+				11000B,
+				11111B /    # [
+
+data	(font[i], i=421,427)  / 00000B,
+				10000B,
+				01000B,
+				00100B,
+				00010B,
+				00001B,
+				00000B /    # \
+
+data	(font[i], i=428,434)  / 11111B,
+				00011B,
+				00011B,
+				00011B,
+				00011B,
+				00011B,
+				11111B /    # ]
+
+data	(font[i], i=435,441)  / 00000B,
+				00000B,
+				00100B,
+				01010B,
+				10001B,
+				00000B,
+				00000B /    # ^
+
+data	(font[i], i=442,448)  / 00000B,
+				00000B,
+				00000B,
+				00000B,
+				00000B,
+				00000B,
+				11111B /    # _
+
+data	(font[i], i=449,455)  / 11111B,
+				10001B,
+				11011B,
+				10101B,
+				11011B,
+				10001B,
+				11111B /    # (unknown)
diff --git a/noao/imred/vtel/putsqib.par b/noao/imred/vtel/putsqib.par
new file mode 100644
index 00000000..635f540f
--- /dev/null
+++ b/noao/imred/vtel/putsqib.par
@@ -0,0 +1,3 @@
+image,s,q,,,,Data image to merge with squibby brightness image
+sqibimage,s,q,,,,Squibby brightness image
+merged,s,q,,,,New image to contain the merged image
diff --git a/noao/imred/vtel/putsqib.x b/noao/imred/vtel/putsqib.x
new file mode 100644
index 00000000..9299c4d4
--- /dev/null
+++ b/noao/imred/vtel/putsqib.x
@@ -0,0 +1,69 @@
+include <mach.h>
+include <imhdr.h>
+include "vt.h"
+
+# PUTSQIB -- Murge a solar synoptic 'data only' image with a
+# squibby brightness image.  Output image is separate image.
+
+procedure t_putsqib()
+
+char	image[SZ_FNAME]		# input image
+char	sqibimage[SZ_FNAME]	# squibby brightness image
+char	merged[SZ_FNAME]	# output merged image
+
+int	i, numpix
+pointer	im, ldatagp, lsqibgp, lpp,  sqibim, mim
+pointer	immap(), imgl2s(), impl2s()
+errchk	immap, imgl2s, impl2s
+
+begin
+	# Get parameters from the CL.
+	call clgstr ("image", image, SZ_FNAME)
+	call clgstr ("sqibimage", sqibimage, SZ_FNAME)
+	call clgstr ("merged", merged, SZ_FNAME)
+
+	# Open the two input images, see that they are the same size.
+	im = immap (image, READ_ONLY, 0)
+	sqibim = immap (sqibimage, READ_ONLY, 0)
+
+	# If not, error.
+	if (IM_LEN(im,2) != IM_LEN(sqibim,2))
+	    call error(0,"sizes of data image and sqib image must match")
+
+	if (IM_LEN(im,1) != IM_LEN(sqibim,1))
+	    call error(0,"sizes of data image and sqib image must match")
+
+	# Open the new image.
+	mim = immap (merged, NEW_COPY, im)
+
+	do i = 1, IM_LEN(im,2) {
+	    ldatagp = imgl2s (im, i)
+	    lsqibgp = imgl2s (sqibim, i)
+	    lpp = impl2s (mim, i)
+	    numpix = IM_LEN(im,1)
+	    call sqibput (Mems[ldatagp], Mems[lsqibgp], Mems[lpp], numpix)
+	}
+
+	# Unmap images.
+	call imunmap (im)
+	call imunmap (sqibim)
+	call imunmap (mim)
+end
+
+
+# SQIBPUT -- pack squibby brightness from line2 into line1 and put the
+# result into line3.
+
+procedure sqibput (line1, line2, line3, numpix)
+
+short	line1[numpix]		# data line
+short	line2[numpix]		# sqib line
+short	line3[numpix]		# out line
+int	numpix			# number of pixels
+
+int	i
+
+begin
+	do i = 1, numpix
+	    line3[i] = line1[i]*16 + line2[i]
+end
diff --git a/noao/imred/vtel/quickfit.par b/noao/imred/vtel/quickfit.par
new file mode 100644
index 00000000..6ce8e742
--- /dev/null
+++ b/noao/imred/vtel/quickfit.par
@@ -0,0 +1,8 @@
+image,s,q,,,,Image file descriptor
+threshold,i,h,4,,,Squibby brightness threshold 
+verbose,b,h,no,,,Print out in verbose mode?
+xguess,i,h,1024,,,X coordinate of center of guess circle
+yguess,i,h,1024,,,Y coordinate of center of guess circle
+halfwidth,i,h,50,,,Halfwidth of limbfinding window
+rowspace,i,h,20,,,# of rows to skip near center in limbfind
+rejectcoeff,r,h,.02,,,Least squares rejection coefficient
diff --git a/noao/imred/vtel/quickfit.x b/noao/imred/vtel/quickfit.x
new file mode 100644
index 00000000..40efb257
--- /dev/null
+++ b/noao/imred/vtel/quickfit.x
@@ -0,0 +1,499 @@
+include <mach.h>
+include <imhdr.h>
+include	"vt.h"
+
+define	SZ_VTPBUF	4096		# Size of limb point buffer.
+
+# QUICKFIT -- Given a fulldisk solar image, find the parameters of an ellipse
+# that best fits the limb.  First the points on the limb are determined using
+# the squibby brightness, then an initial guess for the limb parameters is
+# made, and finally a least squares fit is made by an iterative method.
+
+procedure t_quickfit()
+
+char	image[SZ_FNAME]				# image to find the limb on
+int	threshold				# squibby limb threshold
+bool	verbose					# verbose flag
+
+pointer	pb					# buffer for saving limb points
+int	npoints, rejects			# number of limb pts, rejects
+real	x, y, a, b				# x, y, a, b (a = z0)
+real	rguess, rpercent			# initial guess at r, % rejects
+errchk	limbfind, efit
+pointer	im, sp
+
+pointer	immap()
+int	clgeti()
+bool	clgetb()
+errchk	immap, limbfind
+
+begin
+	call smark (sp)
+	call salloc (pb, 2*SZ_VTPBUF, TY_INT)
+
+	# Get parameters from the cl.
+	call clgstr ("image", image, SZ_FNAME)
+	threshold = clgeti ("threshold")
+	verbose = clgetb ("verbose")
+
+	# Open image.
+	im = immap (image, READ_WRITE, 0)
+
+	# Get the point buffer and npoints.
+	iferr (call limbfind (im, Memi[pb], npoints, threshold, rguess,
+	    verbose))
+	    call eprintf("Error getting limbpoints.\n")
+	if (verbose) {
+	    call printf ("\nrguess = %g\n")
+	        call pargr (rguess)
+	        call flush (STDOUT)
+	}
+
+	# Fit the ellipse.
+	b = rguess
+	a = rguess
+	x = real(DIM_VTFD)/2.
+	y = real(DIM_VTFD)/2.
+	iferr (call efit (Memi[pb], npoints, x, y, a, b, rejects, verbose))
+	    call eprintf ("Error fitting elipse.\n")
+
+	rpercent = real(rejects)/real(npoints)
+	if (verbose) {
+	    call printf ("\nTotal number of limbpoints found was %d\n")
+	        call pargi (npoints)
+	    call printf ("Number of limbpoints rejected was %d\n")
+	        call pargi (rejects)
+	    call printf ("Fraction of limb points rejected = %g\n")
+	        call pargr (rpercent)
+	        call flush (STDOUT)
+	}
+
+	# Put ellipse parameters in image header.
+	call imaddr (im, "E_XCEN", x)
+	call imaddr (im, "E_YCEN", y)
+	call imaddr (im, "E_XSMD", a)
+	call imaddr (im, "E_YSMD", b)
+
+	# Close the image.
+	call imunmap (im)
+
+	call sfree (sp)
+end
+
+
+# LIMBFIND - Find all of the points on the image that determine the
+# limb.  This is done line by line.
+
+procedure limbfind (imageptr, pointbuf, npoints, threshold, rguess, verbose)
+
+pointer	imageptr		# pointer to image
+int	pointbuf[SZ_VTPBUF,2]	# buffer in which to store limb points
+int	npoints			# number of points
+int	threshold		# squibby threshold
+real	rguess			# first guess at radius
+bool	verbose			# verbose flag
+
+int	rowspace, halfwidth, leftsave, rightsave, y
+int	numpix, numrow, leftx, rightx, yesno
+int	month, day, year, hour, minute, second, obsdate, obstime
+real	b0, l0
+pointer	lpg
+
+pointer	imgl2s()
+int	clgeti(), imgeti()
+errchk	ephem, flocr, florr, imgl2s
+
+begin
+	# Get date and time from the header.
+	obsdate = imgeti (imageptr, "OBS_DATE")
+	obstime = imgeti (imageptr, "OBS_TIME")
+
+	# Calculate the month/day/year.
+	month = obsdate/10000
+	day = obsdate/100 - 100 * (obsdate/10000)
+	year = obsdate - 100 * (obsdate/100)
+
+	# Calculate the hour:minute:second.
+	hour = int(obstime/3600)
+	minute = int((obstime - hour * 3600)/60)
+	second = obstime - hour * 3600 - minute * 60
+	if (verbose) {
+	    call printf("date and time of this image = %d/%d/%d, %d:%d:%d\n")
+	        call pargi(month)
+	        call pargi(day)
+	        call pargi(year)
+	        call pargi(hour)
+	        call pargi(minute)
+	        call pargi(second)
+	    call flush (STDOUT)
+	}
+
+	# Get rowspace and halfwidth from the cl.
+	halfwidth = clgeti("halfwidth")
+	rowspace = clgeti("rowspace")
+
+	numpix = IM_LEN(imageptr, 1)
+	numrow = IM_LEN(imageptr, 2)
+	npoints = 0
+
+	# Get rguess from ephem.
+	iferr (call ephem (month, day, year, hour, minute, second, rguess,
+	    b0, l0, verbose))
+	    call eprintf ("Error getting ephemeris data.\n")
+
+	# Put b0 and l0 in the image header.
+	call imaddr (imageptr, "B_ZERO", b0)
+	call imaddr (imageptr, "L_ZERO", l0)
+
+	# Get central row to start with and find its limb points.
+	lpg = imgl2s (imageptr, numrow/2)
+	yesno = YES
+	iferr (call flocr (Mems[lpg], numpix, pointbuf, numrow, npoints, leftx,
+	    rightx, threshold, yesno))
+	    call eprintf ("Error in 'find limb on center row(flocr)'\n")
+	if (yesno == NO)
+	    call error (0,"Failure to find initial limb points, quickfit dies")
+
+	leftsave = leftx
+	rightsave = rightx
+
+	# Find the limb points for the lower half of the image.
+	yesno = YES
+	y = numrow/2-rowspace
+	while (y >= 1) {
+
+	    # Read this line in from the image.
+	    lpg = imgl2s (imageptr, y)
+
+	    # Find its limb points.
+	    iferr (call florr (Mems[lpg], numpix, pointbuf, npoints, numrow,
+	        y, leftx, rightx, threshold, yesno, rguess, halfwidth))
+		call eprintf ("Error in florr.\n")
+	    if (yesno == NO)
+		break
+	    if (abs(y-numrow/2) > rguess)
+		break
+	    if ((int(rowspace * (rguess**2 -
+		real(y-numrow/2)**2)**.5/rguess)) >= 1)
+	        y = y - int(rowspace * (rguess**2 -
+		    real(y-numrow/2)**2)**.5/rguess)
+	    else
+		y = y - 1
+	}
+
+	# Find the limb points for the upper half of the image.
+
+	# Restore the pointers to the limb at disk center.
+	leftx = leftsave
+	rightx = rightsave
+	yesno = NO
+	y = numrow/2+rowspace
+
+	while (y <= numrow) {
+	    # Read this line in from the image.
+	    lpg = imgl2s (imageptr, y)
+
+	    # Find its limb points.
+	    iferr (call florr (Mems[lpg], numpix, pointbuf, npoints, numrow,
+		y, leftx, rightx, threshold, yesno, rguess, halfwidth))
+		call eprintf ("Error in florr.\n")
+
+	    # If we couldn't find any limb points then it's time to go.
+	    if (yesno == NO)
+		break
+
+	    # If we are beyond the limb vertically then its time to go.
+	    if (abs(y-numrow/2) > rguess)
+		break
+
+	    # If the calculated rowspacing gets less than 1, just set it to 1.
+	    if ((int(rowspace * (rguess**2 -
+		real(y-numrow/2)**2)**.5/rguess)) >= 1) {
+	        y = y + int(rowspace * (rguess**2 -
+		    real(y-numrow/2)**2)**.5/rguess)
+	    } else
+		y = y + 1
+	}
+end
+
+
+# FLOCR -- Find Limbpoints On Center Row.  Since this is the first row
+# to be searched, we have no idea of approximately where the limb points
+# will be found in the row as we have in florr.  We search from the endpoints
+# of the row inward until the squibby brightness crosses the threshold.
+
+procedure flocr (array, numpix, pointbuf, npoints, numrow, leftx, rightx,
+		    threshold, yesno)
+
+short	array[numpix]		# line of image
+int	pointbuf[SZ_VTPBUF,2]	# limb point storage array
+int	numpix			# number of pixels in line
+int	npoints			# number of limb points
+int	numrow			# which row this is in image
+int	leftx			# return left boundary position here
+int	rightx			# return right boundary position here
+int	threshold		# squibby brightness limb threshold
+int	yesno			# return yes if we found the limb
+
+int	i, j, foundi, foundj
+
+begin
+	# Start at beginning and end of array and work in.
+	i = 1
+	j = numpix
+
+	# Flags that indicate when a limbpoint has been found.
+	foundi = 0
+	foundj = 0
+
+	while (i <= j) {
+	    if (foundi == 0) {
+		if (and(int(array[i]), 17B) >= threshold) {
+		    foundi = 1
+		    npoints = npoints + 1
+		    pointbuf[npoints,1] = i
+		    pointbuf[npoints,2] = numrow/2
+		    leftx = i
+		}
+		if (i == j) {
+		    yesno = NO
+		    return
+		}
+	    }
+
+	    if (foundj == 0) {
+		if (and(int(array[j]), 17B) >= threshold) {
+		    foundj = 1
+		    npoints = npoints + 1
+		    pointbuf[npoints,1] = j
+		    pointbuf[npoints,2] = numrow/2
+		    rightx = j
+		}
+	    }
+	    if ((foundi == 1) && (foundj == 1))
+		break
+	    i = i + 1
+	    j = j - 1
+	}
+end
+
+
+# FLORR -- Find Limbpoints On Random Row. Since we know the approximate
+# positions of the limbpoints based on their positions on the ajacent
+# row, we can restrict the range of x positions to be searched to those
+# within a certain distance of those positions.  These ranges we will
+# call windows.  Each window is checked for validity before it is
+# searched for the limbpoints, if invalid a correct window is found.
+
+procedure florr (array, numpix, pointbuf, npoints, numrow, y, leftx, rightx,
+	threshold, yesno, rguess, halfwidth)
+
+short	array[numpix]		# line of image
+int	pointbuf[SZ_VTPBUF,2]	# limb point storage array
+int	numpix			# number of pixels in line
+int	npoints			# number of limb points
+int	numrow			# which row this is in image
+int	leftx			# return left boundary position here
+int	rightx			# return right boundary position here
+int	threshold		# squibby brightness limb threshold
+int	yesno			# return yes if we found the limb
+int	halfwidth		# halfwidth of limb search window
+real	rguess			# radius for sun guess
+
+int	i, j, y
+
+begin
+	# Windows are leftx plus or minus halfwidth and rightx plus or
+	# minus halfwidth.  Before searching windows, check them for
+	# validity and call newwindow if necessary.
+
+	# Check for validity means the endpoint we expect to be outside
+	# the limb should have a squibby brightness less than the
+	# threshold and the inside the limb endpoint should have a
+	# squibby brightness greater than the threshold.
+
+	# if invalid...
+	if ((and(int(array[max(1,(leftx-halfwidth))]),17B) >= threshold) ||
+	    (and(int(array[leftx+halfwidth]),17B) < threshold)) {
+
+	    # if we are getting too far from the center (outside limb)
+	    # then return flag for no limbpoints.
+
+	    if (abs(y-numrow/2) > int(rguess)) {
+		yesno = NO
+		return
+	    }
+
+	    # Otherwise calculate a new leftx for this row.
+	    leftx = -((int(rguess**2) - (y-numrow/2)**2)**.5) + numrow/2
+	}
+
+	# If we now have a valid window...
+	if ((and(int(array[max(1,(leftx-halfwidth))]),17B) < threshold) &&
+	    (and(int(array[leftx+halfwidth]),17B) >= threshold)) {
+
+	    # Search window for limb point.
+	    do i = max(1,(leftx-halfwidth)), leftx+halfwidth {
+
+		# When we find it add it to the limbpoints array and
+		# break out of the do loop
+
+	        if (and(int(array[i]), 17B) >= threshold) {
+
+		    # Set the 'we found it' flag.
+		    yesno = YES
+
+		    npoints = npoints + 1
+		    pointbuf[npoints,1] = i
+		    pointbuf[npoints,2] = y
+		    leftx = i
+		    break
+	        }
+	    }
+	}
+
+	# Same stuff for the right hand window.
+	if ((and(int(array[min(numpix,(rightx+halfwidth))]),17B) >=
+	    threshold) || (and(int(array[rightx-halfwidth]),17B) < threshold)) {
+	    if (abs(y-numrow/2) > int(rguess)) {
+		yesno = NO
+		return
+	    }
+	    rightx = (int(rguess**2) - (y-numrow/2)**2)**.5 + numrow/2
+	}
+
+	if ((and(int(array[min(numpix,(rightx+halfwidth))]),17B) < threshold) &&
+	    (and(int(array[rightx-halfwidth]),17B) >= threshold)) {
+	    do j = min(numpix,(rightx+halfwidth)), rightx-halfwidth, -1 {
+	        if (and(int(array[j]), 17B) >= threshold) {
+		    yesno = YES
+		    npoints = npoints + 1
+		    pointbuf[npoints,1] = j
+		    pointbuf[npoints,2] = y
+		    rightx = j
+		    break
+	        }
+	    }
+	}
+end
+
+
+# EFIT - Find the best fitting ellipse to the limb points.  We iterate
+# 10 times, this seems to converge very well.
+# Algorithm due to Jack Harvey.
+
+procedure efit (pointbuf, npoints, xzero, yzero, azero, bzero, rejects,
+	verbose)
+
+int	pointbuf[SZ_VTPBUF,2]		# buffer containing limb points
+int	npoints 			# number of limb points
+real	xzero, yzero, azero, bzero	# return elipse parameters
+int	rejects				# number of points rejected
+bool	verbose				# verbose flag
+
+int	i, j, ij, n
+real	xcenter, ycenter, a, b, a2, b2, a3, b3
+real	z[6,6]
+real	x1, y1, x2, y2, q[5], fn, sq
+real	rejectcoeff
+
+real	clgetr()
+
+begin
+	# Get the least squares rejection coefficient.
+	rejectcoeff = clgetr("rejectcoeff")
+	xcenter = xzero
+	ycenter = yzero
+	a = azero
+	b = azero
+
+	do ij = 1, 10 {
+	    a2 = a**2
+	    a3 = a2 * a
+	    b2 = b**2
+	    b3 = b2 * b
+	    sq = 0.
+
+	    do i = 1, 6
+		do j = 1, 6
+		    z[i,j] = 0
+
+	    fn = 0.
+	    rejects = 0
+
+	    do n = 1, npoints {
+		x1 = real(pointbuf[n,1]) - xcenter
+		y1 = real(pointbuf[n,2]) - ycenter
+		x2 = x1**2
+		y2 = y1**2
+		q[1] = x1/a2
+		q[2] = y1/b2
+		q[3] = -x2/a3
+		q[4] = -y2/b3
+		q[5] = .5 * (1. - x2/a2 - y2/b2)
+
+		# Reject a point if it is too far from the approximate ellipse.
+		if (abs(q[5]) >= rejectcoeff) {
+		    rejects = rejects + 1
+		    next
+		}
+
+		sq = sq + q[5]
+
+		do i = 1, 5
+		    do j = i, 5
+			z[i,j+1] = z[i,j+1] + q[i] * q[j]
+
+		fn = fn + 1.
+	    }
+
+	    sq = sq/fn
+	    call flush(STDOUT)
+	    call lstsq (z, 6, fn)
+	    if (z(5,3) > 3.)
+		z(5,3) = 3.
+	    if (z(5,3) < -3.)
+		z(5,3) = -3.
+	    if (z(5,4) > 3.)
+		z(5,4) = 3.
+	    if (z(5,4) < -3.)
+		z(5,4) = -3.
+	    if (z(5,1) > 10.)
+		z(5,1) = 10.
+	    if (z(5,1) < -10.)
+		z(5,1) = -10.
+	    if (z(5,2) > 10.)
+		z(5,2) = 10.
+	    if (z(5,2) < -10.)
+		z(5,2) = -10.
+	    a = a + z[5,3]
+	    b = b + z[5,4]
+	    xcenter = xcenter - z[5,1]
+	    ycenter = ycenter - z[5,2]
+
+	    if (verbose) {
+		call printf ("x = %f, y = %f, a = %f, b = %f, sq = %13.10f\n")
+		    call pargr (xcenter)
+		    call pargr (ycenter)
+		    call pargr (a)
+		    call pargr (b)
+		    call pargr (sq)
+		call flush (STDOUT)
+	    }
+	}
+
+	if (verbose) {
+	    call printf ("\nCoordinates of center are x = %f, y = %f\n")
+	        call pargr(xcenter)
+	        call pargr(ycenter)
+	    call printf ("xsemidiameter = %f, ysemidiameter = %f\n")
+	        call pargr(a)
+	        call pargr(b)
+	    call flush (STDOUT)
+	}
+
+	xzero = xcenter
+	yzero = ycenter
+	azero = a
+	bzero = b
+end
diff --git a/noao/imred/vtel/readheader.x b/noao/imred/vtel/readheader.x
new file mode 100644
index 00000000..85fb6f66
--- /dev/null
+++ b/noao/imred/vtel/readheader.x
@@ -0,0 +1,59 @@
+include <mach.h>
+include <fset.h>
+include	"vt.h"
+
+# READHEADER -- Read header info from the input.
+
+int procedure readheader(inputfd, hbuf, selfbuf)
+
+int	inputfd		# input file discriptor
+pointer	hbuf		# header data input buffer pointer (short, SZ_VTHDR)
+bool	selfbuf		# flag to tell if we should do our own buffering
+
+int	numchars
+pointer	sp, tempbuf
+int	read()
+errchk	read
+
+begin
+	call smark (sp)
+	call salloc (tempbuf, 100, TY_SHORT)
+
+	# If we are reading from tape and buffering for ourselves then
+	# do a large read and see how many chars we get.  If too few or
+	# too many give an error.  Otherwise just read the correct number 
+	# of chars.
+
+	if (selfbuf) {
+	    iferr (numchars = read (inputfd, Mems[tempbuf],
+		10000*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+		call printf ("Error reading header.\n")
+		numchars = read (inputfd, Mems[tempbuf],
+		    SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+	    }
+	    if (numchars < 10 || numchars >= 100) {
+	        call error (0, "error reading header")
+		return (numchars)
+	    }
+	    call amovs (Mems[tempbuf], Mems[hbuf], SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+	} else {
+	    iferr (numchars = read (inputfd, Mems[hbuf],
+		SZ_VTHDR*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+		call printf ("Error reading header.\n")
+		numchars = read (inputfd, Mems[tempbuf],
+		    SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+	    }
+	    if (numchars < SZ_VTHDR*SZB_SHORT/SZB_CHAR) {
+	        call error (0, "eof encountered when reading header")
+		return (0)
+	    }
+	}
+
+	if (BYTE_SWAP2 == YES)
+	    call bswap2 (Mems[hbuf], 1, Mems[hbuf], 1, SZ_VTHDR*SZB_SHORT)
+	call sfree (sp)
+
+	return (SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+end
diff --git a/noao/imred/vtel/readss1.x b/noao/imred/vtel/readss1.x
new file mode 100644
index 00000000..2aea6d51
--- /dev/null
+++ b/noao/imred/vtel/readss1.x
@@ -0,0 +1,163 @@
+include <mach.h>
+include	<imhdr.h>
+include <fset.h>
+include	"vt.h"
+
+define	WDSBRSTR	50
+
+# READSS1 -- Read a type 1 sector scan from tape and format into 3 iraf images.
+# Type one sector scans consist of three images packed into 32 bits per
+# pixel.  The three images are 1. velocity (12 bits) 2. select (12 bits) and
+# 3. continuum intensity (8 bits).  The images are only 256 pixels high as
+# opposed to 512 pixels high for the other scans.
+
+procedure readss1 (inputfd, filenumber, brief, select, bright, velocity, hs)
+
+int	inputfd			# file descriptor for input (usually tape)
+int	filenumber		# file number on tape
+bool	brief			# short output file names
+bool	select			# flag to make select image
+bool	bright			# flag to make bright image
+bool	velocity		# flag to make velocity image
+int	hs			# header data structure pointer
+
+char	velimage[SZ_FNAME]	# Velocity image
+char	selimage[SZ_FNAME]	# Select image
+char	britimage[SZ_FNAME]	# Brightness image
+short	u[SWTH_HIGH], dat
+int	date, hour, minute, seconds, i, j, num, lrs
+pointer	velim, selim, britim, velsrp, selsrp, britsrp
+
+int	read()
+pointer	immap(), impl2s()
+errchk	immap, impl2s
+
+begin
+	# Calculate the time.  Assemble the output image names.
+	hour = int(VT_HTIME(hs)/3600)
+	minute = int((VT_HTIME(hs) - hour * 3600)/60)
+	seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60)
+	if (brief) {
+	    call sprintf (velimage[1], SZ_FNAME, "v%03d")
+	        call pargi (filenumber)
+	    call sprintf (selimage[1], SZ_FNAME, "s%03d")
+	        call pargi (filenumber)
+	    call sprintf (britimage[1], SZ_FNAME, "b%03d")
+	        call pargi (filenumber)
+	} else {
+	    call sprintf (velimage[1], SZ_FNAME, "v%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	    call sprintf (selimage[1], SZ_FNAME, "s%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	    call sprintf (britimage[1], SZ_FNAME, "b%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	}
+	if (select) {
+	    selim = immap (selimage, NEW_IMAGE, 0)
+	    IM_NDIM(selim) = 2
+	    IM_LEN(selim,1) = SWTH_HIGH/2
+	    IM_LEN(selim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(selim) = TY_SHORT
+	    call imaddi (selim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (selim, "obs_date", date )
+	    call imaddi (selim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (selim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (selim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (selim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (selim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (selim, "rep_time", VT_HREPTIME(hs))
+	}
+	if (bright) {
+	    britim = immap (britimage, NEW_IMAGE, 0)
+	    IM_NDIM(britim) = 2
+	    IM_LEN(britim,1) = SWTH_HIGH/2
+	    IM_LEN(britim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(britim) = TY_SHORT
+	    call imaddi (britim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (britim, "obs_date", date )
+	    call imaddi (britim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (britim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (britim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (britim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (britim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (britim, "rep_time", VT_HREPTIME(hs))
+	}
+	if (velocity) {
+	    velim = immap (velimage, NEW_IMAGE, 0)
+	    IM_NDIM(velim) = 2
+	    IM_LEN(velim,1) = SWTH_HIGH/2
+	    IM_LEN(velim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(velim) = TY_SHORT
+	    call imaddi (velim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (velim, "obs_date", date )
+	    call imaddi (velim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (velim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (velim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (velim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (velim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (velim, "rep_time", VT_HREPTIME(hs))
+	}
+
+	do j = 1, VT_HNUMCOLS(hs) {
+	    if (select)
+	        selsrp = impl2s (selim, j)
+	    if (bright)
+	        britsrp = impl2s (britim, j)
+	    if (velocity)
+	        velsrp = impl2s (velim, j)
+
+	    iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR)
+		call eprintf ("Error on tape read.\n")
+		num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	    }
+	    lrs = num
+	    if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading file")
+	    if (BYTE_SWAP2 == YES)
+	        call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT)
+
+	    # Unpack the data into the three arrays.
+	    do i = 257, 512 {
+		if (select) {
+		    dat = u[i]/16
+		    if (u[i] < 0)
+			dat = dat - 1
+		    Mems[selsrp+i-257] = dat
+		}
+		if (bright)
+		    Mems[britsrp+i-257] = and(int(u[i]),17B)*16
+	    }
+
+	    do i = 1, 256 {
+		if (velocity) {
+		    dat = u[i]/16
+		    if (u[i] < 0)
+			dat = dat - 1
+		    Mems[velsrp+i-1] = dat
+		}
+		if (bright)
+		    Mems[britsrp+i-1] = Mems[britsrp+i-1]+and(int(u[i]),17B)
+	    }
+	}
+
+	# Unmap images.
+	if (select)
+	    call imunmap (selim)
+	if (velocity)
+	    call imunmap (velim)
+	if (bright)
+	    call imunmap (britim)
+end
diff --git a/noao/imred/vtel/readss2.x b/noao/imred/vtel/readss2.x
new file mode 100644
index 00000000..71ae8758
--- /dev/null
+++ b/noao/imred/vtel/readss2.x
@@ -0,0 +1,174 @@
+include <mach.h>
+include	<imhdr.h>
+include <fset.h>
+include	"vt.h"
+
+define	WDSBRSTR	50
+
+# READSS2 -- Read a type 2 sector scan from tape and format into 3 iraf images.
+# Type two sector scans consist of three images with 16 bits per
+# pixel.  The three images are 1. velocity (16 bits) 2. select (16 bits) and
+# 3.  brightness (16 bits).  The images are 512 pixels high.
+
+procedure readss2 (inputfd, filenumber, brief, select, bright, velocity, hs)
+
+int	inputfd			# file descriptor for input (usually tape)
+int	filenumber		# file number on tape
+bool	brief			# short output file names
+bool	select			# flag to make select image
+bool	bright			# flag to make bright image
+bool	velocity		# flag to make velocity image
+int	hs			# header data structure pointer
+
+char	velimage[SZ_FNAME]	# velocity image
+char	selimage[SZ_FNAME]	# select image
+char	britimage[SZ_FNAME]	# brightness image
+short	u[SWTH_HIGH]
+int	date, hour, minute, seconds, i, j, num, lrs
+pointer	velim, selim, britim, velsrp, selsrp, britsrp
+
+int	read()
+pointer	immap(), impl2s()
+errchk	immap, impl2s
+
+begin
+	# Calculate the time.  Assemble the output image names.
+	hour = int(VT_HTIME(hs)/3600)
+	minute = int((VT_HTIME(hs) - hour * 3600)/60)
+	seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60)
+	if (brief) {
+	    call sprintf (velimage[1], SZ_FNAME, "v%03d")
+	        call pargi (filenumber)
+	    call sprintf (selimage[1], SZ_FNAME, "s%03d")
+	        call pargi (filenumber)
+	    call sprintf (britimage[1], SZ_FNAME, "b%03d")
+	        call pargi (filenumber)
+	} else {
+	    call sprintf (velimage[1], SZ_FNAME, "v%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	    call sprintf (selimage[1], SZ_FNAME, "s%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	    call sprintf (britimage[1], SZ_FNAME, "b%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	}
+
+	if (select) {
+	    selim = immap (selimage, NEW_IMAGE, 0)
+	    IM_NDIM(selim) = 2
+	    IM_LEN(selim,1) = SWTH_HIGH
+	    IM_LEN(selim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(selim) = TY_SHORT
+	    call imaddi (selim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (selim, "obs_date", date )
+	    call imaddi (selim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (selim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (selim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (selim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (selim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (selim, "rep_time", VT_HREPTIME(hs))
+	}
+	if (bright) {
+	    britim = immap (britimage, NEW_IMAGE, 0)
+	    IM_NDIM(britim) = 2
+	    IM_LEN(britim,1) = SWTH_HIGH
+	    IM_LEN(britim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(britim) = TY_SHORT
+	    call imaddi (britim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (britim, "obs_date", date )
+	    call imaddi (britim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (britim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (britim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (britim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (britim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (britim, "rep_time", VT_HREPTIME(hs))
+	}
+	if (velocity) {
+	    velim = immap (velimage, NEW_IMAGE, 0)
+	    IM_NDIM(velim) = 2
+	    IM_LEN(velim,1) = SWTH_HIGH
+	    IM_LEN(velim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(velim) = TY_SHORT
+	    call imaddi (velim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (velim, "obs_date", date )
+	    call imaddi (velim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (velim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (velim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (velim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (velim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (velim, "rep_time", VT_HREPTIME(hs))
+	}
+
+	do j = 1, VT_HNUMCOLS(hs) {
+	    if (select)
+	        selsrp = impl2s (selim, j)
+	    if (bright)
+	        britsrp = impl2s (britim, j)
+	    if (velocity)
+	        velsrp = impl2s (velim, j)
+
+	    iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR)
+		call eprintf ("Error on tape read.\n")
+		num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	    }
+	    lrs = num
+	    if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading file")
+	    if (BYTE_SWAP2 == YES)
+	        call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT)
+
+	    if (velocity)
+		do i = 1, 512
+		    Mems[velsrp+i-1] = u[i]
+
+	    iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR)
+		call eprintf ("Error on tape read.\n")
+		num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	    }
+	    lrs = num
+	    if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading file")
+	    if (BYTE_SWAP2 == YES)
+	        call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT)
+
+	    if (select)
+		do i = 1, 512
+		    Mems[selsrp+i-1] = u[i]
+
+	    iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR)
+		call eprintf ("Error on tape read.\n")
+		num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	    }
+	    lrs = num
+	    if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading file")
+	    if (BYTE_SWAP2 == YES)
+	        call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT)
+
+	    if (bright)
+		do i = 1, 512
+		    Mems[britsrp+i-1] = u[i]
+	}
+
+	# Unmap images.
+	if (select)
+	    call imunmap (selim)
+	if (velocity)
+	    call imunmap (velim)
+	if (bright)
+	    call imunmap (britim)
+end
diff --git a/noao/imred/vtel/readss3.x b/noao/imred/vtel/readss3.x
new file mode 100644
index 00000000..f8721ae0
--- /dev/null
+++ b/noao/imred/vtel/readss3.x
@@ -0,0 +1,171 @@
+include <mach.h>
+include	<imhdr.h>
+include <fset.h>
+include	"vt.h"
+
+define	WDSBRSTR	50
+
+# READSS3 -- Read a type 3 sector scan from tape and format into 3 iraf images.
+# Type three sector scans consist of three images packed into 32 bits per
+# pixel.  The three images are 1. velocity (12 bits) 2. select (12 bits) and
+# 3. continuum intensity (8 bits)
+
+procedure readss3 (inputfd, filenumber, brief, select, bright, velocity, hs)
+
+int	inputfd			# file descriptor for input (usually tape)
+int	filenumber		# file number on tape
+bool	brief			# short output file names
+bool	select			# flag to make select image
+bool	bright			# flag to make bright image
+bool	velocity		# flag to make velocity image
+int	hs			# header data structure pointer
+
+char	velimage[SZ_FNAME]	# Velocity image
+char	selimage[SZ_FNAME]	# Select image
+char	britimage[SZ_FNAME]	# Brightness image
+bool	zero
+short	t[SWTH_HIGH], u[SWTH_HIGH], k
+int	date, hour, minute, seconds, i, j, num, lrs
+pointer	velim, selim, britim, velsrp, selsrp, britsrp
+
+define	redo_	10
+
+int	read()
+short	shifts()
+pointer	immap(), impl2s()
+errchk	immap, impl2s
+
+begin
+	k = -4
+
+	# Calculate the time.  Assemble the output image names.
+	hour = int(VT_HTIME(hs)/3600)
+	minute = int((VT_HTIME(hs) - hour * 3600)/60)
+	seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60)
+	if (brief) {
+	    call sprintf (velimage[1], SZ_FNAME, "v%03d")
+	        call pargi (filenumber)
+	    call sprintf (selimage[1], SZ_FNAME, "s%03d")
+	        call pargi (filenumber)
+	    call sprintf (britimage[1], SZ_FNAME, "b%03d")
+	        call pargi (filenumber)
+	} else {
+	    call sprintf (velimage[1], SZ_FNAME, "v%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	    call sprintf (selimage[1], SZ_FNAME, "s%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	    call sprintf (britimage[1], SZ_FNAME, "b%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	}
+	if (select) {
+	    selim = immap (selimage, NEW_IMAGE, 0)
+	    IM_NDIM(selim) = 2
+	    IM_LEN(selim,1) = SWTH_HIGH
+	    IM_LEN(selim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(selim) = TY_SHORT
+	    call imaddi (selim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (selim, "obs_date", date )
+	    call imaddi (selim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (selim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (selim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (selim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (selim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (selim, "rep_time", VT_HREPTIME(hs))
+	}
+	if (bright) {
+	    britim = immap (britimage, NEW_IMAGE, 0)
+	    IM_NDIM(britim) = 2
+	    IM_LEN(britim,1) = SWTH_HIGH
+	    IM_LEN(britim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(britim) = TY_SHORT
+	    call imaddi (britim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (britim, "obs_date", date )
+	    call imaddi (britim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (britim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (britim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (britim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (britim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (britim, "rep_time", VT_HREPTIME(hs))
+	}
+	if (velocity) {
+	    velim = immap (velimage, NEW_IMAGE, 0)
+	    IM_NDIM(velim) = 2
+	    IM_LEN(velim,1) = SWTH_HIGH
+	    IM_LEN(velim,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(velim) = TY_SHORT
+	    call imaddi (velim, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (velim, "obs_date", date )
+	    call imaddi (velim, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (velim, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (velim, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (velim, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (velim, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (velim, "rep_time", VT_HREPTIME(hs))
+	}
+
+	do j = 1, VT_HNUMCOLS(hs) {
+redo_	    if (select)
+	        selsrp = impl2s (selim, j)
+	    if (bright)
+	        britsrp = impl2s (britim, j)
+	    if (velocity)
+	        velsrp = impl2s (velim, j)
+
+	    iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR)
+		call eprintf ("Error on tape read.\n")
+		num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	    }
+	    lrs = num
+	    if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading file")
+	    if (BYTE_SWAP2 == YES)
+	        call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT)
+	    iferr (num = read (inputfd, t, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR)
+		call eprintf ("Error on tape read.\n")
+		num = read (inputfd, t, SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	    }
+	    lrs = num
+	    if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading file")
+	    if (BYTE_SWAP2 == YES)
+	        call bswap2 (t, 1, t, 1, SWTH_HIGH * SZB_SHORT)
+
+	    zero = true
+	    do i = 1, SWTH_HIGH {
+		if (select)
+	            Mems[selsrp+i-1] = shifts(t[i], k)
+		if (velocity)
+	            Mems[velsrp+i-1] = shifts(u[i], k)
+	        if (bright)
+		    Mems[britsrp+i-1] = and(int(t[i]),17B)*16+and(int(u[i]),17B)
+		if (t[i] != 0)
+		    zero = false
+	    }
+	    if (zero) {
+		call eprintf ("READSS3: found a zero line in image, skip.\n")
+		goto redo_
+	    }
+	}
+
+	# Unmap images.
+	if (select)
+	    call imunmap (selim)
+	if (velocity)
+	    call imunmap (velim)
+	if (bright)
+	    call imunmap (britim)
+end
diff --git a/noao/imred/vtel/readss4.x b/noao/imred/vtel/readss4.x
new file mode 100644
index 00000000..2ab3199d
--- /dev/null
+++ b/noao/imred/vtel/readss4.x
@@ -0,0 +1,85 @@
+include <mach.h>
+include	<imhdr.h>
+include <fset.h>
+include	"vt.h"
+
+define	WDSBRSTR	50
+
+# READSS4 -- Read data file from tape or disk and format the data into
+# an IRAF image.  This is for type 4 sector scans.
+
+procedure readss4 (inputfd, filenumber, brief, select, bright, velocity, hs)
+
+int	inputfd			# file descriptor for input (usually tape)
+int	filenumber		# file number on tape
+bool	brief			# short output file names
+bool	select			# flag to make select image
+bool	bright			# flag to make bright image
+bool	velocity		# flag to make velocity image
+int	hs			# header data structure pointer
+
+pointer	im, srp
+char	imagefile[SZ_FNAME]
+int	date, hour, minute, seconds, i, j, num, lrs
+short	u[SWTH_HIGH]
+
+int	read()
+pointer	immap(), impl2s()
+errchk	immap, impl2s
+
+begin
+	# Calculate the time.  Assemble the output image name.
+	hour = int(VT_HTIME(hs)/3600)
+	minute = int((VT_HTIME(hs) - hour * 3600)/60)
+	seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60)
+	if (brief) {
+	    call sprintf (imagefile[1], SZ_FNAME, "s%03d")
+	        call pargi (filenumber)
+	} else {
+	    call sprintf (imagefile[1], SZ_FNAME, "s%02d_%02d%02d_%03d")
+	        call pargi (VT_HDAY(hs)) # day of month
+	        call pargi (hour)
+	        call pargi (minute)
+	        call pargi (filenumber)
+	}
+
+	if (select) {
+	    im = immap (imagefile, NEW_IMAGE, 0)
+	    IM_NDIM(im) = 2
+	    IM_LEN(im,1) = SWTH_HIGH
+	    IM_LEN(im,2) = VT_HNUMCOLS(hs)
+	    IM_PIXTYPE(im) = TY_SHORT
+	    call imaddi (im, "obs_time", VT_HTIME(hs))
+	    date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs)
+	    call imaddi (im, "obs_date", date )
+	    call imaddi (im, "wv_lngth", VT_HWVLNGTH(hs))
+	    call imaddi (im, "obs_type", VT_HOBSTYPE(hs))
+	    call imaddi (im, "av_intns", VT_HAVINTENS(hs))
+	    call imaddi (im, "num_cols", VT_HNUMCOLS(hs))
+	    call imaddi (im, "intg/pix", VT_HINTGPIX(hs))
+	    call imaddi (im, "rep_time", VT_HREPTIME(hs))
+	}
+
+	do j = 1, VT_HNUMCOLS(hs) {
+	    if (select)
+	        srp = impl2s (im, j)
+
+	    iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR)
+		call eprintf ("Error on tape read.\n")
+		num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	    }
+	    lrs = num
+	    if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading file")
+	    if (BYTE_SWAP2 == YES)
+	        call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT)
+
+	    if (select)
+	        do i = 1, 512
+		    Mems[srp+i-1] = u[i]
+	}
+
+	if (select)
+	    call imunmap (im)
+end
diff --git a/noao/imred/vtel/readsubswath.x b/noao/imred/vtel/readsubswath.x
new file mode 100644
index 00000000..9c15bb44
--- /dev/null
+++ b/noao/imred/vtel/readsubswath.x
@@ -0,0 +1,91 @@
+include <mach.h>
+include <fset.h>
+include	"vt.h"
+
+define	SZ_VTRECFD	5120		# length, in chars, of full disk recs
+
+# READSUBSWATH -- Read data from file whose logical unit is inputfd.
+# Swap the bytes in each data word.
+
+procedure readsubswath (inputfd, selfbuf, databuf, buflength, bp)
+
+int	inputfd			# input file discriptor
+int	buflength		# length of data buffer
+bool	selfbuf			# self buffering flag
+short	databuf[buflength]	# data buffer
+pointer	bp			# buffer pointer structure pointer
+
+int	num, bleft, last_recsize
+int	read()
+errchk	read
+
+begin
+	# If we are doing our own buffering, keep track of the number
+	# of records in each file, else let mtio do it.
+
+	last_recsize = 0
+	if (selfbuf) {		# do our own buffering
+
+	    # If there is enough data still in the buffer, just copy data
+	    # to the output buffer and move the pointer, otherwise, read
+	    # the next tape record.
+
+	    if ((VT_BUFBOT(bp) - VT_BP(bp)) >= buflength) {
+		# Copy the data into the data buffer, move the pointer.
+		call amovs (Mems[VT_BP(bp)], databuf, buflength)
+		VT_BP(bp) = VT_BP(bp) + buflength
+
+	    } else {
+		# Copy leftover data from the bottom of the input buffer
+		# into the top of the input buffer, reset the flags.
+
+		bleft = VT_BUFBOT(bp) - VT_BP(bp)
+		call amovs (Mems[VT_BP(bp)], Mems[VT_BUFP(bp)], bleft)
+		VT_BP(bp) = VT_BUFP(bp) + bleft
+
+		# Read in another tape record.
+		# Check the number of chars read.  If this number is EOF or
+		# too short, error.  If it is too long, truncate to correct
+		# length.  This is done because some data tapes are written
+		# in a weird way and have some noise chars tacked on the end
+		# of each tape record.
+
+	        iferr (num = read (inputfd, Mems[VT_BP(bp)],
+		    10000*SZB_SHORT/SZB_CHAR)) {
+		    call fseti (inputfd, F_VALIDATE,
+			SZ_VTRECFD*SZB_SHORT/SZB_CHAR)
+		    call printf ("Error reading subswath.\n")
+		    num = read (inputfd, Mems[VT_BP(bp)],
+		        SZ_VTRECFD*SZB_SHORT/SZB_CHAR)
+	        }
+		if (num == EOF)
+		    call error (0, "EOF encountered on tape read")
+	        else if (num < SZ_VTRECFD*SZB_SHORT/SZB_CHAR)
+	            call error (0, "error on tape read, record too short")
+		else if (num >= SZ_VTRECFD*SZB_SHORT/SZB_CHAR &&
+		    num < (SZ_VTRECFD+300)*SZB_SHORT/SZB_CHAR)
+		    num = SZ_VTRECFD*SZB_SHORT/SZB_CHAR 
+		else
+	            call error (0, "error on tape read, record too long")
+
+		# Update the pointers, move data into the data buffer.
+		VT_BUFBOT(bp) = VT_BP(bp) + num
+		call amovs (Mems[VT_BP(bp)], databuf, buflength)
+		VT_BP(bp) = VT_BP(bp) + buflength
+	    }
+	} else {		# Let the mtio do the buffering.
+	    iferr (num = read (inputfd, databuf,
+		buflength*SZB_SHORT/SZB_CHAR)) {
+		call fseti (inputfd, F_VALIDATE,
+		    last_recsize*SZB_SHORT/SZB_CHAR)
+		call printf ("Error on tape read.\n")
+		num = read (inputfd, databuf, buflength*SZB_SHORT/SZB_CHAR)
+	    }
+	    last_recsize = num
+	    if (num < buflength*SZB_SHORT/SZB_CHAR)
+	        call error (0, "eof encountered when reading subswath")
+	}
+
+	if (BYTE_SWAP2 == YES)
+	    call bswap2 (databuf, 1, databuf, 1, buflength * SZB_SHORT)
+end
diff --git a/noao/imred/vtel/readvt.par b/noao/imred/vtel/readvt.par
new file mode 100644
index 00000000..5986a8c0
--- /dev/null
+++ b/noao/imred/vtel/readvt.par
@@ -0,0 +1,6 @@
+infile,s,q,,,,Input file descriptor
+outfile,s,q,,,,Output image file descriptor
+files,s,q,,,,Tape files to read
+verbose,b,h,no,,,Print out header data and give progress reports
+headeronly,b,h,no,,,Print out the header data and quit
+robust,b,h,no,,,Ignore wrong observation type in header
diff --git a/noao/imred/vtel/readvt.x b/noao/imred/vtel/readvt.x
new file mode 100644
index 00000000..27e34be3
--- /dev/null
+++ b/noao/imred/vtel/readvt.x
@@ -0,0 +1,347 @@
+include <mach.h>
+include	<imhdr.h>
+include	<fset.h>
+include	"vt.h"
+
+define	MAX_RANGES	100
+define	VT_TBUF		15000
+
+# READVT -- Read data from tape or disk and format the data into an IRAF image.
+# Display header information to the user as a check if the 'verbose' flag is
+# set. 
+
+procedure t_readvt()
+
+pointer	infile			# pointer to input filename(s)
+pointer	outfile			# pointer to output filename(s)
+bool	verbose			# verbose flag
+bool	headeronly		# if set, just print the header
+bool	robust			# if set, ignore wrong observation type
+pointer	files			# file list for multiple tape files
+
+int	listin			# list of input images
+int	listout			# list of output images
+bool	selfbuf, rootflag
+int	nfiles, filenumber, stat
+pointer	bp, sp, tapename, dfilename, diskfile, root
+int	filerange[2 * MAX_RANGES + 1]
+
+bool	clgetb()
+int	get_next_number(), mtneedfileno()
+int	strlen(), decode_ranges()
+int	fntopnb(), imtopenp(), clgfil(), imtgetim(), clplen(), imtlen()
+int	mtfile()
+errchk	vt_rfd
+
+begin
+	call smark (sp)
+	call salloc (infile, SZ_LINE, TY_CHAR)
+	call salloc (outfile, SZ_LINE, TY_CHAR)
+	call salloc (tapename, 2*SZ_LINE, TY_CHAR)
+	call salloc (dfilename, 2*SZ_LINE, TY_CHAR)
+	call salloc (diskfile, SZ_LINE, TY_CHAR)
+	call salloc (root, SZ_LINE, TY_CHAR)
+	call salloc (files, SZ_LINE, TY_CHAR)
+
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Get parameters from the CL.
+	verbose = clgetb ("verbose")
+	headeronly = clgetb ("headeronly")
+	robust = clgetb ("robust")
+
+        call clgstr ("infile", Memc[infile], SZ_FNAME)
+
+	# Set up the buffer structure, we may need it.
+	call salloc (bp, VT_LENBSTRUCT, TY_STRUCT)
+	call salloc (VT_BUFP(bp), VT_TBUF, TY_SHORT)
+	VT_BP(bp) = VT_BUFP(bp)
+	VT_BUFBOT(bp) = VT_BUFP(bp)
+
+        if (mtfile (Memc[infile]) == NO) {
+	    # This is not a tape file, expand as a list template.
+	    listin = fntopnb (Memc[infile], 0)
+	    rootflag = FALSE
+	    filenumber = 1
+	    if (!headeronly) {
+	        listout = imtopenp ("outfile")
+
+		# Compare the lengths of the two lists.  If equal, proceed,
+		# otherwise if the outlist is of length one, use it as a root
+		# name, otherwise error.
+		
+		if (imtlen (listout) == 1) {
+		    rootflag = TRUE
+		    stat = imtgetim (listout, Memc[root], SZ_FNAME)
+		} else if (clplen (listin) != imtlen (listout)) {
+		    call clpcls (listin)
+	    	    call imtclose (listout)
+	    	    call error (1, "Wrong number of elements in operand lists")
+		}
+	    }
+
+	    while (clgfil (listin, Memc[diskfile], SZ_FNAME) != EOF) {
+	        if (!headeronly) {
+		    if (!rootflag)
+	                stat = imtgetim (listout, Memc[dfilename], SZ_FNAME)
+		    else {
+			# Assemble an output filename from the root name.
+			call sprintf (Memc[dfilename], SZ_FNAME, "%s")
+			    call pargstr (Memc[root])
+	                call sprintf (Memc[dfilename+strlen(Memc[root])],
+		            SZ_FNAME, "%03d")
+		            call pargi (filenumber)
+			filenumber = filenumber + 1
+		    }
+		}
+
+		# Of course, if the user is reading from disk, we can't
+		# check record sizes.
+
+		selfbuf = false
+		iferr (call vt_rfd (diskfile, dfilename,
+			selfbuf, verbose, headeronly, robust, bp)) {
+		    call eprintf ("Error reading file %s\n")
+		    	call pargstr (Memc[infile])
+	    	}
+	    }
+	    call clpcls (listin)
+	    if (!headeronly)
+	        call imtclose (listout)
+
+	} else if (mtneedfileno(Memc[infile]) == NO) {
+
+	    # This is a tape file and the user specified which file.
+	    if (!headeronly)
+	        call clgstr ("outfile", Memc[outfile], SZ_FNAME)
+	    selfbuf = true
+	    iferr (call vt_rfd (infile, outfile, selfbuf, verbose,
+		headeronly, robust, bp)) {
+		call eprintf ("Error reading file %s\n")
+		    call pargstr (Memc[infile])
+	    }
+
+        } else {
+
+	    # This is a tape file and the user did not specify which file.
+	    call clgstr ("files", Memc[files], SZ_LINE)
+	    if (!headeronly)
+	        call clgstr ("outfile", Memc[outfile], SZ_FNAME)
+
+	    # Set up the file names, then do the read.
+            if (decode_ranges (Memc[files], filerange, MAX_RANGES,
+		nfiles) == ERR)
+	        call error (0, "Illegal file number list.")
+
+            while (get_next_number (filerange, filenumber) != EOF) {
+	        # Assemble the appropriate tape file name.
+		call mtfname (Memc[infile], filenumber, Memc[tapename],
+		    SZ_FNAME)
+
+	        # Assemble the appropriate disk file name.
+	        if (!headeronly) {
+	            call strcpy (Memc[outfile], Memc[dfilename], SZ_FNAME)
+	            call sprintf (Memc[dfilename+strlen(Memc[outfile])],
+		        SZ_FNAME, "%03d")
+		        call pargi (filenumber)
+		}
+
+	        selfbuf = TRUE
+	        iferr (call vt_rfd (tapename, dfilename, selfbuf,
+			verbose, headeronly, robust, bp)) {
+		    call eprintf ("Error reading file %s\n")
+		        call pargstr (Memc[infile])
+	        }
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# VT_RFD -- Do the actual read of a full disk gram.
+
+procedure vt_rfd (in, out, selfbuf, verbose, headeronly, robust, bp)
+
+pointer	in		# input file
+pointer	out		# output file
+bool	selfbuf		# do input buffering and correct for bad record lengths
+bool	verbose		# verbose flag
+bool	headeronly	# if set, just print the header
+bool	robust		# if set, ignore wrong observation type
+
+short	one
+int	date, numchars
+int	subraster, x1, y1, inputfd
+pointer	table, bp, im, srp, hs, sp, hbuf
+pointer	immap(), imps2s()
+int	mtopen(), readheader()
+errchk	readheader, loadsubswath, immap, imps2s
+define	exit_	10
+
+begin
+	call smark (sp)
+	call salloc (hbuf, SZ_VTHDR, TY_SHORT)
+	call salloc (table, SZ_TABLE, TY_SHORT)
+	call salloc (hs, VT_LENHSTRUCT, TY_STRUCT)
+
+	if (verbose) {
+	    call printf ("\nfile %s  ")
+		call pargstr (Memc[in])
+	}
+
+	# Open input file.
+	inputfd = mtopen (Memc[in], READ_ONLY, 0)
+
+	# Read header.
+	iferr (numchars = readheader (inputfd, hbuf, selfbuf))
+	    call error (0, "Error reading header information.")
+	call decodeheader (hbuf, hs, verbose)
+	if (verbose)
+	    call printf ("\n")
+
+	# Check the observation type in the header.  If this value is not
+	# zero (full disk) then write an error message, if the robust flag
+	# is set go ahead and read the file.
+
+	if (!robust) {
+	    if (VT_HOBSTYPE[hs] != 0) {
+	        call printf ("file %s is not a type zero scan (full disk)\n")
+		    call pargstr (Memc[in])
+	        call printf ("Use 'mscan' to read this type %d area scan\n")
+		    call pargi (VT_HOBSTYPE[hs])
+	        goto exit_      # close input file and exit
+	    }
+	} else {
+	    if (VT_HOBSTYPE[hs] != 0) {
+		call printf ("The header for file %s contains 'observation ")
+		    call pargstr (Memc[in])
+		call printf ("type = %d'\n")
+		    call pargi (VT_HOBSTYPE[hs])
+		call printf ("READVT expects the observation type ")
+		call printf ("to be zero.\n")
+		call printf ("This error will be ignored since the 'robust'")
+		call printf (" flag is set\n")
+	    }
+	}
+
+	if (headeronly)
+	    goto exit_      # close input file and exit
+
+	if (verbose) {
+	    call printf ("\nwriting %s\n")
+		call pargstr (Memc[out])
+	}
+
+	# Open the output image. Set it up.
+	im  = immap (Memc[out], NEW_IMAGE, 0)
+	IM_NDIM(im) = 2
+	IM_LEN(im,1) = DIM_VTFD
+	IM_LEN(im,2) = DIM_VTFD
+	IM_PIXTYPE(im) = TY_SHORT
+
+	# Set up the 8 header fields we need and store the information we
+	# obtained from the raw data image header.
+
+	call imaddi (im, "obs_time", VT_HTIME[hs])
+	date = VT_HMONTH[hs] * 10000 + VT_HDAY[hs] * 100 + VT_HYEAR[hs]
+
+	call imaddi (im, "obs_date", date )
+	call imaddi (im, "wv_lngth", VT_HWVLNGTH[hs])
+	call imaddi (im, "obs_type", VT_HOBSTYPE[hs])
+	call imaddi (im, "av_intns", VT_HAVINTENS[hs])
+	call imaddi (im, "num_cols", VT_HNUMCOLS[hs])
+	call imaddi (im, "intg/pix", VT_HINTGPIX[hs])
+	call imaddi (im, "rep_time", VT_HREPTIME[hs])
+
+	# Set up lookuptable.
+	one = 1
+	call amovks (one, Mems[table], SZ_TABLE)
+	call aclrs (Mems[table], HALF_DIF)
+	call aclrs (Mems[table + SWTHWID_14 + HALF_DIF], HALF_DIF)
+	call aclrs (Mems[table + SWTHWID_23 * 3], HALF_DIF)
+	call aclrs (Mems[table + SZ_TABLE - HALF_DIF], HALF_DIF)
+
+	# Now, fill the image with data.
+	do subraster = 1, NUM_SRSTR {
+
+	    # Calculate position of bottom left corner of this subraster
+	    x1 = ((NUM_SRSTR_X - 1) - mod((subraster - 1), NUM_SRSTR_X)) *
+		SRSTR_WID + 1
+	    y1 = ((NUM_SRSTR_Y - 1) - ((subraster - mod((subraster - 1),
+		NUM_SRSTR_Y)) / NUM_SRSTR_Y)) * SWTH_HIGH + 1
+
+	    # Get subraster.
+	    srp = imps2s (im, x1, x1+(SRSTR_WID - 1), y1, y1+(SWTH_HIGH - 1))
+
+	    # Load the subraster with data.
+	    iferr (call loadsubraster (inputfd, Mems[srp], SRSTR_WID, SWTH_HIGH,
+		Mems[table], subraster, selfbuf, bp)) {
+		call eprintf ("Error in loadsubraster, subraster = %d\n")
+		    call pargi (subraster)
+		break
+	    }
+
+	    if (verbose) {
+		call printf("%d%% ")
+		    call pargi ((subraster*100)/NUM_SRSTR)
+		call flush (STDOUT)
+	    }
+	}
+
+	if (verbose)
+	    call printf ("\n")
+
+	# Unmap image and close input file.
+	call imunmap (im)
+exit_
+	call sfree (sp)
+	call close (inputfd)
+end
+
+
+# LOADSUBRASTER -- Get data from the input and load it into this
+# subraster, look in the table to see if each subswath should be
+# filled with data or zeros.
+
+procedure loadsubraster (inputfd, array, nx, ny, table, subraster, selfbuf, bp)
+
+int	inputfd			# input file we are reading from
+short	array[nx, ny]		# array to put the data in
+int	nx			# x length of the array
+int	ny			# y length of the array
+short	table[SZ_TABLE]		# lookup table for data
+int	subraster		# subraster number are we loading
+bool	selfbuf			# buffering and record length checking?
+pointer	bp			# pointer to buffer pointer structure
+
+pointer	sp, bufpointer
+int	i, subswath, tableindex
+errchk	readsubswath
+
+begin
+	call smark (sp)
+	call salloc (bufpointer, ny, TY_SHORT)
+
+	for (subswath = nx;  subswath >= 1;  subswath = subswath - 1) {
+	    tableindex = (subraster - 1) * nx + ((nx + 1) - subswath)
+
+	    if (table[tableindex] == IS_DATA) {
+		iferr (call readsubswath (inputfd, selfbuf, Mems[bufpointer],
+			ny, bp)) {
+
+		    call eprintf ("Error in readsubswath, subswath = %d\n")
+			call pargi (subswath)
+		}
+
+		do i = ny, 1, -1
+		    array[subswath,i] = Mems[bufpointer + ny - i]
+
+	    } else {
+		do i = 1, ny 
+		    array[subswath,i] = 0
+	    }
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/imred/vtel/rmap.par b/noao/imred/vtel/rmap.par
new file mode 100644
index 00000000..b8c6efd0
--- /dev/null
+++ b/noao/imred/vtel/rmap.par
@@ -0,0 +1,5 @@
+inputimage,s,q,,,,Input image
+outputimage,s,q,,,,Output data image
+outweight,s,q,,,,Weights image
+outabs,s,q,,,,Absolute value image
+histoname,s,q,,,,Histogram name
diff --git a/noao/imred/vtel/rmap.x b/noao/imred/vtel/rmap.x
new file mode 100644
index 00000000..313b03db
--- /dev/null
+++ b/noao/imred/vtel/rmap.x
@@ -0,0 +1,563 @@
+include <mach.h>
+include	<imhdr.h>
+include	"vt.h"
+include "numeric.h"
+
+define	LEN_HISTO	1025
+define	SPACING		1
+
+# RMAP -- Project a full disk solar image [2048x2048] into a square
+# image [180x180] such that lines of latitude and longitude are
+# perpendicular straight lines.
+
+procedure t_rmap()
+
+char	inputimage[SZ_FNAME]	# input image
+char	outputimage[SZ_FNAME]	# output data image
+char	outweight[SZ_FNAME]	# output weight image
+char	outabs[SZ_FNAME]	# output absolute value image
+char	histoname[SZ_FNAME]	# output histogram name
+
+real	bzero			# latitude of sub-earth point
+real	el[LEN_ELSTRUCT]	# ellipse parameters data structure
+pointer	inputim, outputim, outw, outa, sp
+pointer inim_subras_ptr, outim_subras_ptr
+pointer	outwei_subras_ptr, outav_subras_ptr
+int	outputrow, wvlngth
+int	inim_subras_bottom
+double	meanf, meanaf, zcm, muzero
+int	numpix
+bool	skip, helium
+real	tempr
+
+real	imgetr()
+int	imgeti()
+pointer	immap()
+pointer imgs2s(), imps2s(), imps2i()
+double	rmap_mode()
+errchk	immap, imgs2s, imps2s, imps2i, checkimmem, rowmap
+
+begin
+	# Get parameters from the cl.
+
+	# Image names.
+	call clgstr ("inputimage", inputimage, SZ_FNAME)
+	call clgstr ("outputimage", outputimage, SZ_FNAME)
+	call clgstr ("outweight", outweight, SZ_FNAME)
+	call clgstr ("outabs", outabs, SZ_FNAME)
+	call clgstr ("histoname", histoname, SZ_FNAME)
+
+	# Open images.
+	inputim = immap (inputimage, READ_ONLY, 0)
+	wvlngth = imgeti (inputim, "wv_lngth")
+	helium = false
+	if (wvlngth == 10830)
+	    helium = true
+	outputim = immap (outputimage, NEW_COPY, inputim)
+	outw = immap (outweight, NEW_COPY, inputim)
+	if (!helium)
+	    outa = immap (outabs, NEW_COPY, inputim)
+
+	# Compute mode estimate from the input image.
+	muzero = rmap_mode (inputim, histoname, helium)
+
+	# Define some parameters for output images.
+	IM_LEN(outputim, 1) = DIM_SQUAREIM
+	IM_LEN(outputim, 2) = DIM_SQUAREIM
+	IM_PIXTYPE(outputim) = TY_INT
+
+	IM_LEN(outw, 1) = DIM_SQUAREIM
+	IM_LEN(outw, 2) = DIM_SQUAREIM
+
+	if (!helium) {
+	    IM_LEN(outa, 1) = DIM_SQUAREIM
+	    IM_LEN(outa, 2) = DIM_SQUAREIM
+	    IM_PIXTYPE(outa) = TY_INT
+	}
+
+	# Get latitude of sub-earth point from input image header.
+	bzero = imgetr (inputim, "B_ZERO")
+
+	# Ellipse parameters.
+	E_XCENTER(el) = imgetr (inputim, "E_XCEN")
+	E_YCENTER(el) = imgetr (inputim, "E_YCEN")
+	E_XSEMIDIAMETER(el) = imgetr (inputim, "E_XSMD")
+	E_YSEMIDIAMETER(el) = imgetr (inputim, "E_YSMD")
+
+	# Remove the elipse parameters from the header records of the
+	# output images
+
+	call imdelf (outputim, "E_XCEN")
+	call imdelf (outputim, "E_YCEN")
+	call imdelf (outputim, "E_XSMD")
+	call imdelf (outputim, "E_YSMD")
+
+	call imdelf (outw, "E_XCEN")
+	call imdelf (outw, "E_YCEN")
+	call imdelf (outw, "E_XSMD")
+	call imdelf (outw, "E_YSMD")
+	call imaddb (outw, "WEIGHTS", YES)
+
+	if (!helium) {
+	    call imdelf (outa, "E_XCEN")
+	    call imdelf (outa, "E_YCEN")
+	    call imdelf (outa, "E_XSMD")
+	    call imdelf (outa, "E_YSMD")
+	    call imaddb (outa, "ABS_VALU", YES)
+	}
+
+	# Set the variable that keeps track of where in the input image the
+	# bottom of the subraster is, map in the initial subraster.
+
+	inim_subras_bottom = 1
+	inim_subras_ptr = imgs2s (inputim, 1, DIM_VTFD, inim_subras_bottom,
+	    inim_subras_bottom+DIM_IN_RAS-1)
+
+	# Map the outputimages into memory.
+	outim_subras_ptr = imps2i (outputim, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+	outwei_subras_ptr = imps2s (outw, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+	if (!helium)
+	    outav_subras_ptr = imps2i (outa, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM)
+	else {
+	    call smark (sp)
+	    call salloc (outav_subras_ptr, DIM_SQUAREIM*DIM_SQUAREIM, TY_INT)
+	}
+
+	# Initialize meanf, meanaf, numpix.
+	meanf = 0.0
+	meanaf = 0.0
+	numpix = 0
+
+	# Map the input image into the output image by output image rows.
+	do outputrow = 1, DIM_SQUAREIM {
+
+	    # Check the current input subraster to see if it covers
+	    # the next output row to be mapped and map in a new subraster
+	    # if necessary.
+
+	    call checkimmem (inim_subras_bottom, bzero, inputim, outputrow,
+	        inim_subras_ptr, el, skip)
+
+	    # If checkimmem returns skip = true then this row is not contained
+	    # in the input image so fill it with zeros and skip it.
+
+	    if (skip) {
+		# Fill the empty row with zeros.
+		call emptyrow (outputrow, Memi[outim_subras_ptr],
+		    Mems[outwei_subras_ptr], Memi[outav_subras_ptr])
+		next
+	    }
+
+	    # Map this pixel row.
+	    call rowmap (inim_subras_bottom, Mems[inim_subras_ptr], bzero,
+		outputrow, Memi[outim_subras_ptr], Mems[outwei_subras_ptr],
+		Memi[outav_subras_ptr], el, muzero, meanf, meanaf, numpix,
+		helium)
+	}
+
+	# Put the mean field, the number of pixels, the zero corrected mean
+	# absolute field, the mode estimate, the zero corrected mean field,
+	# and the standard deviation in the output image header.
+
+	meanaf = meanaf/double(numpix)
+	meanf = meanf/double(numpix)
+	zcm = meanf - muzero
+	tempr = real(meanf)
+	call imaddr (outputim, "MEAN_FLD", tempr)
+	call imaddi (outputim, "NUMPIX", numpix)
+	if (!helium) {
+	    tempr = real(meanaf)
+	    call imaddr (outputim, "MEANAFLD", tempr)
+	    tempr = real(muzero)
+	    call imaddr (outputim, "MUZERO", tempr)
+	    tempr = real(zcm)
+	    call imaddr (outputim, "ZCM", tempr)
+	}
+
+	# Close images.
+	call imunmap (inputim)
+	call imunmap (outputim)
+	call imunmap (outw)
+	if (!helium)
+	    call imunmap (outa)
+	if (helium)
+	    call sfree (sp)
+end
+
+
+# CHECKIMMEM -- Check this row to see if the input subraster in memory
+# covers it and if it doesn't, map in a new subraster.
+
+procedure checkimmem (inim_subras_bottom, bzero, inputim, outputrow,
+	inim_subras_ptr, el, skip)
+
+int	inim_subras_bottom	# current bottom of the loaded subraster
+real	bzero			# latitude of sub-earth point for this image
+pointer	inputim			# pointer to input image
+int	outputrow		# which output row to map
+pointer	inim_subras_ptr		# input image subraster pointer
+real	el[LEN_ELSTRUCT]	# ellipse parameters data structure
+bool	skip			# returned flag saying to skip this line
+
+real	x ,y
+int	ymax, ymin
+real	uplat, downlat, lminusl0, latitude
+pointer	imgs2s()
+errchk	imgs2s
+
+begin
+	skip = false
+
+	# Find values for the latitudes of the upper and lower edges of this
+	# pixel row.
+
+	uplat = 180./3.1415926*asin(float(outputrow - 90)/90.)
+	downlat = 180./3.1415926*asin(float(outputrow - 91)/90.)
+
+	# Check to see if this row is either completely off the image or
+	# partially off the image.  If it is off the image then return
+	# skip = true.  If it is partially off the image then truncate
+	# the appropriate boundary latitude at the image boundary.
+
+	if (bzero > 0) {
+	    if ( downlat < (-90 + bzero) && uplat < (-90 + bzero)) {
+
+		# This row is not on the image.
+		skip = true
+		return
+	    }
+	    if (downlat < (-90 + bzero))
+		downlat = -90 + bzero
+	} else {
+	    if ( downlat > (90 - bzero) && uplat > (90 - bzero)) {
+
+		# This row is not on the image.
+		skip = true
+		return
+	    }
+	    if (uplat > (90 - bzero))
+		uplat = 90 - bzero
+	}
+
+	# Calculate the minimum and maximum values of y in the input image that
+	# we will need to map this output row of pixels and check these
+	# values against the value of the current bottom of the subraster.
+
+	if (bzero > 0) {
+
+	    # Calculate y position in image.
+	    lminusl0 = 90.
+	    latitude = uplat
+	    call getxy (latitude, lminusl0, bzero, el, x, y, skip)
+	    ymax = int(y + .5)
+	    lminusl0 = -90.
+	    latitude = uplat
+	    call getxy (latitude, lminusl0, bzero, el, x, y, skip)
+	    if (int(y + .5) > ymax)
+		ymax = int(y + .5)
+
+	    # Calculate min y position.
+	    lminusl0 = 0.
+	    latitude = downlat
+	    call getxy (latitude, lminusl0, bzero, el, x, y, skip)
+	    ymin = int(y + .5)
+
+	} else {
+
+	    # Calculate y position in image.
+	    lminusl0 = 90.
+	    latitude = downlat
+	    call getxy (latitude, lminusl0, bzero, el, x, y, skip)
+	    ymin = int(y + .5)
+	    lminusl0 = -90.
+	    latitude = downlat
+	    call getxy (latitude, lminusl0, bzero, el, x, y, skip)
+	    if (int(y + .5) < ymin) ymin = int(y + .5)
+
+	    # Calculate max y position.
+	    lminusl0 = 0.
+	    latitude = uplat
+	    call getxy (latitude, lminusl0, bzero, el, x, y, skip)
+	    ymax = int(y + .5)
+	}
+
+	# If ymin or ymax is outside the current subraster, then map in
+	# an appropriate subraster.
+
+	if ((ymin < (inim_subras_bottom + 5)) ||
+	    (ymax > (inim_subras_bottom + 140))) {
+	    if ((ymax - ymin) > 150) {
+		call printf ("Subraster too small(ymax-ymin > 150), bye")
+	    }
+	    if ((ymin +  144) > 2048) {
+		ymin = 2048 - 144
+	    }
+	    if ((ymin - 5) < 1) {
+		skip = true
+		return
+	    }
+	    inim_subras_ptr = imgs2s (inputim, 1, DIM_VTFD, (ymin - 5),
+		(ymin + 144))
+	    inim_subras_bottom = ymin - 5
+	}
+end
+
+
+# ROWMAP -- Map this output row pixel by pixel.
+
+procedure rowmap (inim_subras_bottom, in_subraster, bzero, outputrow,
+	out_subraster, outw_subraster, outa_subraster, el, muzero, meanf,
+	meanaf, numpix helium)
+
+real	bzero						# lat of sub-earth
+real	el[LEN_ELSTRUCT]		# ellipse parameters data structure
+int	inim_subras_bottom				# bottom of current
+int	outputrow					# output row
+short	in_subraster[DIM_VTFD, DIM_IN_RAS]		# subraster
+int	out_subraster[DIM_SQUAREIM, DIM_SQUAREIM]	# output image
+short	outw_subraster[DIM_SQUAREIM, DIM_SQUAREIM]	# output weights
+int	outa_subraster[DIM_SQUAREIM, DIM_SQUAREIM]	# output abs. value
+double	muzero						# mode estimate
+double	meanf						# mean field
+double	meanaf						# mean absolute field
+int	numpix						# number of pixels
+bool	helium						# 10830 flag
+
+int	pixel
+
+errchk	pixelmap
+
+begin
+	# Do all 180 pixels in this output row.
+	do pixel = 1,180 {
+	    call pixelmap (pixel, in_subraster, inim_subras_bottom,
+		bzero, outputrow, out_subraster, outw_subraster, outa_subraster,
+		el, muzero, meanf, meanaf, numpix, helium)
+	}
+end
+
+
+# PIXELMAP -- Sum up and count the input pixels contained inside the
+# given output pixel.  The sum is carried out in the following way:
+#
+# Calculate, on the input image, the position of the center of the
+#    output pixel to be mapped.
+# Calculate the values of the partial derivitives of latitude and
+#    longitude with respect to x and y.
+# Calculate the boundaries of the pixel in the input image and
+#    sum and count all the pixels inside, assign the value
+#    to the output pixel = sum/count.
+
+procedure pixelmap (pixel, in_subraster, inim_subras_bottom,
+	bzero, outputrow, out_subraster, outw_subraster, outa_subraster,
+	el, muzero, meanf, meanaf, numpix, helium)
+
+int	pixel						# which pixel
+short	in_subraster[DIM_VTFD, DIM_IN_RAS]		# subraster
+int	inim_subras_bottom				# bottom of current
+real	bzero						# lat of sub-earth
+int	outputrow					# output row
+int	out_subraster[DIM_SQUAREIM, DIM_SQUAREIM]	# output image
+short	outw_subraster[DIM_SQUAREIM, DIM_SQUAREIM]	# output weights
+int	outa_subraster[DIM_SQUAREIM, DIM_SQUAREIM]	# output abs. value
+real	el[LEN_ELSTRUCT]		# ellipse parameters data structure
+double	muzero						# mode estimate
+double	meanf						# first moment accum.
+double	meanaf						# mean absolute field
+int	numpix						# number of pixels
+bool	helium						# helium flag
+
+real	lat_mid, long_mid, lat_bot, lat_top
+real	long_rite, long_left
+double	sum, sumabs
+int	count
+real	xpixcenter, ypixcenter
+real	dlongdx, dlatdy
+int	xleft,xright,ybottom,ytop,x,y
+int	num_pix_vert, num_pix_horz
+pointer	sp
+pointer	num					# numeric structure pointer
+real	dat
+
+begin
+	call smark (sp)
+	call salloc (num, VT_LENNUMSTRUCT, TY_STRUCT)
+
+	# First obtain the parameters necessary from numeric.
+	call numeric (bzero, el, outputrow, pixel, xpixcenter, ypixcenter, num)
+
+	dlongdx = VT_DLODX(num)
+	dlatdy = VT_DLATDY(num)
+	lat_top = VT_LATTOP(num)
+	lat_bot = VT_LATBOT(num)
+	long_left = VT_LOLEFT(num)
+	long_rite = VT_LORITE(num)
+	lat_mid = VT_LATMID(num)
+	long_mid = VT_LOMID(num)
+
+	if (lat_top == 10000.) {
+	    out_subraster[pixel,outputrow] = 0
+	    outw_subraster[pixel,outputrow] = 0
+	    outa_subraster[pixel,outputrow] = 0
+	    call sfree (sp)
+	    return
+	}
+
+	# Calculate the box of pixels we want.
+	num_pix_horz = int((1.0 / dlongdx) + .5)
+	xleft = xpixcenter - int((.5 / dlongdx) + .5)
+	xright = xleft + num_pix_horz - 1
+	num_pix_vert = int((abs(abs(lat_top) - abs(lat_bot)) / dlatdy) + .5)
+	ybottom = ypixcenter - int(((abs(abs(lat_mid) - abs(lat_bot))) /
+	    dlatdy) + .5) - (inim_subras_bottom - 1)
+	ytop = ybottom + num_pix_vert - 1
+	
+	# Sum up the pixels inside this box.
+	count = 0
+	sum = 0.0
+	sumabs = 0.0
+
+	do x = xleft, xright {
+	    do y = ybottom, ytop {
+		if (and(int(in_subraster[x,y]),17B) >= THRESHOLD+1) {
+		    count = count + 1
+
+		    # Divide by 16 to remove squibby brightness
+		    # Accumulate the various moment data.
+		    dat = real(in_subraster[x,y]/16)
+		    sum = sum + double(dat)
+		    sumabs = sumabs + double(abs(dat - muzero))
+		}
+	    }
+	}
+
+	outw_subraster[pixel,outputrow] = short(count)
+	out_subraster[pixel,outputrow] = int(sum - double(count*muzero) + .5)
+	if (!helium)
+	    outa_subraster[pixel,outputrow] = int(sumabs + .5)
+	meanf = meanf + sum
+	meanaf = meanaf + sumabs
+	numpix = numpix + count
+
+	call sfree (sp)
+end
+
+
+# EMPTYROW -- Set this row in the output image to zero.
+
+procedure emptyrow (outputrow, out_subraster, outw_subraster, outa_subraster)
+
+int	outputrow
+int	out_subraster[DIM_SQUAREIM, DIM_SQUAREIM]
+short	outw_subraster[DIM_SQUAREIM, DIM_SQUAREIM]
+int	outa_subraster[DIM_SQUAREIM, DIM_SQUAREIM]
+
+int	pixel
+
+begin
+	# Do all 180 pixels in this output row.
+	do pixel = 1,180 {
+	    out_subraster[pixel, outputrow] = 0
+	    outw_subraster[pixel, outputrow] = 0
+	    outa_subraster[pixel, outputrow] = 0
+	}
+end
+
+
+double procedure rmap_mode (inputim, histoname, helium)
+
+pointer	inputim			# Input image
+char	histoname[SZ_FNAME]	# Histogram name
+bool	helium
+
+int	count, i, j
+int	dati, hist_middle
+pointer	imline, histim, hiptr
+int	histo[LEN_HISTO]
+
+# Stuff for mrqmin.
+real    a[3], x[LEN_HISTO], y[LEN_HISTO], sig[LEN_HISTO]
+int     lista[3]
+real    alambda, chisq, covar[3,3], alpha[3,3]
+short	k
+
+pointer	imgl2s(), impl1i(), immap()
+short	shifts()
+
+extern	gauss
+
+begin
+	# Initialize.
+	count = 0
+	k = -4
+	do i = 1, LEN_HISTO
+	    histo[i] = 0
+
+	do i = 1, DIM_VTFD, SPACING{
+	    imline = imgl2s (inputim, i)
+	    do j = 1, DIM_VTFD, SPACING {
+		if (and(int(Mems[imline+j-1]),17B) >= THRESHOLD+1) {
+		    count = count + 1
+		    dati = shifts(Mems[imline+j-1], k)
+
+		    # Put the data into a histogram.
+		    hist_middle = (LEN_HISTO-1)/2 + 1
+		    if (abs(dati) <= hist_middle-1)
+			histo[dati+hist_middle] = histo[dati+hist_middle] + 1
+		}
+	    }
+	}
+
+	# Write this histogram out to an image.
+	histim = immap (histoname, NEW_COPY, inputim)
+	IM_NDIM(histim) = 1
+	IM_LEN(histim, 1) = LEN_HISTO
+	IM_PIXTYPE(histim) = TY_INT
+	hiptr = impl1i (histim)
+
+	# Put the histogram into this image.
+	do i = 1, LEN_HISTO
+	    Memi[hiptr+i-1] = histo[i]
+
+	if (!helium) {
+	    # Set up arrays, etc. for gaussian fit.
+	    a[2] = 1.0
+	    a[1] = real(histo[1])
+	    do i = 1, LEN_HISTO {
+	        x[i] = real(i)
+	        y[i] = real(histo[i])
+	        sig[i] = 1.0
+	        if (histo[i] > a[1]) {
+		    a[1] = real(histo[i])
+		    a[2] = real(i)
+	        }
+	    }
+	    a[3] = 15.0
+
+	    do i = 1, 3
+	        lista[i] = i
+
+	    # Fit the gaussian.
+	    alambda = -1.0
+	    call mrqmin (x, y, sig, LEN_HISTO, a, 3, lista, 3, covar, alpha, 3,
+	        chisq, gauss, alambda)
+	    do i = 1, 10 {
+	        call mrqmin (x, y, sig, LEN_HISTO, a, 3, lista, 3, covar,
+		    alpha, 3, chisq, gauss, alambda)
+	    }
+
+	    call imaddr (histim, "GSS_AMPL", a[1])
+	    call imaddr (histim, "GSS_CNTR", a[2])
+	    call imaddr (histim, "GSS_WDTH", a[3])
+
+	    # Put the mode estimate in the header.
+	    call imaddr (histim, "MUZERO", (a[2] - real(hist_middle)))
+	}
+
+	call imunmap (histim)
+
+	if (helium)
+	    return (0.0)
+	else
+	    return (double(a[2] - real(hist_middle)))
+end
diff --git a/noao/imred/vtel/syndico.h b/noao/imred/vtel/syndico.h
new file mode 100644
index 00000000..d7693057
--- /dev/null
+++ b/noao/imred/vtel/syndico.h
@@ -0,0 +1,13 @@
+# coordinates of center of picture.
+define DICO_XCENTER	.505
+define DICO_YCENTER	.500
+
+# The number of dicomed pixels it takes to make 18 centimeters on a 
+# standard dicomed plot.
+define DICO_18CM	2436.0
+
+# coordinates of greyscale box
+define IMGBL_X	.245
+define IMGBL_Y	.867
+define IMGTR_X	.765
+define IMGTR_Y	.902
diff --git a/noao/imred/vtel/syndico.par b/noao/imred/vtel/syndico.par
new file mode 100644
index 00000000..b36d0624
--- /dev/null
+++ b/noao/imred/vtel/syndico.par
@@ -0,0 +1,14 @@
+image,s,a,,,,input image
+logofile,s,h,iraf$noao/imred/vtel/nsolcrypt.dat,,,logo file
+device,s,h,dicomed,,,plot device
+sbthresh,i,h,2,,,squibby brightness threshold
+plotlogo,b,h,yes,,,plot the logo on the image?
+verbose,b,h,no,,,give progress reports?
+forcetype,b,h,no,,,force the data type?
+magnetic,b,h,yes,,,if forcing datatype is it magnetic else 10830
+month,i,q,,,,month the observation was made
+day,i,q,,,,day the observation was made
+year,i,q,,,,year the observation was made
+hour,i,q,,,,hour the observation was made
+minute,i,q,,,,minute the observation was made
+second,i,q,,,,second the observation was made
diff --git a/noao/imred/vtel/syndico.x b/noao/imred/vtel/syndico.x
new file mode 100644
index 00000000..64910679
--- /dev/null
+++ b/noao/imred/vtel/syndico.x
@@ -0,0 +1,416 @@
+include <mach.h>
+include <imhdr.h>
+include <imset.h>
+include <gset.h>
+include "syndico.h"
+include "vt.h"
+
+# SYNDICO -- Make Dicomed prints of synoptic images.  This program is tuned
+# to make the images 18 centimeters in diameter.
+
+procedure t_syndico()
+
+char	image[SZ_FNAME]				# image to plot
+char	logofile[SZ_FNAME]			# file containing logo
+char	device[SZ_FNAME]			# plot device
+int	sbthresh				# squibby brightness threshold
+bool	verbose					# verbose flag
+bool	plotlogo				# plotlogo flag
+bool	forcetype				# force image type flag
+bool	magnetic				# image type = magnetic flag
+
+int	obsdate, wavelength, obstime
+int	i, j, month, day, year, hour, minute, second, stat, bufptr
+real	delta_gblock, x, y
+real	excen, eycen, exsmd, eysmd, rguess
+real	b0, l0
+real	mapy1, mapy2, radius, scale, diskfrac
+char	ltext[SZ_LINE]
+char	system_id[SZ_LINE]
+
+short	grey[16]
+pointer	gp, sp, im, lf
+pointer	subrasp, subras1, buff
+int	trnsfrm[513]
+int	lkup10830[1091]
+int	gs10830[16]
+real	xstart, xend, ystart, yend, yinc
+real	xcenerr, ycenerr, ndc_xcerr, ndc_ycerr
+real	temp_xcenter, temp_ycenter
+
+pointer	immap(), gopen(), imgl2s()
+int	imgeti(), clgeti(), open(), read()
+real	imgetr()
+bool	clgetb(), imaccf()
+include	"trnsfrm.inc"
+errchk	gopen, immap, sysid, imgs2s, imgl2s
+
+# Grey scale points for 10830.
+data (gs10830[i], i = 1, 6) /-1000,-700,-500,-400,-300,-250/
+data (gs10830[i], i = 7, 10) /-200,-150,-100,-50/
+data (gs10830[i], i = 11, 16) /0,10,20,40,60,90/
+
+begin
+	call smark (sp)
+	call salloc (subrasp, DIM_VTFD, TY_SHORT)
+	call salloc (subras1, 185*185, TY_SHORT)
+	call salloc (buff, 185, TY_CHAR)
+
+	# Get parameters from the cl.
+	call clgstr ("image", image, SZ_FNAME)
+	call clgstr ("logofile", logofile, SZ_FNAME)
+	call clgstr ("device", device, SZ_FNAME)
+	sbthresh = clgeti ("sbthresh")
+	plotlogo = clgetb ("plotlogo")
+	verbose = clgetb ("verbose")
+	forcetype = clgetb ("forcetype")
+	magnetic = clgetb ("magnetic")
+
+	# Open the input image, open the logo image if requested.
+	im = immap (image, READ_ONLY, 0)
+	if (plotlogo)
+	    iferr {
+	        lf = open (logofile, READ_ONLY, TEXT_FILE)
+	    } then {
+		call eprintf ("Error opening the logo file, logo not made.\n")
+		plotlogo = false
+	    }
+
+	# Get/calculate some of the housekeeping data.
+	if (imaccf (im, "obs_date")) {
+	    obsdate = imgeti (im, "obs_date")
+	    obstime = imgeti (im, "obs_time")
+	    month = obsdate/10000
+	    day = obsdate/100 - 100 * (obsdate/10000)
+	    year = obsdate - 100 * (obsdate/100)
+	    hour = int(obstime/3600)
+	    minute = int((obstime - hour * 3600)/60)
+	    second = obstime - hour * 3600 - minute * 60
+	} else {
+	    # Use cl query parameters to get these values.
+	    call eprintf ("Date and Time not found in image header.\n")
+	    call eprintf ("Please enter them below.\n")
+	    month = clgeti ("month")
+	    day = clgeti ("day")
+	    year = clgeti ("year")
+	    hour = clgeti ("hour")
+	    minute = clgeti ("minute")
+	    second = clgeti ("second")
+	}
+
+	# Get the solar image center and radius from the image header,
+	# get the solar image radius from the ephemeris routine.  If 
+	# the two radii are similar, use the former one, if they are
+	# %10 percent or more different, use the ephemeris radius and
+	# assume the center is at (1024,1024).
+
+	# Get ellipse parameters from image header.
+	# If they are not there, warn the user that we are using ephemeris
+	# values.
+	if (imaccf (im, "E_XCEN")) {
+	    excen =  imgetr (im, "E_XCEN")
+	    eycen =  imgetr (im, "E_YCEN")
+	    exsmd =  imgetr (im, "E_XSMD")
+	    eysmd =  imgetr (im, "E_YSMD")
+
+	    # Get rguess from ephem.
+	    iferr (call ephem (month, day, year, hour, minute, second, rguess,
+	        b0, l0, false))
+	        call eprintf ("Error getting ephemeris data.\n")
+
+	    radius = (exsmd + eysmd) / 2.0
+	    if (abs(abs(radius-rguess)/rguess - 1.0) > 0.1) {
+	        radius = rguess
+	        excen = 1024.0
+	        eycen = 1024.0
+	    }
+
+	} else {
+	    call eprintf ("No ellipse parameters in image header.\n Using")
+	    call eprintf (" ephemeris value for radius and setting center to")
+	    call eprintf (" 1024, 1024\n")
+
+	    # Get rguess from ephem.
+	    iferr (call ephem (month, day, year, hour, minute, second, rguess,
+	        b0, l0, false))
+	        call eprintf ("Error getting ephemeris data.\n")
+
+	    radius = rguess
+	    excen = 1024.0
+	    eycen = 1024.0
+	}
+
+	# Error in center. (units of pixels)
+	xcenerr = excen - 1024.0
+	ycenerr = eycen - 1024.0
+
+	# Transform error to NDC.
+	ndc_xcerr = xcenerr * (1.0/4096.0)
+	ndc_ycerr = ycenerr * (1.0/4096.0)
+
+	# Next, knowing that the image diameter must be 18 centimeters,
+	# calculate the scaling factor we must use to expand the image.
+	# DICO_18CM is a MAGIC number = 18 centimeters on dicomed prints
+	# given the way the NOAO photo lab currently enlarges the images.
+	scale = DICO_18CM / real(radius*2)
+
+	# Open the output file.
+	gp = gopen (device, NEW_FILE, STDGRAPH)
+
+	# Put feducial(sp?) marks on plot.
+	diskfrac = radius/1024.0
+	temp_xcenter = DICO_XCENTER-ndc_xcerr
+	temp_ycenter = DICO_YCENTER-ndc_ycerr
+	call gline (gp, temp_xcenter, temp_ycenter+diskfrac*.25*scale+.01,
+	    temp_xcenter, temp_ycenter+diskfrac*.25*scale+.025)
+	call gline (gp, temp_xcenter, temp_ycenter-diskfrac*.25*scale-.01,
+	    temp_xcenter, temp_ycenter-diskfrac*.25*scale-.025)
+	
+	# Draw a little compass on the plot.
+	call gline (gp, .25, DICO_YCENTER+.25+.01,
+	    .25, DICO_YCENTER+.25+.035)
+	call gtext (gp, .25, DICO_YCENTER+.25+.037,
+	    "N", "v=b;h=c;s=.50")
+	call gmark (gp, .2565, DICO_YCENTER+.25+.037,
+	    GM_CIRCLE, .006, .006)
+	call gmark (gp, .2565, DICO_YCENTER+.25+.037,
+	    GM_CIRCLE, .001, .001)
+	call gline (gp, .25, DICO_YCENTER+.25+.01,
+	    .28, DICO_YCENTER+.25+.01)
+	call gtext (gp, .282, DICO_YCENTER+.25+.01,
+	    "W", "v=c;h=l;s=.50")
+	call gmark (gp, .290, DICO_YCENTER+.25+.01-.006,
+	    GM_CIRCLE, .006, .006)
+	call gmark (gp, .290, DICO_YCENTER+.25+.01-.006,
+	    GM_CIRCLE, .001, .001)
+
+	# Get the wavelength from the image header.  If the user wants
+	# to force the wavelength, do so.  (this is used if the header
+	# information about wavelength is wrong.)
+	wavelength = imgeti (im, "wv_lngth")
+	if (forcetype)
+	    if (magnetic)
+		wavelength = 8688
+	    else
+		wavelength = 10830
+
+	# Write the grey scale labels onto the plot.
+	delta_gblock = (IMGTR_X - IMGBL_X)/16.
+	y = IMGBL_Y - .005
+	do i = 1, 16 {
+	    x = IMGBL_X + real(i-1) * delta_gblock + delta_gblock/2.
+	    call sprintf (ltext, SZ_LINE, "%d")
+	    if (wavelength == 8688)
+		call pargi ((i-1)*(int((512./15.)+0.5))-256)
+	    else if (wavelength == 10830)
+		call pargi (gs10830(i))
+	    call gtext (gp, x, y, ltext, "v=t;h=c;s=.20")
+	}
+
+	# Label on grey scale.
+	call sprintf (ltext, SZ_LINE, "%s")
+	if (wavelength == 8688)
+	    call pargstr ("gauss")
+	else if (wavelength == 10830)
+	    call pargstr ("relative line strength")
+        call gtext (gp, DICO_XCENTER, (IMGBL_Y-.024), ltext, "v=c;h=c;s=.5")
+
+	# Put the title on.
+	call sprintf (ltext, SZ_LINE, "%s")
+	if (wavelength == 8688)
+	    call pargstr ("8688 MAGNETOGRAM")
+	else if (wavelength == 10830)
+	    call pargstr ("10830 SPECTROHELIOGRAM")
+	else
+	    call pargstr (" ")
+	call gtext (gp, DICO_XCENTER, .135, ltext, "v=c;h=c;s=.7")
+
+	# If we don't have a logo to plot, write the data origin on the plot.
+	if (!plotlogo) {
+
+	    call sprintf (ltext, SZ_LINE, "%s")
+	        call pargstr ("National")
+	    call gtext (gp, .24, .155, ltext, "v=c;h=c;s=.7")
+	    call sprintf (ltext, SZ_LINE, "%s")
+	        call pargstr ("Solar")
+	    call gtext (gp, .24, .135, ltext, "v=c;h=c;s=.7")
+	    call sprintf (ltext, SZ_LINE, "%s")
+	        call pargstr ("Observatory")
+	    call gtext (gp, .24, .115, ltext, "v=c;h=c;s=.7")
+	}
+
+	# Put month/day/year on plot.
+	call sprintf (ltext, SZ_LINE, "%02d/%02d/%02d")
+	    call pargi (month)
+	    call pargi (day)
+	    call pargi (year)
+	call gtext (gp, .70, .175, ltext, "v=c;h=l;s=.5")
+
+	# Put the hour:minute:second on plot.
+	call sprintf (ltext, SZ_LINE, "%02d:%02d:%02d UT")
+	    call pargi (hour)
+	    call pargi (minute)
+	    call pargi (second)
+	call gtext (gp, .70, .155, ltext, "v=c;h=l;s=.5")
+
+	# Fill in the grey scale.
+	if (wavelength == 8688) {
+	    do i = 1, 16
+	        grey[i] = (trnsfrm[(i-1)*(int((512./15.)+0.5))+1])
+	    call gpcell (gp, grey, 16, 1, IMGBL_X, IMGBL_Y, IMGTR_X, IMGTR_Y)
+	} else if (wavelength == 10830) {
+	    do i = 1, 16
+	        grey[i] = (lkup10830[gs10830(i)+1001])
+	    call gpcell (gp, grey, 16, 1, IMGBL_X, IMGBL_Y, IMGTR_X, IMGTR_Y)
+	}
+
+	# Prepare some constants for plotting.
+	xstart = temp_xcenter - .25 * scale
+	xend = temp_xcenter + .25 * scale
+	ystart = temp_ycenter - .25 * scale
+	yend = temp_ycenter + .5 * scale
+	mapy1 = ystart
+	mapy2 = ystart
+	yinc = (.5*scale)/real(DIM_VTFD)
+	
+	# Put the data on the plot. Line by line.
+	do i = 1, DIM_VTFD {
+
+	    if (verbose) {
+		call printf ("line = %d\n")
+		    call pargi (i)
+		call flush (STDOUT)
+	    }
+	
+	    subrasp = imgl2s (im, i)
+
+	    # Call the limb trimmer and data divider.
+	    call fixline (Mems[subrasp], DIM_VTFD, wavelength, sbthresh)
+
+	    # Update the top and bottom edges of this line.
+	    mapy1 = mapy2
+	    mapy2 = mapy2 + yinc
+
+	    # Put the line on the output plot.
+	    call gpcell (gp, Mems[subrasp], DIM_VTFD, 1, xstart,
+		mapy1, xend, mapy2)
+
+	} # End of do loop on image lines.
+
+	# Put the system identification on the plot.
+	call sysid (system_id, SZ_LINE)
+	call gtext (gp, DICO_XCENTER, .076, system_id, "h=c;s=0.45")
+
+	# Put the NSO logo on the plot.
+	if (plotlogo) {
+
+	    # Read in the image. (the image is encoded in a text file)
+	    do i = 1, 185 {
+	        bufptr = 0
+	        while (bufptr < 185-79) {
+	            stat = read (lf, Memc[buff+bufptr], 80)
+		    bufptr = bufptr + 79
+	        }
+	        stat = read (lf, Memc[buff+bufptr], 80)
+	        do j = 1, 185 {
+		    Mems[subras1+(i-1)*185+j-1] =
+			short((Memc[buff+j-1]-32.)*2.7027027)
+		}
+	    }
+
+	    # Put it on the plot.
+	    call gpcell (gp, Mems[subras1], 185, 185, .24, .13, .32, .21)
+	}
+
+	# Close the graphics pointer, unmap images, free stack.
+	call gclose (gp)
+	call imunmap (im)
+	if (plotlogo)
+	    call close (lf)
+	call sfree (sp)
+end
+
+
+# FIXLINE -- Clean up the line.  Set the value of pixels off the limb to
+# zero, remove the squibby brightness from each pixel, and apply a
+# nonlinear lookup table to the greyscale mapping.
+
+procedure fixline (ln, xlength, wavelength, sbthresh)
+
+int	xlength			# length of line buffer
+short	ln[xlength]		# line buffer
+int	wavelength		# wavelength of the observation
+int	sbthresh		# squibby brightness threshold
+
+int	trnsfrm[513]
+int	lkup10830[1091]
+bool	found
+int	i, left, right
+include	"trnsfrm.inc"
+
+begin
+	# Look in from the left end till squibby brightness goes above the
+	# threshold, remember where this limbpoint is.
+	found = false
+	do i = 1, xlength {		# Find left limbpoint.
+	    if (and(int(ln[i]),17B) > sbthresh) {
+		found = true
+		left = i
+		break
+	    }
+	}
+
+	if (found) {
+	    # Find the right limbpoint.
+	    do i = xlength, 1, -1 {
+	        if (and(int(ln[i]),17B) > sbthresh) {
+		    right = i
+		    break
+	        }
+	    }
+
+	    # Divide the image by 16, map the greyscale, and trim the limb.
+	    do i = left+1, right-1 {
+
+		# Remove squibby brightness.
+		ln[i] = ln[i]/16
+
+		if (wavelength == 8688) {
+		    # Magnetogram, nonlinear greyscale.
+		    # Make data fit in the table.
+		    if (ln[i] < -256)
+		        ln[i] = -256
+		    if (ln[i] > 256)
+		        ln[i] = 256
+
+		    # Look it up in the table.
+		    ln[i] = trnsfrm[ln[i]+257]
+		} else if (wavelength == 10830) {
+		    # 10830 spectroheliogram, nonlinear greyscale.
+		    # Make data fit in the table.
+		    if (ln[i] < -1000)
+		        ln[i] = -1000
+		    if (ln[i] > 90)
+		        ln[i] = 90
+		    # Look it up in the table.
+		    ln[i] = lkup10830[ln[i]+1001]
+		} else {
+		    # Unknown type, linear greyscale.
+		    if (ln[i] < 1)
+		        ln[i] = 1
+		    if (ln[i] > 255)
+		        ln[i] = 255
+		}
+	    }
+
+	    # Set stuff outside the limb to zero.
+	    do i = 1, left
+		ln[i] = 0
+	    do i = right, xlength
+		ln[i] = 0
+	} else {
+	    # This line is off the limb, set it to zero.
+	    do i = 1, xlength
+		ln[i] = 0
+        }
+end
diff --git a/noao/imred/vtel/tcopy.par b/noao/imred/vtel/tcopy.par
new file mode 100644
index 00000000..4facf827
--- /dev/null
+++ b/noao/imred/vtel/tcopy.par
@@ -0,0 +1,5 @@
+inputfile,s,q,,,,Input file descriptor
+files,s,q,,,,List of files to be examined
+outputfile,s,q,,,,Output file descriptor
+new_tape,b,q,,,,Are you using a new tape?
+verbose,b,h,no,,,Print out header data and give progress reports
diff --git a/noao/imred/vtel/tcopy.x b/noao/imred/vtel/tcopy.x
new file mode 100644
index 00000000..42709563
--- /dev/null
+++ b/noao/imred/vtel/tcopy.x
@@ -0,0 +1,190 @@
+include <error.h>
+include <fset.h>
+include <printf.h>
+include <mach.h>
+include	"vt.h"
+
+define	SZ_VTRECFD	5120		# length, in chars, of full disk recs
+define	YABUF		20000			# Yet Another BUFfer
+define	SWAP		{temp=$1;$1=$2;$2=temp}
+define	MAX_RANGES	100
+
+# TCOPY -- This is an asynchronous tape to tape copy routine.  It considers
+# the input and output to be streaming devices. 
+# The user specifies which files on tape s/he wants and a root name for the
+# output file names.
+
+procedure t_tcopy()
+
+char	inputfile[SZ_FNAME]
+char	files[SZ_LINE]
+char	outputfile[SZ_FNAME]
+
+char	tapename[SZ_FNAME]
+int	filerange[2 * MAX_RANGES + 1]
+int	nfiles, filenumber, numrecords, whichfile
+bool	verbose 
+
+int	decode_ranges(), mtfile()
+int	get_next_number(), tapecopy(), mtneedfileno()
+bool	clgetb()
+errchk	tapecopy
+
+begin
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+        # Get input file(s).
+        call clgstr ("inputfile", inputfile, SZ_FNAME)
+	if (mtfile (inputfile) == NO || mtneedfileno (inputfile) == NO) {
+	    call strcpy ("1", files, SZ_LINE)
+        } else {
+	    call clgstr ("files", files, SZ_LINE)
+	}
+
+        if (decode_ranges (files, filerange, MAX_RANGES, nfiles) == ERR)
+	    call error (0, "Illegal file number list.")
+
+	# Get the output file from the cl.
+	call clgstr ("outputfile", outputfile, SZ_FNAME)
+
+	# See if the output is mag tape, if not, error.
+	if (mtfile (outputfile) == NO)
+	    call error (1, "Outputfile should be magnetic tape.")
+
+	# If no tape file number is given, then ask whether the tape
+	# is blank or contains data.  If blank then start at [1], else
+	# start at [EOT].
+
+	if (mtneedfileno(outputfile) == YES)
+	    if (!clgetb ("new_tape"))
+		call mtfname (outputfile, EOT, outputfile, SZ_FNAME)
+	    else
+		call mtfname (outputfile, 1, outputfile, SZ_FNAME)
+
+	# Get verbose flag.
+	verbose = clgetb ("verbose")
+
+        # Loop over files
+	whichfile = 1
+	filenumber = 0
+        while (get_next_number (filerange, filenumber) != EOF) {
+
+	    # Assemble the appropriate tape file name.
+	    if (mtneedfileno (inputfile) == NO)
+		call strcpy (inputfile, tapename, SZ_FNAME)
+	    else
+		call mtfname (inputfile, filenumber, tapename, SZ_FNAME)
+
+	    if (whichfile > 1) {
+	        # Assemble the appropriate output file name.
+		call mtfname (outputfile, EOT, outputfile, SZ_FNAME)
+	    }
+
+	    if (verbose) {
+		call printf ("reading %s, writing %s\n")
+    		    call pargstr(tapename)
+    		    call pargstr(outputfile)
+	    }
+
+	    iferr {
+	        numrecords = tapecopy (tapename, outputfile)
+	    } then {
+		call eprintf ("Error copying file: %s\n")
+		    call pargstr (tapename)
+		call erract (EA_WARN)
+		next
+	    } else if (numrecords == 0) {
+	        call printf ("Tape at EOT\n")
+		break
+	    }
+	    whichfile = whichfile + 1
+
+        }  # End while.
+end
+
+
+# TAPECOPY -- This is the actual tape to tape copy routine.
+
+int procedure tapecopy (infile, outfile)
+
+char	infile[SZ_FNAME]
+char	outfile[SZ_FNAME]
+
+pointer	bufa, bufb, temp
+int	bufsz, numrecords
+int	nbytes, lastnbytes, in, out
+int	fstati(), mtopen(), awaitb()
+errchk	mtopen, areadb, awriteb, awaitb
+
+begin
+	# Open input file, see if it has anything in it.  If not, return.
+	in = mtopen (infile, READ_ONLY, 0)
+
+	bufsz = fstati (in, F_MAXBUFSIZE)	# Maximum output buffer size.
+	if (bufsz == 0)				# If no max, set a max.
+	    bufsz = YABUF
+
+	call malloc (bufa, bufsz, TY_CHAR) 	# Allocate output buffer.
+	call malloc (bufb, bufsz, TY_CHAR)	# Other output buffer
+
+	call areadb (in, Memc[bufa], bufsz, 0)
+	nbytes = awaitb (in)
+	if (nbytes == EOF) {
+	    call close (in)
+	    call mfree (bufa, TY_CHAR)
+	    call mfree (bufb, TY_CHAR)
+	    return (EOF)
+	}
+
+	# Open the output file.
+	out = mtopen (outfile, WRITE_ONLY, 0)
+
+	lastnbytes = 0				# Last record size memory.
+	numrecords = 0				# Number of records read.
+
+	if (nbytes > 0) {
+	    if (nbytes > SZ_VTRECFD*SZB_SHORT &&
+		nbytes < SZ_VTRECFD*SZB_SHORT+600)
+		nbytes = SZ_VTRECFD*SZB_SHORT
+	    call awriteb (out, Memc[bufa], nbytes, 0)
+	    call areadb (in, Memc[bufb], bufsz, 0)
+	    numrecords = numrecords + 1
+	}
+
+	SWAP (bufa, bufb)
+
+	# Main Loop.
+	repeat {
+	    if (awaitb (out) != nbytes) {
+		call printf ("Write error, record = %d.\n")
+		    call pargi (numrecords+1)
+	    }
+
+	    nbytes = awaitb (in)
+	    if (nbytes == ERR) {
+		call printf ("Read error, record = %d.\n")
+		    call pargi (numrecords+1)
+		nbytes = lastnbytes
+	    }
+	    lastnbytes = nbytes
+
+	    if (nbytes > 0) {
+		if (nbytes > SZ_VTRECFD*SZB_SHORT &&
+		    nbytes < SZ_VTRECFD*SZB_SHORT+600)
+		    nbytes = SZ_VTRECFD*SZB_SHORT
+	        call awriteb (out, Memc[bufa], nbytes, 0)
+	        call areadb (in, Memc[bufb], bufsz, 0)
+	        numrecords = numrecords + 1
+	    }
+
+	    SWAP (bufa, bufb)
+
+	} until (nbytes == 0)	# all done
+
+	call mfree (bufa, TY_CHAR)
+	call mfree (bufb, TY_CHAR)
+	call close (in)
+	call close (out)
+
+	return (numrecords)
+end
diff --git a/noao/imred/vtel/textim.x b/noao/imred/vtel/textim.x
new file mode 100644
index 00000000..4ca5a8c1
--- /dev/null
+++ b/noao/imred/vtel/textim.x
@@ -0,0 +1,114 @@
+include <mach.h>
+include <imhdr.h>
+
+define	FONTWIDE	6
+define	FONTHIGH	7
+define	MAXSTRING	100
+
+# TEXTIM -- Write a text string into an image using a pixel font for speed.
+# Characters are made twice as big as the font by doubling in both axes.
+
+procedure textim (im, s, x, y, xmag, ymag, value, zerobgnd, bgndvalu)
+
+pointer	im				# Image to put the text in.
+char	s[MAXSTRING]			# Text to put in the image.
+int	x, y				# x, y position in the image.
+int	xmag, ymag			# x, y magnification values.
+int	value				# Value to use in image for text.
+int	zerobgnd			# Flag to tell if we should zero bgnd.
+int	bgndvalu			# Background value to use.
+
+int	numrow, numcol, numchars
+int	fonthigh, fontwide
+int	i, l, ch
+int	nchar, line
+int	pixary[5]
+pointer	lineget, lineput
+
+short	tshort
+int	strlen()
+pointer	imgl2s(), impl2s()
+errchk	imgl2s, impl2s
+
+begin
+	# Find the length of the string (if there aren't any chars, return).
+	numchars = strlen (s)
+	if (numchars <= 0)
+	    return
+
+	# Calculate height and width of magnified font.
+	fonthigh = FONTHIGH * ymag
+	fontwide = FONTWIDE * xmag
+
+	# Check for row/col out of bounds.
+	numcol= IM_LEN(im,1)
+	numrow = IM_LEN(im,2)
+
+	if (x <= 0) {
+	    call printf ("Warning: Image text deleted, column <= 0.\n")
+	    return
+	}
+
+	if (x > numcol - fontwide*numchars) {
+	    call printf ("Warning: Image text truncated or deleted\n")
+	    numchars = int((numcol - x)/fontwide)
+	    if (numchars <= 0)
+	        return
+	}
+
+	if ((y <= 0) || (y > numrow - fonthigh)) {
+	    call printf ("Warning: Image text deleted, wrong row number.\n")
+	    return
+	}
+
+	# For each line of the text (backward).
+	for (i=7; i>=1; i=i-1) {
+	    line = y+(8-i)*ymag-1
+
+	    do l = 1, ymag {
+
+	        # Get and put the line of the image.
+	        lineget = imgl2s (im, line+(l-1))
+	        lineput = impl2s (im, line+(l-1))
+
+	        # Copy input array or the background value to output array.
+	        if (zerobgnd == 1) {
+		    tshort = bgndvalu
+	            call amovks (tshort, Mems[lineput+x-1],
+		        fontwide*numchars)
+	        } else
+	            call amovs (Mems[lineget], Mems[lineput], numcol)
+
+	        # Put the font.
+	        do ch = 1, numchars {
+	            nchar = int(s[ch])
+		    call pixbit (nchar, i, pixary)
+		    call putpix (pixary, Mems[lineput], numcol,
+			x+(ch-1)*fontwide, value, xmag)
+	        }
+	    }		# End of do on l.
+	}
+end
+
+
+# PUTPIX -- Put one line of one character into the data array.
+
+procedure putpix (pixary, array, size, position, value, xmag)
+
+int	pixary[5]		# array of pixels in character
+int	size, position		# size of data array
+short	array[size]		# data array in which to put character line
+int	value			# value to use for character pixels
+int	xmag			# x-magnification of text
+
+int	i, k, x
+
+begin
+	do i = 1, 5 {
+	    if (pixary[i] == 1) {
+		x = position + (i-1) * xmag
+		do k = 1, xmag
+		    array[x+(k-1)] = value
+	    }
+	}
+end
diff --git a/noao/imred/vtel/trim.par b/noao/imred/vtel/trim.par
new file mode 100644
index 00000000..49e6184e
--- /dev/null
+++ b/noao/imred/vtel/trim.par
@@ -0,0 +1,2 @@
+image,s,q,,,,Image name
+threshold,i,q,,0,15,Squibby brightness threshold for limb
diff --git a/noao/imred/vtel/trim.x b/noao/imred/vtel/trim.x
new file mode 100644
index 00000000..8e76489b
--- /dev/null
+++ b/noao/imred/vtel/trim.x
@@ -0,0 +1,75 @@
+include <mach.h>
+include <imhdr.h>
+include "vt.h"
+
+# TRIM -- Trim a full disk image using the squibby brightness template.
+# Leave all the squibby brightness information intact, set data outside the
+# limb to zero.
+
+procedure t_trim()
+
+char	image[SZ_FNAME]		# image to trim
+int	threshold		# squibby brightness threshold defining limb
+
+int	i, numpix
+pointer	im, lgp, lpp
+pointer	immap(), imgl2s(), impl2s()
+int	clgeti()
+errchk	immap, imgl2s, impl2s
+
+begin
+	# Get parameters from the CL.
+	call clgstr ("image", image, SZ_FNAME)
+	threshold = clgeti("threshold")
+
+	# Open image.
+	im = immap (image, READ_WRITE, 0)
+
+	do i = 1, IM_LEN(im,2) {
+	    lgp = imgl2s (im, i)
+	    lpp = impl2s (im, i)
+	    numpix = IM_LEN(im,1)
+	    call trimline (Mems[lgp], Mems[lpp], numpix, threshold)
+	}
+
+	# Unmap image.
+	call imunmap (im)
+end
+
+
+# TRIMLINE -- trim line1 and put it into line2.
+
+procedure trimline (line1, line2, numpix, threshold)
+
+short	line1[numpix]		# input line
+short	line2[numpix]		# output line
+int	numpix			# number of pixels in this line
+int	threshold		# squibby brightness threshold
+
+int	i, left, right
+
+begin
+	left = 0
+	right = 0
+
+	do i = 1, numpix {
+	    if (and(int(line1[i]),17B) >= threshold) {
+	        left = i
+	        break
+	    } else
+		line2[i] = and(int(line1[i]),17B)
+	}
+
+	if (left != 0)
+	    do i = numpix, 1, -1 {
+	        if(and(int(line1[i]),17B) >= threshold) {
+	            right = i
+	            break
+	        } else
+		    line2[i] = and(int(line1[i]),17B)
+	    }
+
+	if (left != 0 && right != 0 && left < right)
+	    do i = left, right
+		line2[i] = line1[i]
+end
diff --git a/noao/imred/vtel/trnsfrm.inc b/noao/imred/vtel/trnsfrm.inc
new file mode 100644
index 00000000..b916b126
--- /dev/null
+++ b/noao/imred/vtel/trnsfrm.inc
@@ -0,0 +1,163 @@
+data (trnsfrm[i], i = 1, 10) /56,56,56,56,57,57,57,57,58,58/
+data (trnsfrm[i], i = 11, 20) /58,58,59,59,59,59,60,60,60,60/
+data (trnsfrm[i], i = 21, 30) /61,61,61,61,62,62,62,63,63,63/
+data (trnsfrm[i], i = 31, 40) /63,64,64,64,64,65,65,65,65,66/
+data (trnsfrm[i], i = 41, 50) /66,66,67,67,67,67,68,68,68,68/
+data (trnsfrm[i], i = 51, 60) /69,69,69,70,70,70,70,71,71,71/
+data (trnsfrm[i], i = 61, 70) /71,72,72,72,73,73,73,73,74,74/
+data (trnsfrm[i], i = 71, 80) /74,75,75,75,75,76,76,76,77,77/
+data (trnsfrm[i], i = 81, 90) /77,77,78,78,78,79,79,79,79,80/
+data (trnsfrm[i], i = 91, 100) /80,80,81,81,81,82,82,82,82,83/
+data (trnsfrm[i], i = 101, 110) /83,83,84,84,84,85,85,85,85,86/
+data (trnsfrm[i], i = 111, 120) /86,86,87,87,87,88,88,88,89,89/
+data (trnsfrm[i], i = 121, 130) /89,90,90,90,90,91,91,91,92,92/
+data (trnsfrm[i], i = 131, 140) /92,93,93,93,94,94,94,95,95,95/
+data (trnsfrm[i], i = 141, 150) /96,96,96,97,97,97,98,98,98,99/
+data (trnsfrm[i], i = 151, 160) /99,99,100,100,101,101,101,102,102,102/
+data (trnsfrm[i], i = 161, 170) /103,103,103,104,104,104,105,105,106,106/
+data (trnsfrm[i], i = 171, 180) /106,107,107,107,108,108,109,109,109,110/
+data (trnsfrm[i], i = 181, 190) /110,110,111,111,112,112,112,113,113,114/
+data (trnsfrm[i], i = 191, 200) /114,114,115,115,116,116,117,117,117,118/
+data (trnsfrm[i], i = 201, 210) /118,119,119,120,120,120,121,121,122,122/
+data (trnsfrm[i], i = 211, 220) /123,123,124,124,125,125,126,126,127,127/
+data (trnsfrm[i], i = 221, 230) /128,128,129,129,130,130,131,131,132,132/
+data (trnsfrm[i], i = 231, 240) /133,133,134,135,135,136,136,137,138,138/
+data (trnsfrm[i], i = 241, 250) /139,140,140,141,142,143,143,144,145,146/
+data (trnsfrm[i], i = 251, 260) /147,148,149,150,151,153,156,158,160,161/
+data (trnsfrm[i], i = 261, 270) /162,163,164,165,166,167,168,168,169,170/
+data (trnsfrm[i], i = 271, 280) /171,171,172,173,173,174,175,175,176,176/
+data (trnsfrm[i], i = 281, 290) /177,178,178,179,179,180,180,181,181,182/
+data (trnsfrm[i], i = 291, 300) /182,183,183,184,184,185,185,186,186,187/
+data (trnsfrm[i], i = 301, 310) /187,188,188,189,189,190,190,191,191,191/
+data (trnsfrm[i], i = 311, 320) /192,192,193,193,194,194,194,195,195,196/
+data (trnsfrm[i], i = 321, 330) /196,197,197,197,198,198,199,199,199,200/
+data (trnsfrm[i], i = 331, 340) /200,201,201,201,202,202,202,203,203,204/
+data (trnsfrm[i], i = 341, 350) /204,204,205,205,205,206,206,207,207,207/
+data (trnsfrm[i], i = 351, 360) /208,208,208,209,209,209,210,210,210,211/
+data (trnsfrm[i], i = 361, 370) /211,212,212,212,213,213,213,214,214,214/
+data (trnsfrm[i], i = 371, 380) /215,215,215,216,216,216,217,217,217,218/
+data (trnsfrm[i], i = 381, 390) /218,218,219,219,219,220,220,220,221,221/
+data (trnsfrm[i], i = 391, 400) /221,221,222,222,222,223,223,223,224,224/
+data (trnsfrm[i], i = 401, 410) /224,225,225,225,226,226,226,226,227,227/
+data (trnsfrm[i], i = 411, 420) /227,228,228,228,229,229,229,229,230,230/
+data (trnsfrm[i], i = 421, 430) /230,231,231,231,232,232,232,232,233,233/
+data (trnsfrm[i], i = 431, 440) /233,234,234,234,234,235,235,235,236,236/
+data (trnsfrm[i], i = 441, 450) /236,236,237,237,237,238,238,238,238,239/
+data (trnsfrm[i], i = 451, 460) /239,239,240,240,240,240,241,241,241,241/
+data (trnsfrm[i], i = 461, 470) /242,242,242,243,243,243,243,244,244,244/
+data (trnsfrm[i], i = 471, 480) /244,245,245,245,246,246,246,246,247,247/
+data (trnsfrm[i], i = 481, 490) /247,247,248,248,248,248,249,249,249,250/
+data (trnsfrm[i], i = 491, 500) /250,250,250,251,251,251,251,252,252,252/
+data (trnsfrm[i], i = 501, 510) /252,253,253,253,253,254,254,254,254,255/
+data (trnsfrm[i], i = 511, 513) /255,255,255/
+
+data (lkup10830[i], i = 1, 10) /50,50,50,50,50,50,50,50,50,50/
+data (lkup10830[i], i = 11, 20) /50,50,50,50,50,50,50,50,50,50/
+data (lkup10830[i], i = 21, 30) /50,50,50,50,50,50,50,50,50,50/
+data (lkup10830[i], i = 31, 40) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 41, 50) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 51, 60) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 61, 70) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 71, 80) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 81, 90) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 91, 100) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 101, 110) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 111, 120) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 121, 130) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 131, 140) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 141, 150) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 151, 160) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 161, 170) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 171, 180) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 181, 190) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 191, 200) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 201, 210) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 211, 220) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 221, 230) /51,51,51,51,51,51,51,51,51,51/
+data (lkup10830[i], i = 231, 240) /51,51,52,52,52,52,52,52,52,52/
+data (lkup10830[i], i = 241, 250) /52,52,52,52,52,52,52,52,52,52/
+data (lkup10830[i], i = 251, 260) /52,52,52,52,52,52,52,52,52,52/
+data (lkup10830[i], i = 261, 270) /52,52,52,52,52,52,52,52,52,52/
+data (lkup10830[i], i = 271, 280) /52,52,52,52,52,52,52,52,52,52/
+data (lkup10830[i], i = 281, 290) /52,52,52,52,52,52,52,52,52,52/
+data (lkup10830[i], i = 291, 300) /52,52,52,52,52,52,52,52,52,52/
+data (lkup10830[i], i = 301, 310) /52,52,52,53,53,53,53,53,53,53/
+data (lkup10830[i], i = 311, 320) /53,53,53,53,53,53,53,53,53,53/
+data (lkup10830[i], i = 321, 330) /53,53,53,53,53,53,53,53,53,53/
+data (lkup10830[i], i = 331, 340) /53,53,53,53,53,53,53,53,53,54/
+data (lkup10830[i], i = 341, 350) /54,54,54,54,54,54,54,54,54,54/
+data (lkup10830[i], i = 351, 360) /54,54,54,54,54,54,54,54,54,54/
+data (lkup10830[i], i = 361, 370) /54,54,54,54,54,55,55,55,55,55/
+data (lkup10830[i], i = 371, 380) /55,55,55,55,55,55,55,55,55,55/
+data (lkup10830[i], i = 381, 390) /55,55,55,55,55,55,55,56,56,56/
+data (lkup10830[i], i = 391, 400) /56,56,56,56,56,56,56,56,56,56/
+data (lkup10830[i], i = 401, 410) /56,56,56,56,56,57,57,57,57,57/
+data (lkup10830[i], i = 411, 420) /57,57,57,57,57,57,57,57,57,57/
+data (lkup10830[i], i = 421, 430) /57,57,58,58,58,58,58,58,58,58/
+data (lkup10830[i], i = 431, 440) /58,58,58,58,58,58,58,59,59,59/
+data (lkup10830[i], i = 441, 450) /59,59,59,59,59,59,59,59,59,59/
+data (lkup10830[i], i = 451, 460) /59,60,60,60,60,60,60,60,60,60/
+data (lkup10830[i], i = 461, 470) /60,60,60,60,60,61,61,61,61,61/
+data (lkup10830[i], i = 471, 480) /61,61,61,61,61,61,61,62,62,62/
+data (lkup10830[i], i = 481, 490) /62,62,62,62,62,62,62,62,62,63/
+data (lkup10830[i], i = 491, 500) /63,63,63,63,63,63,63,63,63,63/
+data (lkup10830[i], i = 501, 510) /63,64,64,64,64,64,64,64,64,64/
+data (lkup10830[i], i = 511, 520) /64,64,65,65,65,65,65,65,65,65/
+data (lkup10830[i], i = 521, 530) /65,65,65,66,66,66,66,66,66,66/
+data (lkup10830[i], i = 531, 540) /66,66,66,67,67,67,67,67,67,67/
+data (lkup10830[i], i = 541, 550) /67,67,67,67,68,68,68,68,68,68/
+data (lkup10830[i], i = 551, 560) /68,68,68,68,69,69,69,69,69,69/
+data (lkup10830[i], i = 561, 570) /69,69,69,70,70,70,70,70,70,70/
+data (lkup10830[i], i = 571, 580) /70,70,70,71,71,71,71,71,71,71/
+data (lkup10830[i], i = 581, 590) /71,71,72,72,72,72,72,72,72,72/
+data (lkup10830[i], i = 591, 600) /72,73,73,73,73,73,73,73,73,73/
+data (lkup10830[i], i = 601, 610) /74,74,74,74,74,74,74,74,74,75/
+data (lkup10830[i], i = 611, 620) /75,75,75,75,75,75,75,75,76,76/
+data (lkup10830[i], i = 621, 630) /76,76,76,76,76,76,77,77,77,77/
+data (lkup10830[i], i = 631, 640) /77,77,77,77,78,78,78,78,78,78/
+data (lkup10830[i], i = 641, 650) /78,78,78,79,79,79,79,79,79,79/
+data (lkup10830[i], i = 651, 660) /79,80,80,80,80,80,80,80,80,81/
+data (lkup10830[i], i = 661, 670) /81,81,81,81,81,81,81,82,82,82/
+data (lkup10830[i], i = 671, 680) /82,82,82,82,82,83,83,83,83,83/
+data (lkup10830[i], i = 681, 690) /83,83,83,84,84,84,84,84,84,84/
+data (lkup10830[i], i = 691, 700) /85,85,85,85,85,85,85,85,86,86/
+data (lkup10830[i], i = 701, 710) /86,86,86,86,86,86,87,87,87,87/
+data (lkup10830[i], i = 711, 720) /87,87,87,88,88,88,88,88,88,88/
+data (lkup10830[i], i = 721, 730) /88,89,89,89,89,89,89,89,90,90/
+data (lkup10830[i], i = 731, 740) /90,90,90,90,90,91,91,91,91,91/
+data (lkup10830[i], i = 741, 750) /91,91,91,92,92,92,92,92,92,92/
+data (lkup10830[i], i = 751, 760) /93,93,93,93,93,93,93,94,94,94/
+data (lkup10830[i], i = 761, 770) /94,94,94,95,95,95,95,95,95,95/
+data (lkup10830[i], i = 771, 780) /96,96,96,96,96,96,97,97,97,97/
+data (lkup10830[i], i = 781, 790) /97,97,98,98,98,98,98,98,99,99/
+data (lkup10830[i], i = 791, 800) /99,99,99,99,100,100,100,100,100,101/
+data (lkup10830[i], i = 801, 810) /101,101,101,101,101,102,102,102,102,102/
+data (lkup10830[i], i = 811, 820) /103,103,103,103,103,104,104,104,104,104/
+data (lkup10830[i], i = 821, 830) /105,105,105,105,106,106,106,106,106,107/
+data (lkup10830[i], i = 831, 840) /107,107,107,108,108,108,108,108,109,109/
+data (lkup10830[i], i = 841, 850) /109,109,110,110,110,110,111,111,111,111/
+data (lkup10830[i], i = 851, 860) /112,112,112,113,113,113,113,114,114,114/
+data (lkup10830[i], i = 861, 870) /114,115,115,115,116,116,116,116,117,117/
+data (lkup10830[i], i = 871, 880) /117,118,118,118,118,119,119,119,120,120/
+data (lkup10830[i], i = 881, 890) /120,121,121,121,122,122,122,123,123,123/
+data (lkup10830[i], i = 891, 900) /124,124,124,125,125,125,126,126,126,127/
+data (lkup10830[i], i = 901, 910) /127,128,128,128,129,129,129,130,130,131/
+data (lkup10830[i], i = 911, 920) /131,131,132,132,132,133,133,134,134,135/
+data (lkup10830[i], i = 921, 930) /135,135,136,136,137,137,137,138,138,139/
+data (lkup10830[i], i = 931, 940) /139,140,140,141,141,141,142,142,143,143/
+data (lkup10830[i], i = 941, 950) /144,144,145,145,146,146,147,147,148,148/
+data (lkup10830[i], i = 951, 960) /149,149,150,150,151,151,152,152,153,153/
+data (lkup10830[i], i = 961, 970) /154,154,155,155,156,156,157,158,158,159/
+data (lkup10830[i], i = 971, 980) /159,160,160,161,162,162,163,163,164,164/
+data (lkup10830[i], i = 981, 990) /165,166,166,167,167,168,169,169,170,171/
+data (lkup10830[i], i = 991, 1000) /171,172,173,173,174,174,175,176,176,177/
+data (lkup10830[i], i = 1001, 1010) /178,178,179,180,180,181,182,183,183,184/
+data (lkup10830[i], i = 1011, 1020) /185,185,186,187,187,188,189,190,190,191/
+data (lkup10830[i], i = 1021, 1030) /192,193,193,194,195,196,196,197,198,199/
+data (lkup10830[i], i = 1031, 1040) /200,200,201,202,203,203,204,205,206,207/
+data (lkup10830[i], i = 1041, 1050) /208,208,209,210,211,212,213,213,214,215/
+data (lkup10830[i], i = 1051, 1060) /216,217,218,219,220,220,221,222,223,224/
+data (lkup10830[i], i = 1061, 1070) /225,226,227,228,229,230,230,231,232,233/
+data (lkup10830[i], i = 1071, 1080) /234,235,236,237,238,239,240,241,242,243/
+data (lkup10830[i], i = 1081, 1090) /244,245,246,247,248,249,250,251,252,253/
+data (lkup10830[i], i = 1091, 1091) /254/
diff --git a/noao/imred/vtel/unwrap.par b/noao/imred/vtel/unwrap.par
new file mode 100644
index 00000000..1a1d3504
--- /dev/null
+++ b/noao/imred/vtel/unwrap.par
@@ -0,0 +1,9 @@
+image,s,a,,,,image
+outimage,s,a,,,,outimage
+threshold1,i,h,128,,,threshold for first unwrap
+wrapval1,i,h,256,,,wrap displacement for first unwrap
+threshold2,i,h,128,,,threshold for second unwrap
+wrapval2,i,h,256,,,wrap displacement for second unwrap
+cstart,i,h,2,,,column start
+step,i,h,5,,,number of steps to take
+verbose,b,h,yes,,,verbose flag
diff --git a/noao/imred/vtel/unwrap.x b/noao/imred/vtel/unwrap.x
new file mode 100644
index 00000000..a753ddf4
--- /dev/null
+++ b/noao/imred/vtel/unwrap.x
@@ -0,0 +1,293 @@
+include <mach.h>
+include <imhdr.h>
+
+define	MAXBADLINES	20		# maximum number of bad lines
+define	BADTHRESH	1000		# threshold for bad lines
+define	FIXWIDTH	20		# Width of average for fixline
+
+# UNWRAP -- Filter an iraf image.  This filter checks for binary wraparound
+# in IRAF images.  The algorithm is described in detail in the help page.
+# The program accepts templates for both input and output image lists.
+
+procedure t_unwrap()
+
+char	image[SZ_FNAME]			# input image template
+char	outimage[SZ_FNAME]		# output image template
+int	threshold1			# threshold value for first unwrap
+int	threshold2			# threshold value for second unwrap
+int	wrapval1			# wrapvalue for first unwrap
+int	wrapval2			# wrapvalue for second unwrap
+int	cstart				# column to start on
+int	step				# number of steps to perform
+bool	verbose				# verbose flag
+
+int	i, j 
+int	listin, listout
+int	length, nlines
+int	badlines[MAXBADLINES]
+int	diff, nbad
+char	tempimage[SZ_FNAME]
+pointer	im, imout, lgp, lgp2, lpp, cck, sp
+
+bool	clgetb()
+int	imtopenp(), imtlen(), imtgetim(), clgeti()
+pointer	immap(), imgl2s(), impl2s()
+errchk	immap, imgl2s, impl2s
+
+begin
+	# Get parameters from the CL.
+	listin = imtopenp ("image")
+	listout = imtopenp ("outimage")
+	threshold1 = clgeti("threshold1")
+	wrapval1 = clgeti("wrapval1")
+	threshold2 = clgeti("threshold2")
+	wrapval2 = clgeti("wrapval2")
+	cstart = clgeti("cstart")
+	step = clgeti("step")
+	verbose = clgetb("verbose")
+
+	if (verbose) {
+	    call printf ("\n\nUNWRAP: ")
+	    call printf ("threshold1 = %d\n")
+	    call pargi (threshold1)
+	    call printf ("\twrapval1   = %d\n")
+	    call pargi (wrapval1)
+	    call printf ("\tthreshold2 = %d\n")
+	    call pargi (threshold2)
+	    call printf ("\twrapval2   = %d\n")
+	    call pargi (wrapval2)
+	    call printf ("\tcstart     = %d\n")
+	    call pargi (cstart)
+	    call printf ("\tstep       = %d\n\n")
+	    call pargi (step)
+	    call flush (STDOUT)
+	}
+
+	# Check the number of elements.
+	if (imtlen (listin) != imtlen (listout)) {
+	    call imtclose (listin)
+	    call imtclose (listout)
+	    call error (1, "Wrong number of elements in the operand lists")
+	}
+
+	# Get the next images from the lists.
+	while (imtgetim (listin, image, SZ_FNAME) != EOF) {
+	    if (imtgetim (listout, outimage, SZ_FNAME) != EOF) {
+
+	        if (verbose) {
+		    # Write out about the input file name and output file name.
+		    call printf ("\tUnwrapping %s into %s.  ")
+		        call pargstr (image)
+		        call pargstr (outimage)
+		    call flush (STDOUT)
+	        }
+
+	        # Open images.
+	        iferr {
+	            im = immap (image, READ_WRITE, 0)
+	        } then {
+		    call eprintf ("Cannot open image %s.\n")
+		        call pargstr (image)
+		    next
+	        }
+
+	        call xt_mkimtemp (image, outimage, tempimage, SZ_FNAME)
+
+	        iferr {
+	            imout = immap (outimage, NEW_COPY, im)
+	        } then {
+		    call eprintf ("Cannot open image %s, (already exists?).\n")
+		        call pargstr (outimage)
+		    next
+	        }
+
+	        length = IM_LEN(im,1)
+	        nlines = IM_LEN(im,2)
+
+	        # Set up the column check array, then unwrap line by line.
+	        call smark (sp)
+	        call salloc (cck, nlines, TY_INT)
+	        call amovks (0, Memi[cck], nlines)
+	        do i = 1, nlines {
+	            lgp = imgl2s (im, i)
+	            lpp = impl2s (imout, i)
+	            call unwrapline (Mems[lgp], Mems[lpp], cck, length,
+			threshold1, wrapval1, threshold2, wrapval2, cstart,
+			step, i)
+	        }
+
+	        # Step 5 is the final step. (fixline)
+	        if (step == 5) {
+	            # Analyze the column, check for wraps.
+	            nbad = 0
+	            do i = 2, nlines {
+	    	        diff = Memi[cck+i-1] - Memi[cck+i-2]
+	    	        if (abs(diff) > BADTHRESH) {
+	    	            # Mark this line bad.
+	    	            nbad = nbad + 1
+	    	            if (nbad > MAXBADLINES)
+	    		        break
+	    	            badlines[nbad] = i
+	    	        }
+	            }
+	        }
+
+	        # If number bad lines <= than MAXBADLINES, fix em, else, quit.
+	        if (nbad <= MAXBADLINES && nbad > 0) {
+	            do i = 1, nbad {
+
+	    	        # GET the lines above and below the bad line and PUT the
+	    	        # bad line.  Then average the above and below lines and
+			# save in the bad line.
+
+	    	        if (badlines[i] != 1 && badlines[i] != nlines) {
+	    	            if ((badlines[i+1] - badlines[i]) == 1) {
+	                        lgp = imgl2s (imout, badlines[i]-1)
+	                        lgp2 = imgl2s (imout, badlines[i]+1)
+	                        lpp = impl2s (imout, badlines[i])
+	    	                do j = 1, length {
+	    		            Mems[lpp+j-1] = int((real(Mems[lgp+j-1]) +
+	    		                real(Mems[lgp2+j-1]))/2. + .5)
+	    		        }
+	    	            } 
+	    	        }
+	            }
+	        }
+
+	        if (verbose) {
+	            call printf ("number of bad lines = %d\n")
+	                call pargi (nbad)
+	            do i = 1, nbad {
+	                call printf ("\tbadlines[%d] = %d\n")
+	    	        call pargi (i)
+	    	        call pargi (badlines[i])
+	            }
+		    call printf ("\n")
+	            call flush (STDOUT)
+	        }
+
+	        # Unmap images.
+	        call imunmap (im)
+	        call imunmap (imout)
+	        call xt_delimtemp (outimage, tempimage)
+	        call sfree (sp)
+
+	    } # End of if (not EOF)
+	}  # End of while loop on input images
+
+	call imtclose (listin)
+	call imtclose (listout)
+end
+
+
+# UNWRAPLINE -- Unwrap a line of the image.
+
+procedure unwrapline (line1, line2, cck, numpix, threshold1, wrapval1,
+	threshold2, wrapval2, cstart, step, whichline)
+
+short	line1[numpix]			# input line
+short	line2[numpix]			# output line
+pointer	cck				# pointer to array for column check
+int	numpix				# number of pixels per line
+int	threshold1			# unwrap threshold for first unwrap
+int	wrapval1			# unwrap value for first unwrap
+int	threshold2			# unwrap threshold for second unwrap
+int	wrapval2			# unwrap value for second unwrap
+int	cstart				# column to start on
+int	step				# steps to complete
+int	whichline			# which line this is we are unwrapping
+
+pointer	tl1, tl2, tl3			# pointers of temporary arrays
+pointer	sp				# stack pointer
+int	i, diff, sum
+short	wrap				# wrap number
+
+begin
+	# Mark the stack and allcoate the temporary arrays.
+	call smark (sp)
+	call salloc (tl1, numpix, TY_SHORT)
+	call salloc (tl2, numpix, TY_SHORT)
+	call salloc (tl3, numpix, TY_SHORT)
+
+	# Initialize wrap.
+	wrap = 0
+
+	# Copy the input line into the output line and the temporary arrays.
+	call amovs (line1, line2, numpix)
+	call amovs (line1, Mems[tl1], numpix)
+	call amovs (line1, Mems[tl2], numpix)
+	call amovs (line1, Mems[tl3], numpix)
+
+	# Check the image width, do various things if the image is too small.
+
+	# Too small for anything.
+	if (numpix <= 4) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Too small for step 5 (fixline).
+	if (numpix <= FIXWIDTH && step == 5)
+	    step = 4
+
+	# Unwrap1 (step 1).
+	Mems[tl1+cstart-1] = line1[cstart]
+	do i = cstart+1, numpix {
+	    diff = line1[i] - line1[i-1]
+	    if (diff < -threshold1)
+		wrap = wrap + 1
+	    if (diff > threshold1)
+		wrap = wrap - 1
+
+	    Mems[tl1+i-1] = line1[i] + wrap * wrapval1
+	}
+	if (step == 1) {
+	    call amovs (Mems[tl1], line2, numpix)
+	    call sfree (sp)
+	    return
+	}
+
+	# If the user wants it, step 2 (dif).
+	do i = cstart, numpix
+	    Mems[tl2+i-1] = Mems[tl1+i-1] - Mems[tl1+i-2]
+
+	if (step == 2) {
+	    call amovs (Mems[tl2], line2, numpix)
+	    call sfree (sp)
+	    return
+	}
+
+	# If the user wants it, step 3 (unwrap2).
+	wrap = 0
+	line2[cstart] = Mems[tl2+cstart-1]
+	do i = cstart+1, numpix {
+	    diff = Mems[tl2+i-1] - Mems[tl2+i-2]
+	    if (diff < -threshold2)
+	        wrap = wrap + 1
+	    if (diff > threshold2)
+		wrap = wrap - 1
+
+	    line2[i] = Mems[tl2+i-1] + wrap * wrapval2
+	}
+	if (step == 3) {
+	    call sfree (sp)
+	    return
+	}
+
+	# If the user wants it, step 4 (reconstruct).
+	do i = cstart, numpix
+	    line2[i] = line2[i-1] + line2[i]
+	
+	if (step == 4) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Again, if the user wants it, save data for step 5, (fixline).
+	sum = 0
+	do i = numpix-FIXWIDTH+1, numpix
+	    sum = sum + line2[i]
+	Memi[cck+whichline-1] = int(real(sum)/real(FIXWIDTH) + .5)
+
+	call sfree (sp)
+end
diff --git a/noao/imred/vtel/vt.h b/noao/imred/vtel/vt.h
new file mode 100644
index 00000000..73d9c22a
--- /dev/null
+++ b/noao/imred/vtel/vt.h
@@ -0,0 +1,73 @@
+# Vacuum_telescope analysis package header file.
+
+# General defines common to most of the programs in this package.
+define	DIM_VTFD	2048		  # full disk image = 2048 x 2048 array 
+define	SZB_SHORT	SZ_SHORT*SZB_CHAR # number of bytes per short integer
+define	SZB_REAL	SZ_REAL*SZB_CHAR  # number of bytes per real
+define	THRESHOLD	4		  # limb cutoff value, squib brightness
+
+# Defines related to the tape format.
+define 	SZ_VTHDR	20		# number of 16-bit words in vt header
+define	SZ_VTREC	5120		# number of 16-bit words in vt record
+define	NUM_VTREC	750		# number of records in full disk image
+
+# Ellipse structure defines.
+define	LEN_ELSTRUCT	4		# real el[LEN_ELSTRUCT]
+
+define	E_XCENTER	$1[1]		# x-coord of center of limb ellipse
+define	E_YCENTER	$1[2]		# y-coord of center of limb ellipse
+define	E_XSEMIDIAMETER	$1[3]		# length of x semiaxis of limb ellipse
+define	E_YSEMIDIAMETER	$1[4]		# length of y semiaxis of limb ellipse
+
+# Defines for readvt, etc.
+define	SWTH_HIGH	512		# height of each swath
+define	SWTHWID_14	1700		# width of swaths 1 and 4
+define	SWTHWID_23	2048		# width of swaths 2 and 3
+define	HALF_DIF	174		# one half of difference in swath widths
+define	SZ_TABLE	8192		# length of lookup table (16-bit words)
+define	NUM_SRSTR	16		# total # of subrasters in full disk
+define	LEN_HDRDAT	10		# length of header data
+define	NUM_SRSTR_X	4		# number of subrasters in x direction
+define	NUM_SRSTR_Y	4		# number of subrasters in y direction
+define	SRSTR_WID	512		# width of each subraster
+define	IS_DATA		1		# subswath data indicator
+define	DTSTRING	100		# length of date/time string
+
+# Defines for rmap, etc.
+define	DIM_IN_RAS	150		# y dimension for input image subraster
+define	DIM_SQUAREIM	180		# x or y dimension of daily projection
+
+# Defines for merge, etc.
+define	DIM_XCARMAP	360		# x dimension of carrington map
+define	SZ_WTBL		180		# size of weight table for merge
+
+# Mscan text (pixelfont) structure.
+define	LEN_TXSTRUCT	10
+
+define	TX_XPOS		Memi[$1]	# x position of start of text
+define	TX_YPOS		Memi[$1+1]	# y position of start of text
+define	TX_VALUE	Memi[$1+2]	# value to write text with
+define	PRINT_TEXT	Memi[$1+3]	# to text, or not to text  (1=yes,0=no)
+define	ZERO_BGND	Memi[$1+4]	# fill background w/ VALU? (1=yes,0=no)
+define	BGND_VALU	Memi[$1+5]	# background value to use
+
+# Vacuum telescope header struture.
+define	VT_LENHSTRUCT	10
+
+define	VT_HMONTH	Memi[$1]	# month of observation (1-12)
+define	VT_HDAY		Memi[$1+1]	# day of observation (1-31)
+define	VT_HYEAR	Memi[$1+2]	# year (two digits)
+define	VT_HTIME	Memi[$1+3]	# time (seconds since midnight)
+define	VT_HWVLNGTH	Memi[$1+4]	# wavelength (angstroms)
+define	VT_HOBSTYPE	Memi[$1+5]	# observation type (0,1,2,3,or 4)
+define	VT_HAVINTENS	Memi[$1+6]	# average intensity
+define	VT_HNUMCOLS	Memi[$1+7]	# number of columns
+define	VT_HINTGPIX	Memi[$1+8]	# integrations per pixel
+define	VT_HREPTIME	Memi[$1+9]	# repitition time
+
+# I/O buffer structure.
+define	VT_LENBSTRUCT	3
+
+define	VT_BUFP		Memi[$1]	# pointer, top of i/o buf
+define	VT_BP		Memi[$1+1]	# pointer, current position in i/o buf
+define	VT_BUFBOT	Memi[$1+2]	# pointer, current bottom of i/o buf
diff --git a/noao/imred/vtel/vtblink.cl b/noao/imred/vtel/vtblink.cl
new file mode 100644
index 00000000..d9e51a61
--- /dev/null
+++ b/noao/imred/vtel/vtblink.cl
@@ -0,0 +1,150 @@
+#{ VTBLINK -- Blink successive frames of daily grams to check registration.
+
+# imname1,s,a,,,,Name of first image
+# imname2,s,a,,,,Name of next image
+# z1,r,h,-3000.0,,,Minimum graylevel to be displayed.
+# z2,r,h,3000.0,,,Minimum graylevel to be displayed.
+
+{
+	real	zz1, zz2, offset, currentoffset
+	char	im1name, im2name, framelog[4]
+	int	im1long, im2long, currentframe, offscreenflag
+
+	# initialize
+	print ("  ")
+	print ("  ")
+	print ("vtblink vtblink vtblink vtblink vtblink vtblink vtblink")
+	print ("  ")
+	currentframe = 1
+	offscreenflag = 0
+	currentoffset = .72      # Start at the right side of the screen.
+	framelog[1] = "none"
+	framelog[2] = "none"
+	framelog[3] = "none"
+	framelog[4] = "none"
+
+	# Get the gray scale.
+	zz1 = z1
+	zz2 = z2
+
+	# Get the first frame from the user, display it, allow user to window.
+	im1name = imname1
+	if (im1name == "end") {
+	    bye
+	}
+	while (!access(im1name//".imh") && im1name != "end") {
+	    print (im1name, "not accessable, try again")
+	    im1name = imname1
+	    if (im1name == "end") {
+	        bye
+	    }
+	}
+	imgets (im1name, "L_ZERO")
+	im1long = real(imgets.value)
+	print ("Longitude of first image is ", im1long)
+	print ("Displaying frame.")
+	display (im1name, currentframe, xcenter=currentoffset, zrange=no,
+	    zscale=no, z1=zz1, z2=zz2)
+	framelog[currentframe] = im1name
+	frame (currentframe)
+	print ("Now, please window this frame for the desired color table.")
+	window
+
+	# Make all the color tables of the other 3 frames the same as this.
+	print ("Equalizing color tables of 4 frames, Please wait.")
+	lumatch (2, currentframe)
+	lumatch (3, currentframe)
+	lumatch (4, currentframe)
+
+	# Get the next frame from the user.
+	im2name = imname2
+	while (im2name == "stat") {
+	    print ("Frame 1 contains image ", framelog[1])
+	    print ("Frame 2 contains image ", framelog[2])
+	    print ("Frame 3 contains image ", framelog[3])
+	    print ("Frame 4 contains image ", framelog[4])
+	    im2name = imname2
+	}
+	if (im2name == "end") {
+	    bye
+	}
+	while (!access(im2name//".imh") && im2name != "end") {
+	    print (im2name, "not accessable, try again")
+	    im2name = imname2
+	    if (im2name == "end") {
+	        bye
+	    }
+	}
+	imgets (im2name, "L_ZERO")
+	im2long = real(imgets.value)
+	print ("Longitude of this image is ", im2long)
+
+	# While the user does not enter 'end' for the image name, keep going.
+	# also check the offscreenflag and exit it it becomes set.
+	while (im2name != 'end' && offscreenflag != 1) {
+	
+	    # Calculate offset. subsequent images in general have smaller
+	    # longitudes, that is, longitude decreases with time.
+	    # If the new image has a larger longitude then fix up offset.
+	    if (im1long < im2long) {
+	        offset = real((im2long - 360) - im1long)/512.
+	    } else {
+	        offset = real(im2long - im1long)/512.
+	    }
+
+	    # If we are getting too close to the left side, restart program.
+	    if ((currentoffset+offset) <= .18) {
+		print("*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*")
+		print("* The next image would overlap the edge of the      *")
+		print("* screen. Please restart the program with the last  *")
+		print("* image.                                            *")
+		print("*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*")
+		offscreenflag = 1
+	    }
+
+	    # Display the next image and blink it with the previously displayed
+	    # image.
+	    if (offscreenflag != 1) {
+	        print ("Displaying frame.")
+	        display (im2name, mod(currentframe,4)+1,
+		    xcenter=currentoffset+offset, zscale=no, zrange=no,
+		    z1=zz1, z2=zz2)
+		framelog[mod(currentframe,4)+1] = im2name
+
+	        # Return the user to the cl so s/he can do whatever s/he wants.
+	        print("  ")
+	        print("You are now in the cl, type 'bye' to return to vtlbink")
+	        cl()
+	        print("  ")
+
+	        # Update currentframe and print it out, update the offset.
+	        currentframe = mod(currentframe,4)+1
+		print ("The next frame to be used for display is frame ", 
+		    mod(currentframe,4)+1)
+	        currentoffset += offset
+
+	        # Move image2 to image1 and then get a new image2 and loop back.
+	        im1name = im2name
+	        im1long = im2long
+	        im2name = imname2
+		while (im2name == "stat") {
+	    	    print ("Frame 1 contains image ", framelog[1])
+	    	    print ("Frame 2 contains image ", framelog[2])
+	    	    print ("Frame 3 contains image ", framelog[3])
+	    	    print ("Frame 4 contains image ", framelog[4])
+	    	    im2name = imname2
+		}
+	        while (!access(im2name//".imh") && im2name != "end") {
+	            print (im2name, "not accessable, try again")
+	            im2name = imname2
+	            if (im2name == "end") {
+	                bye
+	            }
+	        }
+		if (im2name != "end") {
+		    imgets (im2name, "L_ZERO")
+		    im2long = real(imgets.value)
+		}
+	    }
+	}
+}
diff --git a/noao/imred/vtel/vtblink.par b/noao/imred/vtel/vtblink.par
new file mode 100644
index 00000000..def7c1eb
--- /dev/null
+++ b/noao/imred/vtel/vtblink.par
@@ -0,0 +1,4 @@
+imname1,s,a,,,,Name of first image
+imname2,s,a,,,,Name of next image
+z1,r,h,-3000.0,,,Minimum graylevel to be displayed.
+z2,r,h,3000.0,,,Minimum graylevel to be displayed.
diff --git a/noao/imred/vtel/vtel.cl b/noao/imred/vtel/vtel.cl
new file mode 100644
index 00000000..020a6455
--- /dev/null
+++ b/noao/imred/vtel/vtel.cl
@@ -0,0 +1,38 @@
+#{ VTEL -- Vacuum_telescope package.
+
+# load necessary packages
+images
+tv
+
+set	vtel		= "imred$vtel/"
+
+package vtel
+
+task	readvt,
+	writevt,
+	unwrap,
+	quickfit,
+	getsqib,
+	putsqib,
+	mscan,
+	rmap,
+	merge,
+	destreak,
+	trim,
+	vtexamine,
+	tcopy,
+	pimtext,
+	syndico,
+	dicoplot	= "vtel$x_vtel.e"
+
+# scripts
+
+task	vtblink		= "vtel$vtblink.cl"
+task	writetape	= "vtel$writetape.cl"
+task	destreak5	= "vtel$destreak5.cl"
+task	fitslogr	= "vtel$fitslogr.cl"
+task	mrotlogr	= "vtel$mrotlogr.cl"
+task	makeimages	= "vtel$makeimages.cl"
+task	makehelium	= "vtel$makehelium.cl"
+
+clbye()
diff --git a/noao/imred/vtel/vtel.hd b/noao/imred/vtel/vtel.hd
new file mode 100644
index 00000000..5a9871ab
--- /dev/null
+++ b/noao/imred/vtel/vtel.hd
@@ -0,0 +1,29 @@
+# Help directory for the VACUUM package.
+
+$doc	= "./doc/"
+
+vtel		men=vtel$vtel.men,		src=vtel$vtel.cl
+destreak	hlp=doc$destreak.hlp,		src=vtel$destreak.x
+destreak5	hlp=doc$destreak5.hlp,		src=vtel$destreak5.cl
+readvt		hlp=doc$readvt.hlp,		src=vtel$readvt.x
+writevt		hlp=doc$writevt.hlp,		src=vtel$writevt.x
+rmap		hlp=doc$rmap.hlp,		src=vtel$rmap.x
+vtblink		hlp=doc$vtblink.hlp,		src=vtel$vtblink.cl
+quickfit	hlp=doc$quickfit.hlp,		src=vtel$quickfit.x
+merge		hlp=doc$merge.hlp,		src=vtel$merge.x
+dicoplot	hlp=doc$dicoplot.hlp,		src=vtel$dicoplot.x
+unwrap		hlp=doc$unwrap.hlp,		src=vtel$unwrap.x
+getsqib		hlp=doc$getsqib.hlp,		src=vtel$getsqib.x
+putsqib		hlp=doc$putsqib.hlp,		src=vtel$putsqib.x
+trim		hlp=doc$trim.hlp,		src=vtel$trim.x
+mscan		hlp=doc$mscan.hlp,		src=vtel$mscan.x
+vtexamine	hlp=doc$vtexamine.hlp,		src=vtel$vtexamine.x
+tcopy		hlp=doc$tcopy.hlp,		src=vtel$tcopy.x
+pimtext		hlp=doc$pimtext.hlp,		src=vtel$pimtext.x
+fitslogr	hlp=doc$fitslogr.hlp,		src=vtel$fitslogr.cl
+mrotlogr	hlp=doc$mrotlogr.hlp,		src=vtel$mrotlogr.cl
+makeimages	hlp=doc$makeimages.hlp,		src=vtel$makeimages.cl
+makehelium	hlp=doc$makehelium.hlp,		src=vtel$makehelium.cl
+writetape	hlp=doc$writetape.hlp,		src=vtel$writetape.cl
+syndico		hlp=doc$syndico.hlp,		src=vtel$syndico.x
+revisions	sys=Revisions
diff --git a/noao/imred/vtel/vtel.men b/noao/imred/vtel/vtel.men
new file mode 100644
index 00000000..df98fc59
--- /dev/null
+++ b/noao/imred/vtel/vtel.men
@@ -0,0 +1,23 @@
+       destreak - Destreak He 10830 grams.
+      destreak5 - First pass processing CL script for 10830 grams.
+       dicoplot - Make dicomed plots of carrington maps.
+       fitslogr - Make a log of certain header parameters from a FITS tape.
+	getsqib - Extract the squibby brightness image from a full disk scan.
+     makehelium - Cl script for processing destreaked 10830 grams(second pass).
+     makeimages - Cl script for processing magnetograms into projected maps
+	  merge - Merge daily grams into a Carrington map.
+       mrotlogr - Log some header parameters from a FITS rotation map tape.
+	  mscan - Read all sector scans on a tape and put them into images.
+	pimtext - Put text directly into images using a pixel font.
+	putsqib - Merge a squibby brightness image into a full disk image.
+       quickfit - Fit an ellipse to the solar limb.
+	 readvt - Read a full disk tape and produce an IRAF image.
+	   rmap - Map a full disk image into a 180 by 180 flat image.
+	syndico - Make dicomed print of daily grams 18 cm across.
+	  tcopy - Tape to tape copy routine.
+	   trim - Set all pixels outside the limb to 0.0 (use sqib for limb).
+	 unwrap - Remove effects of data wraparound on continuum scans.
+	vtblink - Blink daily grams on the IIS to check for registration.
+      vtexamine - Examine a vacuum telescope tape, print headers and profile.
+      writetape - Cl script to write 5 full disk grams to tape.
+	writevt - Write an IRAF image to tape in vacuum telescope format.
diff --git a/noao/imred/vtel/vtel.par b/noao/imred/vtel/vtel.par
new file mode 100644
index 00000000..dde78dd5
--- /dev/null
+++ b/noao/imred/vtel/vtel.par
@@ -0,0 +1 @@
+version,s,h,"8Jun87"
diff --git a/noao/imred/vtel/vtexamine.par b/noao/imred/vtel/vtexamine.par
new file mode 100644
index 00000000..39283d0e
--- /dev/null
+++ b/noao/imred/vtel/vtexamine.par
@@ -0,0 +1,3 @@
+input,s,q,,,,Input file descriptor
+headers,b,h,yes,,,Print out header data 
+files,s,q,,,,List of files to be examined
diff --git a/noao/imred/vtel/vtexamine.x b/noao/imred/vtel/vtexamine.x
new file mode 100644
index 00000000..2b482bbe
--- /dev/null
+++ b/noao/imred/vtel/vtexamine.x
@@ -0,0 +1,195 @@
+include <error.h>
+include <fset.h>
+include <printf.h>
+include <mach.h>
+include "vt.h"
+
+define	MAX_RANGES	100
+
+# VTEXAMINE -- Examine a vacuum telescope tape.  Decode and print the
+# header and tell the user info about number and length of records
+# on the tape.
+
+procedure t_vtexamine()
+
+char	input[SZ_FNAME]		# input template
+char	files[SZ_LINE]		# which files to examine
+bool	headers			# print headers?
+
+char	tapename[SZ_FNAME]
+int	filerange[2 * MAX_RANGES + 1]
+int	nfiles, filenumber, nrecords
+
+bool	clgetb()
+int	decode_ranges(), get_next_number()
+int	vtexamine(), mtfile(), mtneedfileno()
+errchk	vtexamine
+
+begin
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Find out if user wants to see header info.
+	headers = clgetb ("headers")
+	
+        # Get input file(s)
+        call clgstr ("input", input, SZ_FNAME)
+	if (mtfile (input) == NO || mtneedfileno (input) == NO)
+	    call strcpy ("1", files, SZ_LINE)
+        else
+	    call clgstr ("files", files, SZ_LINE)
+
+        if (decode_ranges (files, filerange, MAX_RANGES, nfiles) == ERR)
+	    call error (0, "Illegal file number list.")
+	call printf ("\n")
+
+        # Loop over files.
+	filenumber = 0
+        while (get_next_number (filerange, filenumber) != EOF) {
+
+	    # Assemble the appropriate tape file name.
+	    call strcpy (input, tapename, SZ_FNAME)
+	    if (mtfile(input) == YES && mtneedfileno (input) == YES)
+		call mtfname (input, filenumber, tapename, SZ_FNAME)
+
+	    iferr {
+	        nrecords = vtexamine (tapename, headers)
+	    } then {
+		call eprintf ("Error reading file: %s\n")
+		    call pargstr (tapename)
+		call erract (EA_WARN)
+		next
+	    } else if (nrecords == 0) {
+	        call printf ("Tape at EOT\n")
+		break
+	    }
+
+        }  # End while.
+end
+
+
+# VTEXAMINE -- examine a tape (or disk) file.  Report about size and
+# number of records and, if requested, decode and print the header
+# information.
+
+int procedure vtexamine (input, headers)
+
+char	input[ARB]		# input file name
+bool	headers
+
+int	in, bufsize, totrecords
+int	nrecords, totbytes, lastrecsize
+int	recsize
+bool	trufls
+pointer	hs, sp
+pointer	pchar, hpchar
+
+int	mtopen(), fstati(), get_next_record()
+errchk	mtopen, close, get_next_record
+
+begin
+	call smark (sp)
+	call salloc (hs, VT_LENHSTRUCT, TY_STRUCT)
+
+	in = mtopen (input, READ_ONLY, 0)
+	bufsize = fstati (in, F_BUFSIZE)
+
+	call malloc (pchar, bufsize, TY_CHAR)
+	call malloc (hpchar, bufsize, TY_SHORT)
+
+	call printf ("File %s:  ")
+	    call pargstr (input)
+
+	totrecords = 0
+	nrecords = 0
+	totbytes = 0
+	lastrecsize = 0
+
+
+	# First read the header file.
+	recsize = get_next_record (in, Memc[pchar], bufsize, recsize,
+	    SZ_VTHDR * SZB_SHORT/SZB_CHAR)
+	if (recsize == EOF)
+	    return (totrecords)
+	call amovs (Memc[pchar], Mems[hpchar], SZ_VTHDR * SZB_SHORT/SZB_CHAR)
+
+	nrecords = nrecords + 1
+	totrecords = totrecords + 1
+	totbytes = totbytes + recsize
+	lastrecsize = recsize
+	trufls = TRUE
+	if (headers)
+	    call decodeheader (hpchar, hs, trufls)
+	call printf ("\n")
+
+	# Loop through the rest of the records.
+	while (get_next_record (in, Memc[pchar], bufsize, recsize,
+	    lastrecsize) != EOF) {
+
+	    if (recsize == lastrecsize)
+		nrecords = nrecords + 1
+	    else {
+		call printf ("\t      %d %d-byte records\n")
+		    call pargi (nrecords)
+		    call pargi (lastrecsize)
+		nrecords = 1
+		lastrecsize = recsize
+	    }
+
+	    totrecords = totrecords + 1
+	    totbytes = totbytes + recsize
+
+	}  # End while.
+
+	if (nrecords > 0 ) {
+	    call printf ("\t      %d %d-byte records\n")
+		call pargi (nrecords)
+		call pargi (lastrecsize)
+	}
+
+	# Print total number of records and bytes.
+	call printf ("\t      Total %d records, %d bytes\n")
+	    call pargi (totrecords)
+	    call pargi (totbytes)
+
+	call mfree (pchar, TY_CHAR)
+	call mfree (hpchar, TY_SHORT)
+	call sfree (sp)
+	call close (in)
+
+	return (totrecords)
+end
+
+
+# GET_NEXT_RECORD -- Read the next record from tape (or disk) and,
+# if an error is found, patch up the data as best we can and use it.
+# Also, tell the user about the error.
+
+int procedure get_next_record(fd, buffer, bufsize, recsize, lastbufsize)
+
+int	bufsize
+char	buffer[bufsize]
+int	recsize, lastbufsize
+pointer	fd
+
+int	read(), fstati()
+bool	eofflag
+errchk	read
+
+begin
+	eofflag = false
+	iferr {
+	    if (read (fd, buffer, bufsize) == EOF)
+		eofflag = true
+	    recsize = fstati (fd, F_SZBBLK)
+	} then {
+	    call fseti (fd, F_VALIDATE, lastbufsize)
+	    recsize = read (fd, buffer, bufsize)
+	    recsize = fstati (fd, F_SZBBLK)
+	}
+	if (BYTE_SWAP2 == YES)
+	    call bswap2 (buffer, 1, buffer, 1, SZ_VTHDR*SZB_SHORT)
+	if (eofflag)
+	    return (EOF)
+	else
+	    return (recsize)
+end
diff --git a/noao/imred/vtel/writetape.cl b/noao/imred/vtel/writetape.cl
new file mode 100644
index 00000000..76bb23f2
--- /dev/null
+++ b/noao/imred/vtel/writetape.cl
@@ -0,0 +1,45 @@
+#{ WRITETAPE -- Write five images to a vacuum telescope tape.  The
+# script accepts the name of the mag tape device and the general input
+# image filename from the user.  Writetape appends a digit [1-5] to the
+# file name for each file to be written.
+
+# getmtape,s,a,,,,Mag tape device to write to
+# getname,s,a,,,,Root filename for the 5 images
+# magtape,s,h
+# imname,s,h
+
+{
+
+	imname = getname
+	magtape = getmtape
+
+	if (access(imname//"1.imh")) {
+	    writevt (imname//"1", magtape//"1600[1]")
+	} else {
+	    print (imname//"1 not accessable")
+	}
+
+	if (access(imname//"2.imh")) {
+	    writevt (imname//"2", magtape//"1600[2]")
+	} else {
+	    print (imname//"2 not accessable")
+	}
+
+	if (access(imname//"3.imh")) {
+	    writevt (imname//"3", magtape//"1600[3]")
+	} else {
+	    print (imname//"3 not accessable")
+	}
+
+	if (access(imname//"4.imh")) {
+	    writevt (imname//"4", magtape//"1600[4]")
+	} else {
+	    print (imname//"4 not accessable")
+	}
+
+	if (access(imname//"5.imh")) {
+	    writevt (imname//"5", magtape//"1600[5]")
+	} else {
+	    print (imname//"5 not accessable")
+	}
+}
diff --git a/noao/imred/vtel/writetape.par b/noao/imred/vtel/writetape.par
new file mode 100644
index 00000000..863a283d
--- /dev/null
+++ b/noao/imred/vtel/writetape.par
@@ -0,0 +1,5 @@
+
+getmtape,s,a,,,,Mag tape device to write to
+getname,s,a,,,,Root filename for the 5 images
+magtape,s,h
+imname,s,h
diff --git a/noao/imred/vtel/writevt.par b/noao/imred/vtel/writevt.par
new file mode 100644
index 00000000..de11cb13
--- /dev/null
+++ b/noao/imred/vtel/writevt.par
@@ -0,0 +1,4 @@
+imagefile,s,q,,,,Image file descriptor
+outputfile,s,q,,,,Output file descriptor
+verbose,b,h,no,,,Print out header data and give progress reports
+new_tape,b,q,,,,Are you using a new tape?
diff --git a/noao/imred/vtel/writevt.x b/noao/imred/vtel/writevt.x
new file mode 100644
index 00000000..390884b2
--- /dev/null
+++ b/noao/imred/vtel/writevt.x
@@ -0,0 +1,232 @@
+include <error.h>
+include <mach.h>
+include <fset.h>
+include "vt.h"
+
+define	SZ_TABLE	8192		# size of lookup table (data)
+
+# WRITEVT -- Write an IRAF image (vacuum telescope full disk image) out to
+# tape in a format identical to the format produced bye the vacuum telescope.
+
+procedure t_writevt()
+
+char	imagefile[SZ_FNAME]			# name of image to be written
+char	outputfile[SZ_FNAME]			# output file name (tape)
+bool	verbose					# verbose flag
+
+int	obsdate
+int	x1, y1, subraster, outfd
+int	one
+pointer	table
+pointer	srp, im, hs, sp
+
+int	imgeti(), mtopen()
+int	mtfile(), mtneedfileno()
+bool	clgetb()
+pointer	imgs2s(), immap()
+errchk	immap, imgs2s, mtopen
+
+begin
+	call smark (sp)
+	call salloc (table, SZ_TABLE, TY_SHORT)
+	call salloc (hs, VT_LENHSTRUCT, TY_STRUCT)
+
+	# Get the image name and the verbose flag from the cl.
+	call clgstr ("imagefile", imagefile, SZ_FNAME)
+	verbose = clgetb ("verbose")
+
+	# Get the output file from the cl.
+	call clgstr ("outputfile", outputfile, SZ_FNAME)
+
+	# See if the outputfile is mag tape, if not, error.
+        if (mtfile (outputfile) == NO)
+	    call error (1, "Outputfile should be magnetic tape.")
+
+	# If no tape file number is given, then ask whether the tape
+	# is blank or contains data.  If blank then start at [1], else
+	# start at [EOT].
+
+	if (mtneedfileno(outputfile) == YES)
+	    if (!clgetb ("new_tape"))
+		call mtfname (outputfile, EOT, outputfile, SZ_FNAME)
+	    else
+		call mtfname (outputfile, 1, outputfile, SZ_FNAME)
+
+	if (verbose) {
+	    call printf ("outputfile name = %s\n")
+		call pargstr (outputfile)
+	}
+
+	# Open the image file and the output file.
+	im = immap (imagefile, READ_ONLY, 0)
+	outfd = mtopen (outputfile, WRITE_ONLY, SZ_VTREC)
+
+	# Get date and time from the header.
+	obsdate = imgeti (im, "OBS_DATE")
+	VT_HMONTH(hs) = obsdate/10000
+	VT_HDAY(hs) = obsdate/100 - 100 * (obsdate/10000)
+	VT_HYEAR(hs) = obsdate - 100 * (obsdate/100)
+	VT_HTIME(hs) = imgeti (im, "OBS_TIME")
+	VT_HWVLNGTH(hs) = imgeti(im, "wv_lngth")
+	VT_HOBSTYPE(hs) = imgeti (im, "obs_type")
+	VT_HAVINTENS(hs) = imgeti (im, "av_intns")
+	VT_HNUMCOLS(hs) = imgeti (im, "num_cols")
+	VT_HINTGPIX(hs) = imgeti (im, "intg/pix")
+	VT_HREPTIME(hs) = imgeti (im, "rep_time")
+
+	# Write header data to tape.
+	call writeheader (outfd, hs, verbose)
+
+	# Set up lookuptable for data subswaths.
+	one = 1
+	call amovks (one, Mems[table], SZ_TABLE)
+	call aclrs (Mems[table], HALF_DIF)
+	call aclrs (Mems[table + SWTHWID_14 + HALF_DIF], HALF_DIF)
+	call aclrs (Mems[table + SWTHWID_23 * 3], HALF_DIF)
+	call aclrs (Mems[table + SZ_TABLE - HALF_DIF], HALF_DIF)
+
+	# Write the image data to tape.
+	do subraster = 1, NUM_SRSTR {
+
+	    # Calculate position of bottom left corner of this subraster.
+	    x1 = ((NUM_SRSTR_X - 1) - mod((subraster - 1), NUM_SRSTR_X)) *
+		SRSTR_WID + 1
+	    y1 = ((NUM_SRSTR_Y - 1) - ((subraster - mod((subraster - 1),
+		NUM_SRSTR_Y)) / NUM_SRSTR_Y)) * SWTH_HIGH + 1
+
+	    # Get subraster.
+	    srp = imgs2s (im, x1, x1+(SRSTR_WID - 1), y1, y1+(SWTH_HIGH - 1))
+	    iferr (call putsubraster (outfd, Mems[srp], SRSTR_WID,
+		SWTH_HIGH, Mems[table], subraster))
+		call eprintf ("Error in putsubraster, subraster = %d\n")
+		    call pargi (subraster)
+	    if (verbose) {
+		call printf("%d%% done\n")
+		    call pargi ((subraster*100)/NUM_SRSTR)
+		call flush (STDOUT)
+	    }
+	}
+
+	# Close output file and unmap image.
+	call close (outfd)
+	call imunmap (im)
+	call sfree (sp)
+end
+
+
+# WRITEHEADER -- Write header info to the output, pack date
+# and time, and, if 'verbose' flag is set, display some information
+# to the user.
+
+procedure writeheader(outfd, hs, verbose)
+
+int	outfd			# output file descriptor
+pointer	hs			# header data structure pointer
+bool	verbose			# verbose flag
+
+int	i
+short	hbuf[SZ_VTHDR]
+int	fstati()
+errchk	write
+
+begin
+	# Pack date, time.  The constants below are explained in the
+	# description of the image header and how it is packed.  If any
+	# changes are made the following code will have to be rewritten.
+
+	call bitpak (VT_HMONTH(hs)/10, hbuf[1], 13, 4)
+	call bitpak ((VT_HMONTH(hs)-(VT_HMONTH(hs)/10)*10), hbuf[1], 9, 4)
+	call bitpak (VT_HDAY(hs)/10, hbuf[1], 5, 4)
+	call bitpak ((VT_HDAY(hs)-(VT_HDAY(hs)/10)*10), hbuf[1], 1, 4)
+	call bitpak (VT_HYEAR(hs)/10, hbuf[2], 13, 4)
+	call bitpak ((VT_HYEAR(hs)-(VT_HYEAR(hs)/10)*10), hbuf[2], 9, 4)
+	call bitpak (VT_HTIME(hs)/2**15, hbuf[3], 1, 2)
+	call bitpak ((VT_HTIME(hs)-(VT_HTIME(hs)/2**15)*2**15), hbuf[4], 1, 15)
+
+	# Put other parameters in appropriate places.
+	hbuf[5] = VT_HWVLNGTH(hs)
+	hbuf[6] = VT_HOBSTYPE(hs)
+	hbuf[7] = VT_HAVINTENS(hs)
+	hbuf[8] = VT_HNUMCOLS(hs)
+	hbuf[9] = VT_HINTGPIX(hs)
+	hbuf[10] = VT_HREPTIME(hs)
+
+	# Store other header parameters.
+	for (i = 11 ; i <= SZ_VTHDR ; i = i + 1)
+	    hbuf[i] = 0
+
+	if (verbose) {
+	    call printf ("\nmonth/day/year = %d/%d/%d\n")
+		call pargi (VT_HMONTH(hs))
+		call pargi (VT_HDAY(hs))
+		call pargi (VT_HYEAR(hs))
+	    call printf ("time = %d seconds since midnight\n")
+		call pargi (VT_HTIME(hs))
+	    call printf ("wavelength = %d\nobservation type = %d\n")
+		call pargi (VT_HWVLNGTH(hs))
+		call pargi (VT_HOBSTYPE(hs))
+	    call flush (STDOUT)
+	}
+
+	if (BYTE_SWAP2 == YES)
+		call bswap2 (hbuf, 1, hbuf, 1, SZ_VTHDR*SZB_SHORT)
+	call write (outfd, hbuf, SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+	if (fstati (outfd, F_NCHARS) !=  SZ_VTHDR*SZB_SHORT/SZB_CHAR)
+	    call error (0, "error when writing header")
+	call flush (outfd)
+end
+
+
+# PUTSUBRASTER -- Write data to the output from this subraster, look
+# in the table to see if each subswath should be filled with data or zeros.
+
+procedure putsubraster (outfd, array, nx, ny, table, subraster)
+
+int	outfd			# output file descriptor
+int	subraster		# subraster number
+int	nx			# size of the data array (x)
+int	ny			# size of the data array (y)
+short	array[nx, ny]		# data array
+short	table[SZ_TABLE]		# subswath lookup table
+
+int	i, subswath, tableindex
+pointer	sp, bufpointer
+errchk	writesubswath
+
+begin
+	call smark (sp)
+	call salloc (bufpointer, ny, TY_SHORT)
+
+	do subswath = nx, 1, -1 {
+	    tableindex = (subraster - 1) * nx + ((nx + 1) - subswath)
+	    if (table[tableindex] == IS_DATA) {
+		do i = ny, 1, -1
+		     Mems[bufpointer + ny - i] = array[subswath,i]
+		call writesubswath (outfd, Mems[bufpointer], ny)
+	    } else
+		next
+	}
+
+	call sfree(sp)
+end
+
+
+# WRITESUBSWATH -- Write data to file whose logical unit is outfd.
+# Swap the bytes in each data word.
+
+procedure writesubswath (outfd, buf, buflength)
+
+int	outfd			# output file descriptor
+int	buflength		# length of data buffer
+short	buf[buflength]		# data buffer
+
+int	fstati()
+errchk	write
+
+begin
+	if (BYTE_SWAP2 == YES)
+	    call bswap2 (buf, 1, buf, 1, buflength * SZB_SHORT)
+	call write (outfd, buf, buflength*SZB_SHORT/SZB_CHAR)
+	if (fstati (outfd, F_NCHARS) != buflength*SZB_SHORT/SZB_CHAR)
+	    call error (0, "eof encountered when reading subswath")
+end
diff --git a/noao/imred/vtel/x_vtel.x b/noao/imred/vtel/x_vtel.x
new file mode 100644
index 00000000..942afcf0
--- /dev/null
+++ b/noao/imred/vtel/x_vtel.x
@@ -0,0 +1,16 @@
+task	readvt		= t_readvt,
+	writevt		= t_writevt,
+	unwrap		= t_unwrap,
+	quickfit	= t_quickfit,
+	getsqib		= t_getsqib,
+	putsqib		= t_putsqib,
+	rmap		= t_rmap,
+	merge		= t_merge,
+	destreak	= t_destreak,
+	trim		= t_trim,
+	dicoplot	= t_dicoplot,
+	vtexamine	= t_vtexamine,
+	tcopy		= t_tcopy,
+	mscan		= t_mscan,
+	syndico		= t_syndico,
+	pimtext		= t_pimtext